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