Commit | Line | Data |
60cda014 |
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; |