t/basic.t

   1 use strictures 1;
   2 use Test::More;
   3 use aliased 'DX::Op::FromCode';
   4 use aliased 'DX::ArrayStream';
   5 use DX::Var;
   6 use DX::State;
   7
   8 my @servers = qw(
   9   kitty.scsys.co.uk
  10   jim.example.com
  11   joe.example.com
  12   pryde.scsys.co.uk
  13   bob.example.com
  14 );
  15
  16 my @shells = qw(csh bash);
  17
  18 my %shells = (
  19   bash => { map +($_ => 1),
  20              qw(joe.example.com kitty.scsys.co.uk pryde.scsys.co.uk) },
  21   csh => { map +($_ => 1),
  22              qw(jim.example.com joe.example.com bob.example.com) },
  23 );
  24
  25 sub bind_array {
  26   my ($var, $array) = @_;
  27   sub {
  28     my ($self, $state) = @_;
  29     $state->bind_stream_then(
  30       $state->scope_var($var),
  31       ArrayStream->from_array(@$array),
  32       $self->next
  33     )
  34   }
  35 }
  36
  37 my $op = FromCode->new(
  38   code => bind_array(S => \@servers),
  39   next => FromCode->new(
  40     code => sub {
  41       my ($self, $state) = @_;
  42       my $server = $state->scope_var('S')->bound_value;
  43       if ($server =~ /\.example\.com$/) {
  44         return $state->then($self->next);
  45       }
  46       return $state->backtrack;
  47     },
  48   )
  49 );
  50
  51 my %scope = map +($_ => $_), qw(S);
  52 my %by_id = map +($_ => DX::Var->new(id => $_)), qw(S);
  53
  54 my $state = DX::State->new(
  55   next_op => $op,
  56   return_stack => [],
  57   by_id => \%by_id,
  58   scope => \%scope,
  59   last_choice => []
  60 );
  61
  62 while (my $op = $state->next_op) {
  63   $state = $op->run($state);
  64   ::Dwarn($state);
  65 }
  66
  67 is($state->scope_var('S')->bound_value, 'jim.example.com');
  68
  69 done_testing;