#!/usr/bin/perl
# See http://tnx.nl/3064YXAF if you want syntax-highlighting.

package Spacetime;

use warnings;
use strict;

# We'd get a compile-time error if we'd make a typo here.
use constant RERUN => "RERUN\n";

# Usage: Spacetime->run(\&code1, \&code2, ...)
# Runs the specified CODE references.
sub run {
  my ($class, @code) = @_;

  my $self = bless [
    0,  # Current time
    [], # Message box
    [], # Infoline cache, needed to pretty-print debugging messages
  ] => $class;

  local $@;
  while(1) {
    # If $rerun is true at the and of the loop, we run it again.
    my $rerun = 0;

    foreach my $sub (@code) {
      # Reset time to 0 -- Each coderef is executed "parallel".
      $self->time = 0;
      eval { $sub->($self) };

      # $sub die()ed -- Is it a RERUN request?
      if($@ and $@ eq RERUN) {
        $rerun++;
      } elsif($@) {
    # It was a "real" die -- rethrow $@.
    die $@;
      }
    }

    # Print and reset infoline cache.
    foreach my $line (sort { $a->[0] <=> $b->[0] } splice @{ $self->in
+folines }) {
      print "[$line->[0]] $line->[1]\n";
    }

    # We won't rerun if we don't have to.
    last unless $rerun;
  }

  return $self;
}

# Queues a message.
# Parameters:
#   $time: Specifies the arrival time of the message.
#   $msg:  The content of the message.
# Triggers rerunning if the message is sent to the past.
sub send_to {
  my ($self, $time, $msg) = @_;

  push @{ $self->inbox }, Spacetime::Message->new(
    sent    => $self->time,
    arrival => $time,
    content => $msg,
    # A coderef which deletes the message when executed.
    delete  => sub { @{ $self->inbox } = grep { $_ ne $_[0] } @{ $self
+->inbox } },
  );

  # We've to rerun time if we sent a message to the past.
  die RERUN if $time < $self->time;
}

# send sends a plain old message, no time-travelling. Doesn't trigger
# rerunning.
sub send { $_[0]->send_to($_[0]->time, $_[1]) }

# Returns the messages currently visible.
sub messages {
  my $self = shift;
  my @msgs;

  foreach my $msg (@{ $self->inbox }) {
    push @msgs, $msg if $msg->arrival <= $self->time;
  }

  return @msgs;
}

# Adds a infoline to the infoline cache.
sub info { push @{ $_[0]->infolines }, [ $_[0]->time, $_[1] ] }

# Accessors
sub time      : lvalue { $_[0]->[0] }
sub inbox     : lvalue { $_[0]->[1] }
sub infolines : lvalue { $_[0]->[2] }

package Spacetime::Message;

sub new     { bless { @_[1..$#_] } => $_[0] }
sub sent    { $_[0]->{sent}                 }
sub arrival { $_[0]->{arrival}              }
sub content { $_[0]->{content}              }
sub delete  { $_[0]->{delete}->($_[0])      }

package main;

use constant {
  # Messages. We're using constants to get compile-time errors if we m
+ake a
  # typo.

  # Voyager sends EVERYTHING_OK when they gracefully left subspace.
  EVERYTHING_OK     => 0,
  # PHASECORR_BAD is the malfunctioning phase correction.
  PHASECORR_BAD     => 1,
  # PHASECORR_GOOD is the passe correction which causes Voyager to lea
+ve
  # subspace gracefully.
  PHASECORR_GOOD    => 2,
  # Flyer sends PHASECORR_WAS_BAD to itself in order not to send the b
+ad phase
  # correction each run. Note: This message wasn't sent ijn the origin
+al
  # episode, because StarTrek's understanding of time-travels is b0rke
+d.
  PHASECORR_WAS_BAD => 3,

  TIME_VOY_SUBSPACE    => 10,     # Voyager enters subspace
  TIME_VOY_CORRECTIONS => 20,     # Voyager gets phase corrections
  TIME_VOY_CRASH       => 30,     # Voyager crashes
  TIME_VOY_NORMSPACE   => 30,     # Voyager leaves subspace gracefully
  TIME_FLYER_GOTOK     => 30,     # Flyer gets EVERYTHING_OK message
  TIME_FLYER_FIX       => 100000, # Flyer fixes history
};

# Ok, run.
Spacetime->run(sub { print "Running...\n" }, \&voyager, \&flyer);

sub voyager {
  # &Spacetime::run passes a Spacetime object as first arg to its code
+refs.
  my $spacetime = shift;

  $spacetime->time = TIME_VOY_SUBSPACE;
  $spacetime->info("Voyager: Entering subspace...");

  # Seven gets phase corrections.
  $spacetime->time = TIME_VOY_CORRECTIONS;
  foreach my $msg ($spacetime->messages) {
    # Seven got first (bad) phase correction.
    if($msg->content == PHASECORR_BAD) {
      $msg->delete;

      $spacetime->info("Voyager: Seven got bad phase corrections.");

    # Seven got second (good) phase correction.
    } elsif($msg->content == PHASECORR_GOOD) {
      $msg->delete;

      $spacetime->info("Voyager: Seven got good phase corrections!");

      $spacetime->time = TIME_VOY_NORMSPACE;
      # We send EVERYTHING_OK to Flyer, i.e.: Flyer should return to V
+oyager.
      $spacetime->info("Voyager: Everything's ok!");
      $spacetime->send(EVERYTHING_OK);

      return;
    }
  }

  $spacetime->time = TIME_VOY_CRASH;
  $spacetime->info("Voyager: We're crashing!");
}

sub flyer {
  my $spacetime = shift;

  $spacetime->time = TIME_VOY_SUBSPACE;
  $spacetime->info("Flyer: Flying ahead to get phase corretions...");

  # Voyager sends us EVERYTHING_OK when our fix was/is/will be success
+ful.
  $spacetime->time = TIME_FLYER_GOTOK;
  foreach my $msg ($spacetime->messages) {
    if($msg->content == EVERYTHING_OK) {
      $msg->delete;
      $spacetime->info("Flyer: Everything ok, returning to Voyager..."
+);
      return;
    }
  }

  $spacetime->time = TIME_VOY_CRASH;
  $spacetime->info("Flyer: OMG! Voyager crashed out of subspace!");

  $spacetime->time = TIME_FLYER_FIX;
  $spacetime->info("Flyer: Ok, we change history...");

  foreach my $msg ($spacetime->messages) {
    # We got PHASECORR_WAS_BAD -- i.e. we already tried to fix history
+, but we
    # sent malfunctioning phase corrections. Now, we fix the fix.
    if($msg->content == PHASECORR_WAS_BAD) {
      $msg->delete;
      $spacetime->info("Flyer: Sending good phase corrections...");
      $spacetime->send_to(TIME_VOY_CORRECTIONS, PHASECORR_GOOD);
      return;
    }
  }

  # Our first fix.
  $spacetime->info("Flyer: Sending bad phase corrections...");
  $spacetime->send(PHASECORR_WAS_BAD);
  $spacetime->send_to(TIME_VOY_CORRECTIONS, PHASECORR_BAD);
}
[download]