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::ResultStream;
   6 use DX::Var;
   7 use DX::State;
   8 use Test::Exception;
   9
  10 my @servers = qw(
  11   kitty.scsys.co.uk
  12   jim.example.com
  13   joe.example.com
  14   pryde.scsys.co.uk
  15   bob.example.com
  16 );
  17
  18 my @shells = qw(csh bash);
  19
  20 my %shells = (
  21   bash => { map +($_ => 1),
  22              qw(joe.example.com kitty.scsys.co.uk pryde.scsys.co.uk) },
  23   csh => { map +($_ => 1),
  24              qw(jim.example.com joe.example.com bob.example.com) },
  25 );
  26
  27 sub bind_array {
  28   my ($var, $array) = @_;
  29   sub {
  30     my ($self, $state) = @_;
  31     $state->bind_stream_then(
  32       $state->scope_var($var),
  33       ArrayStream->from_array(@$array),
  34       $self->next
  35     )
  36   }
  37 }
  38
  39 sub test_values {
  40   my ($vars, $test) = @_;
  41   sub {
  42     my ($self, $state) = @_;
  43     my @values = map $state->scope_var($_)->bound_value, @$vars;
  44     if ($test->(@values)) {
  45       return $state->then($self->next);
  46     }
  47     return $state->backtrack;
  48   }
  49 }
  50
  51 my $op = FromCode->new(
  52   code => bind_array(S => \@servers),
  53   next => FromCode->new(
  54     code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ })
  55   )
  56 );
  57
  58 sub make_state {
  59   my ($vars, $op) = @_;
  60
  61   my %scope = map +($_ => $_), @{$vars};
  62   my %by_id = map +($_ => DX::Var->new(id => $_)), @{$vars};
  63
  64   DX::State->new(
  65     next_op => $op,
  66     return_stack => [],
  67     by_id => \%by_id,
  68     scope => \%scope,
  69     last_choice => []
  70   );
  71 }
  72
  73 my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op));
  74
  75 is($stream->next->{'S'}, $_)
  76   for qw(jim.example.com joe.example.com bob.example.com);
  77
  78 is($stream->next, undef, 'No more');
  79
  80 my $complex_op = FromCode->new(
  81   code => bind_array(S => \@servers),
  82   next => FromCode->new(
  83     code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
  84     next => FromCode->new(
  85       code => bind_array(P => \@shells),
  86       next => FromCode->new(
  87         code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
  88       )
  89     )
  90   )
  91 );
  92
  93 my $cstream = DX::ResultStream->new(
  94   for_state => make_state([ qw(S P) ], $complex_op)
  95 );
  96
  97 is_deeply(
  98   [ $cstream->results ],
  99   [
 100     { P => 'csh', S => 'jim.example.com' },
 101     { P => 'csh', S => 'joe.example.com' },
 102     { P => 'bash', S => 'joe.example.com' },
 103     { P => 'csh', S => 'bob.example.com' },
 104   ],
 105   'Complex stream'
 106 );
 107
 108 my $call_op = FromCode->new(
 109   code => sub {
 110     my ($self, $state) = @_;
 111     my @rst = @{$state->return_stack};
 112     my $save_scope = $state->scope;
 113     my %scope = (S => $save_scope->{S});
 114     my $ret_op = FromCode->new(
 115       code => sub { $_[1]->new(%{$_[1]}, scope => $save_scope, next_op => $_[0]->next) },
 116       next => $self->next,
 117     );
 118     $state->new(%$state,
 119       scope => \%scope,
 120       return_stack => [ @rst, $ret_op ],
 121       next_op => $op
 122     );
 123   },
 124   next => FromCode->new(
 125     code => bind_array(P => \@shells),
 126     next => FromCode->new(
 127       code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
 128     )
 129   )
 130 );
 131
 132 my $callstream = DX::ResultStream->new(
 133   for_state => make_state([ qw(S P) ], $call_op)
 134 );
 135
 136 is_deeply(
 137   [ $callstream->results ],
 138   [
 139     { P => 'csh', S => 'jim.example.com' },
 140     { P => 'csh', S => 'joe.example.com' },
 141     { P => 'bash', S => 'joe.example.com' },
 142     { P => 'csh', S => 'bob.example.com' },
 143   ],
 144   'Call stream'
 145 );
 146
 147 done_testing;