Commit | Line | Data |
9a4942da |
1 | use strictures 1; |
2 | use Test::More; |
3 | use DX::Solver; |
4 | use DX::SetOver; |
5ef4d923 |
5 | use DX::Observer::FromCode; |
71217e42 |
6 | use DX::Action::FromCode; |
deec7cc4 |
7 | use File::Spec; |
734376d9 |
8 | use Test::Exception; |
9a4942da |
9 | |
10 | { |
11 | package My::PathStatus; |
12 | |
13 | use Moo; |
14 | |
9c7b21a2 |
15 | with 'DX::Role::Fact'; |
16 | |
9a4942da |
17 | has path => (is => 'ro', required => 1); |
859049a3 |
18 | has info => (is => 'ro', predicate => 1); |
9a4942da |
19 | |
20 | package My::PathStatusInfo; |
21 | |
22 | use Moo; |
23 | |
9c7b21a2 |
24 | with 'DX::Role::Fact'; |
25 | |
9a4942da |
26 | has is_directory => (is => 'ro', default => 0); |
27 | has is_file => (is => 'ro', default => 0); |
28 | has mode => (is => 'ro', required => 1); |
29 | } |
30 | |
31 | @INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__); |
32 | |
33 | my %protos = ( |
34 | '.ssh' => My::PathStatus->new( |
35 | path => '.ssh', |
36 | info => My::PathStatusInfo->new(is_directory => 1, mode => '0755') |
37 | ), |
38 | '.ssh/authorized_keys' => My::PathStatus->new( |
39 | path => '.ssh/authorized_keys', |
40 | info => My::PathStatusInfo->new(is_file => 1, mode => '0644') |
41 | ), |
42 | ); |
43 | |
71217e42 |
44 | my %empty = ( |
45 | '.ssh' => My::PathStatus->new( |
46 | path => '.ssh' |
deec7cc4 |
47 | ), |
48 | '.ssh/authorized_keys' => My::PathStatus->new( |
49 | path => '.ssh/authorized_keys' |
71217e42 |
50 | ) |
51 | ); |
52 | |
9a4942da |
53 | my %path_status; |
54 | |
55 | my $solver = DX::Solver->new( |
56 | facts => { path_status => DX::SetOver->new( |
57 | over => 'path', |
58 | values => \%path_status, |
59 | ) }, |
60 | ); |
61 | |
734376d9 |
62 | $solver->add_rule(@$_) for ( |
9a4942da |
63 | [ path_status => [ qw(PS) ], |
e183503f |
64 | [ member_of => 'PS', \'path_status' ] ], |
9a4942da |
65 | [ path => [ qw(PS P) ], |
e183503f |
66 | [ prop => 'PS', \'path', 'P' ] ], |
67 | [ info_prop => [ qw(PS N V) ], |
a5c3a041 |
68 | [ prop => 'PS', \'info', 'PSI' ], |
69 | [ prop => 'PSI', 'N', 'V' ] ], |
e183503f |
70 | [ mode => [ qw(PS M) ], |
71 | [ info_prop => 'PS', \'mode', 'M' ] ], |
71217e42 |
72 | [ exists_path => [ qw(PS) ], |
e183503f |
73 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
859049a3 |
74 | [ exists_path => [ qw(PS) ], |
e183503f |
75 | [ info_prop => 'PS', \'is_file', \1 ] ], |
9a4942da |
76 | [ is_directory => [ qw(PS) ], |
e183503f |
77 | [ info_prop => 'PS', \'is_directory', \1 ] ], |
9a4942da |
78 | [ is_file => [ qw(PS) ], |
e183503f |
79 | [ info_prop => 'PS', \'is_file', \1 ] ], |
9a4942da |
80 | ); |
81 | |
9a4942da |
82 | %path_status = %protos; |
83 | |
5ef4d923 |
84 | sub paths_for_simple { |
deec7cc4 |
85 | join ' ', map $_->value_for('PS')->path, $solver->query( |
734376d9 |
86 | [ qw(PS) ], [ path_status => 'PS' ], @_ |
9a4942da |
87 | )->results; |
88 | } |
89 | |
5ef4d923 |
90 | is(paths_for_simple(), '.ssh .ssh/authorized_keys'); |
9a4942da |
91 | |
5ef4d923 |
92 | is(paths_for_simple([ is_directory => 'PS' ]), '.ssh'); |
9a4942da |
93 | |
5ef4d923 |
94 | is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys'); |
9a4942da |
95 | |
5ef4d923 |
96 | is(paths_for_simple([ mode => 'PS', [ value => '0755' ] ]), '.ssh'); |
734376d9 |
97 | |
98 | $solver->add_rule( |
99 | path_status_at => [ 'PS', 'P' ], |
100 | [ path_status => 'PS' ], |
101 | [ path => qw(PS P) ], |
102 | ); |
103 | $solver->add_rule( |
104 | path_status_at => [ 'PS', 'P' ], |
105 | [ constrain => [] => sub { die "ARGH" } ] |
106 | ); |
107 | |
108 | throws_ok { |
109 | $solver->query( |
110 | [ qw(PS) ], |
111 | [ path_status_at => 'PS', [ value => '.ssh' ] ] |
112 | )->results |
113 | } qr/ARGH/; |
114 | |
115 | delete $solver->rule_set->rules->{'path_status_at/2'}; |
116 | |
117 | $solver->add_rule( |
118 | path_status_at => [ 'PS', 'P' ], |
119 | [ path_status => 'PS' ], |
120 | [ path => qw(PS P) ], |
121 | [ 'cut' ], |
122 | ); |
123 | $solver->add_rule( |
124 | path_status_at => [ 'PS', 'P' ], |
125 | [ constrain => [] => sub { die "ARGH" } ] |
126 | ); |
127 | |
128 | my @res; |
129 | |
130 | lives_ok { |
131 | @res = $solver->query( |
132 | [ qw(PS) ], |
133 | [ path_status_at => 'PS', [ value => '.ssh' ] ] |
134 | )->results |
135 | }; |
136 | |
deec7cc4 |
137 | is(join(' ', map $_->value_for('PS')->path, @res), '.ssh'); |
734376d9 |
138 | |
5ef4d923 |
139 | delete $solver->rule_set->rules->{'path_status_at/2'}; |
140 | |
141 | $solver->add_rule( |
142 | path_status_at => [ 'PS', 'P' ], |
143 | [ path_status => 'PS' ], |
144 | [ path => qw(PS P) ], |
145 | [ 'cut' ], |
146 | ); |
147 | |
148 | my %ob_res; |
149 | |
150 | $solver->add_rule( |
151 | path_status_at => [ 'PS', 'P' ], |
152 | [ observe => [ 'P' ], |
153 | sub { |
154 | my ($path) = $_[0]; |
155 | DX::Observer::FromCode->new( |
156 | code => sub { (path_status => $ob_res{$path}) } |
157 | ) |
158 | } |
159 | ], |
160 | [ path_status => 'PS' ], |
161 | [ path => qw(PS P) ], |
162 | ); |
163 | |
71217e42 |
164 | %path_status = (); |
5ef4d923 |
165 | |
166 | $ob_res{'.ssh'} = $protos{'.ssh'}; |
167 | |
168 | sub paths_for { |
deec7cc4 |
169 | join ' ', map $_->value_for('PS')->path, $solver->query([ 'PS' ], @_)->results; |
5ef4d923 |
170 | } |
171 | |
172 | is( |
173 | paths_for([ path_status => 'PS' ], [ path => 'PS', [ value => '.ssh' ] ]), |
174 | '', |
175 | 'no .ssh entry' |
176 | ); |
177 | |
178 | throws_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) } |
179 | qr/refused/; |
180 | |
181 | $solver->{observation_policy} = sub { 1 }; |
182 | |
183 | is( |
184 | paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]), |
185 | '.ssh', |
186 | 'observation' |
187 | ); |
188 | |
189 | is($path_status{'.ssh'}, $ob_res{'.ssh'}); |
190 | |
191 | delete $solver->{observation_policy}; |
192 | |
193 | lives_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) } |
194 | 'No observation required anymore'; |
734376d9 |
195 | |
71217e42 |
196 | $path_status{'.ssh/authorized_keys'} = $protos{'.ssh/authorized_keys'}; |
197 | |
198 | is( |
199 | paths_for([ path_status => 'PS' ], [ not => [ is_directory => 'PS' ] ]), |
200 | '.ssh/authorized_keys', |
201 | 'Negation' |
202 | ); |
203 | |
204 | $solver->add_rule(@$_) for ( |
205 | [ directory_at => [ qw(PS P) ], |
206 | [ path_status_at => qw(PS P) ], |
207 | [ is_directory => 'PS' ] ], |
deec7cc4 |
208 | [ file_at => [ qw(PS P) ], |
209 | [ path_status_at => qw(PS P) ], |
210 | [ is_file => 'PS' ] ], |
71217e42 |
211 | ); |
212 | |
213 | %path_status = (); |
214 | |
215 | $ob_res{'.ssh'} = $empty{'.ssh'}; |
216 | |
217 | #%path_status = %protos; |
218 | |
219 | $solver->{observation_policy} = sub { 1 }; |
220 | |
221 | sub dot_ssh_query { |
222 | $solver->query([ 'PS' ], [ directory_at => 'PS' => [ value => '.ssh' ] ]); |
223 | } |
224 | |
225 | is_deeply( |
226 | [ dot_ssh_query()->results ], |
227 | [] |
228 | ); |
229 | |
230 | #::Dwarn(paths_for([ directory_at => 'PS', [ value => '.ssh' ] ])); |
231 | |
232 | $solver->add_rule(@$_) for ( |
233 | [ is_directory => [ qw(PS) ], |
234 | [ not => [ exists_path => 'PS' ] ], |
235 | [ act => [ 'PS' ], |
236 | sub { |
4ce2e778 |
237 | my ($value) = @_; |
71217e42 |
238 | DX::Action::FromCode->new( |
239 | expect => sub { |
4ce2e778 |
240 | (path_status => My::PathStatus->new( |
71217e42 |
241 | path => $value->path, |
242 | info => My::PathStatusInfo->new( |
243 | is_directory => 1, mode => '' |
244 | ) |
245 | )) |
246 | }, |
247 | perform => sub { |
248 | $ob_res{$value->path} = $protos{$value->path}; |
249 | (path_status => $value); |
250 | } |
251 | ) |
252 | } ] ] |
253 | ); |
254 | |
255 | %path_status = (); |
256 | |
257 | @res = dot_ssh_query()->results; |
258 | |
259 | is(scalar(@res),1,'Single result'); |
260 | |
261 | is($path_status{'.ssh'}, $empty{'.ssh'}, 'Empty observed'); |
262 | |
deec7cc4 |
263 | is( |
264 | scalar(my ($action) = $res[0]->actions), 1 |
265 | ); |
71217e42 |
266 | |
e7117efc |
267 | $solver->run_action($action); |
71217e42 |
268 | |
269 | ok(!$path_status{'.ssh'}, 'Empty retracted'); |
270 | |
271 | @res = dot_ssh_query()->results; |
272 | |
273 | is(scalar(@res),1,'Single result'); |
274 | |
275 | is($path_status{'.ssh'}, $protos{'.ssh'}, 'Created observed'); |
276 | |
deec7cc4 |
277 | ok(!$res[0]->actions, 'No action'); |
278 | |
37e9670d |
279 | $solver->add_predicate( |
280 | catfile => [ qw(DirPath FileName FilePath) ], |
281 | [ qw(+ + -) ] => sub { |
282 | +(FilePath => [ value => File::Spec->catfile($_{DirPath}, $_{FileName}) ]) |
283 | }, |
284 | ); |
285 | |
deec7cc4 |
286 | $solver->add_rule(@$_) for ( |
deec7cc4 |
287 | [ file_in => [ qw(DirStatus FileName FileStatus) ], |
288 | [ is_directory => qw(DirStatus) ], |
a5c3a041 |
289 | [ path => qw(DirStatus DirPath) ], |
290 | [ catfile => qw(DirPath FileName FilePath) ], |
291 | [ file_at => qw(FileStatus FilePath) ] ], |
deec7cc4 |
292 | [ is_file => [ qw(PS) ], |
293 | [ not => [ exists_path => 'PS' ] ], |
294 | [ act => [ 'PS' ], |
295 | sub { |
4ce2e778 |
296 | my ($value) = @_; |
deec7cc4 |
297 | DX::Action::FromCode->new( |
298 | expect => sub { |
4ce2e778 |
299 | (path_status => My::PathStatus->new( |
deec7cc4 |
300 | path => $value->path, |
301 | info => My::PathStatusInfo->new( |
302 | is_file => 1, mode => '' |
303 | ) |
304 | )) |
305 | }, |
306 | perform => sub { |
307 | $ob_res{$value->path} = $protos{$value->path}; |
308 | (path_status => $value); |
309 | } |
310 | ) |
311 | } ] ] |
312 | ); |
313 | |
314 | %path_status = (); |
315 | %ob_res = %empty; |
316 | |
317 | sub keys_file { |
318 | $solver->query([ qw(D F) ], |
319 | [ directory_at => 'D' => \'.ssh' ], |
320 | [ file_in => 'D' => \'authorized_keys' => 'F' ], |
321 | ); |
322 | } |
323 | |
324 | @res = keys_file()->results; |
325 | |
326 | is(scalar @res, 1, 'One result'); |
327 | |
328 | is(scalar(my @act = $res[0]->actions), 2, 'Two actions'); |
329 | |
4ce2e778 |
330 | #::Dwarn(\@act); |
331 | |
deec7cc4 |
332 | is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible'); |
333 | |
e7117efc |
334 | $solver->run_action($poss); |
deec7cc4 |
335 | |
336 | @res = keys_file()->results; |
337 | |
338 | is(scalar @res, 1, 'One result'); |
339 | |
340 | is( |
341 | scalar(($poss) = grep !@{$_->dependencies}, $res[0]->actions), 1, |
342 | 'One possible' |
343 | ); |
344 | |
e7117efc |
345 | $solver->run_action($poss); |
deec7cc4 |
346 | |
347 | @res = keys_file()->results; |
348 | |
349 | is(scalar @res, 1, 'One result'); |
350 | |
351 | is(scalar($res[0]->actions), 0, 'No actions'); |
71217e42 |
352 | |
734376d9 |
353 | done_testing; |