5 use DX::Observer::FromCode;
6 use DX::Action::FromCode;
11 package My::PathStatus;
15 has path => (is => 'ro', required => 1);
16 has info => (is => 'ro', predicate => 1);
18 package My::PathStatusInfo;
22 has is_directory => (is => 'ro', default => 0);
23 has is_file => (is => 'ro', default => 0);
24 has mode => (is => 'ro', required => 1);
27 @INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__);
30 '.ssh' => My::PathStatus->new(
32 info => My::PathStatusInfo->new(is_directory => 1, mode => '0755')
34 '.ssh/authorized_keys' => My::PathStatus->new(
35 path => '.ssh/authorized_keys',
36 info => My::PathStatusInfo->new(is_file => 1, mode => '0644')
41 '.ssh' => My::PathStatus->new(
44 '.ssh/authorized_keys' => My::PathStatus->new(
45 path => '.ssh/authorized_keys'
51 my $solver = DX::Solver->new(
52 facts => { path_status => DX::SetOver->new(
54 values => \%path_status,
58 $solver->add_rule(@$_) for (
59 [ path_status => [ qw(PS) ],
60 [ member_of => 'PS', \'path_status' ] ],
61 [ path => [ qw(PS P) ],
62 [ prop => 'PS', \'path', 'P' ] ],
63 [ info_prop => [ qw(PS N V) ],
64 [ exists => [ qw(PSI) ],
65 [ prop => 'PS', \'info', 'PSI' ],
66 [ prop => 'PSI', 'N', 'V' ] ] ],
67 [ mode => [ qw(PS M) ],
68 [ info_prop => 'PS', \'mode', 'M' ] ],
69 [ exists_path => [ qw(PS) ],
70 [ info_prop => 'PS', \'is_directory', \1 ] ],
71 [ exists_path => [ qw(PS) ],
72 [ info_prop => 'PS', \'is_file', \1 ] ],
73 [ is_directory => [ qw(PS) ],
74 [ info_prop => 'PS', \'is_directory', \1 ] ],
75 [ is_file => [ qw(PS) ],
76 [ info_prop => 'PS', \'is_file', \1 ] ],
79 %path_status = %protos;
81 sub paths_for_simple {
82 join ' ', map $_->value_for('PS')->path, $solver->query(
83 [ qw(PS) ], [ path_status => 'PS' ], @_
87 is(paths_for_simple(), '.ssh .ssh/authorized_keys');
89 is(paths_for_simple([ is_directory => 'PS' ]), '.ssh');
91 is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys');
93 is(paths_for_simple([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
96 path_status_at => [ 'PS', 'P' ],
97 [ path_status => 'PS' ],
101 path_status_at => [ 'PS', 'P' ],
102 [ constrain => [] => sub { die "ARGH" } ]
108 [ path_status_at => 'PS', [ value => '.ssh' ] ]
112 delete $solver->rule_set->rules->{'path_status_at/2'};
115 path_status_at => [ 'PS', 'P' ],
116 [ path_status => 'PS' ],
117 [ path => qw(PS P) ],
121 path_status_at => [ 'PS', 'P' ],
122 [ constrain => [] => sub { die "ARGH" } ]
128 @res = $solver->query(
130 [ path_status_at => 'PS', [ value => '.ssh' ] ]
134 is(join(' ', map $_->value_for('PS')->path, @res), '.ssh');
136 delete $solver->rule_set->rules->{'path_status_at/2'};
139 path_status_at => [ 'PS', 'P' ],
140 [ path_status => 'PS' ],
141 [ path => qw(PS P) ],
148 path_status_at => [ 'PS', 'P' ],
149 [ observe => [ 'P' ],
152 DX::Observer::FromCode->new(
153 code => sub { (path_status => $ob_res{$path}) }
157 [ path_status => 'PS' ],
158 [ path => qw(PS P) ],
163 $ob_res{'.ssh'} = $protos{'.ssh'};
166 join ' ', map $_->value_for('PS')->path, $solver->query([ 'PS' ], @_)->results;
170 paths_for([ path_status => 'PS' ], [ path => 'PS', [ value => '.ssh' ] ]),
175 throws_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
178 $solver->{observation_policy} = sub { 1 };
181 paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]),
186 is($path_status{'.ssh'}, $ob_res{'.ssh'});
188 delete $solver->{observation_policy};
190 lives_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
191 'No observation required anymore';
193 $path_status{'.ssh/authorized_keys'} = $protos{'.ssh/authorized_keys'};
196 paths_for([ path_status => 'PS' ], [ not => [ is_directory => 'PS' ] ]),
197 '.ssh/authorized_keys',
201 $solver->add_rule(@$_) for (
202 [ directory_at => [ qw(PS P) ],
203 [ path_status_at => qw(PS P) ],
204 [ is_directory => 'PS' ] ],
205 [ file_at => [ qw(PS P) ],
206 [ path_status_at => qw(PS P) ],
207 [ is_file => 'PS' ] ],
212 $ob_res{'.ssh'} = $empty{'.ssh'};
214 #%path_status = %protos;
216 $solver->{observation_policy} = sub { 1 };
219 $solver->query([ 'PS' ], [ directory_at => 'PS' => [ value => '.ssh' ] ]);
223 [ dot_ssh_query()->results ],
227 #::Dwarn(paths_for([ directory_at => 'PS', [ value => '.ssh' ] ]));
229 $solver->add_rule(@$_) for (
230 [ is_directory => [ qw(PS) ],
231 [ not => [ exists_path => 'PS' ] ],
235 DX::Action::FromCode->new(
237 (path_status => My::PathStatus->new(
238 path => $value->path,
239 info => My::PathStatusInfo->new(
240 is_directory => 1, mode => ''
245 $ob_res{$value->path} = $protos{$value->path};
246 (path_status => $value);
254 @res = dot_ssh_query()->results;
256 is(scalar(@res),1,'Single result');
258 is($path_status{'.ssh'}, $empty{'.ssh'}, 'Empty observed');
261 scalar(my ($action) = $res[0]->actions), 1
264 $solver->run_action($action);
266 ok(!$path_status{'.ssh'}, 'Empty retracted');
268 @res = dot_ssh_query()->results;
270 is(scalar(@res),1,'Single result');
272 is($path_status{'.ssh'}, $protos{'.ssh'}, 'Created observed');
274 ok(!$res[0]->actions, 'No action');
276 $solver->add_predicate(
277 catfile => [ qw(DirPath FileName FilePath) ],
278 [ qw(+ + -) ] => sub {
279 +(FilePath => [ value => File::Spec->catfile($_{DirPath}, $_{FileName}) ])
283 $solver->add_rule(@$_) for (
284 [ file_in => [ qw(DirStatus FileName FileStatus) ],
285 [ is_directory => qw(DirStatus) ],
286 [ exists => [ qw(DirPath) ],
287 [ path => qw(DirStatus DirPath) ],
288 [ exists => [ qw(FilePath) ],
289 [ catfile => qw(DirPath FileName FilePath) ],
290 [ file_at => qw(FileStatus FilePath) ] ] ] ],
291 [ is_file => [ qw(PS) ],
292 [ not => [ exists_path => 'PS' ] ],
296 DX::Action::FromCode->new(
298 (path_status => My::PathStatus->new(
299 path => $value->path,
300 info => My::PathStatusInfo->new(
301 is_file => 1, mode => ''
306 $ob_res{$value->path} = $protos{$value->path};
307 (path_status => $value);
317 $solver->query([ qw(D F) ],
318 [ directory_at => 'D' => \'.ssh' ],
319 [ file_in => 'D' => \'authorized_keys' => 'F' ],
323 @res = keys_file()->results;
325 is(scalar @res, 1, 'One result');
327 is(scalar(my @act = $res[0]->actions), 2, 'Two actions');
331 is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible');
333 $solver->run_action($poss);
335 @res = keys_file()->results;
337 is(scalar @res, 1, 'One result');
340 scalar(($poss) = grep !@{$_->dependencies}, $res[0]->actions), 1,
344 $solver->run_action($poss);
346 @res = keys_file()->results;
348 is(scalar @res, 1, 'One result');
350 is(scalar($res[0]->actions), 0, 'No actions');