Commit | Line | Data |
60cda014 |
1 | use strictures 1; |
2 | use Test::More; |
3 | use aliased 'DX::Op::FromCode'; |
4 | use aliased 'DX::ArrayStream'; |
94565614 |
5 | use DX::ResultStream; |
60cda014 |
6 | use DX::Var; |
7 | use DX::State; |
94565614 |
8 | use Test::Exception; |
60cda014 |
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 | |
5622b4df |
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 | |
60cda014 |
51 | my $op = FromCode->new( |
52 | code => bind_array(S => \@servers), |
53 | next => FromCode->new( |
5622b4df |
54 | code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }) |
60cda014 |
55 | ) |
56 | ); |
57 | |
5622b4df |
58 | sub make_state { |
59 | my ($vars, $op) = @_; |
60cda014 |
60 | |
5622b4df |
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 | } |
60cda014 |
72 | |
5622b4df |
73 | my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op)); |
94565614 |
74 | |
75 | is($stream->next->{'S'}, $_) |
76 | for qw(jim.example.com joe.example.com bob.example.com); |
60cda014 |
77 | |
5622b4df |
78 | is($stream->next, undef, 'No more'); |
79 | |
5622b4df |
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 | |
26300a7d |
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 | ); |
60cda014 |
107 | |
71d26209 |
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 | |
60cda014 |
147 | done_testing; |