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