use DX::Solver;
use DX::SetOver;
use DX::Observer::FromCode;
+use DX::Action::FromCode;
+use File::Spec;
use Test::Exception;
{
use Moo;
+ with 'DX::Role::Fact';
+
has path => (is => 'ro', required => 1);
- has info => (is => 'ro', required => 1);
+ has info => (is => 'ro', predicate => 1);
package My::PathStatusInfo;
use Moo;
+ with 'DX::Role::Fact';
+
has is_directory => (is => 'ro', default => 0);
has is_file => (is => 'ro', default => 0);
has mode => (is => 'ro', required => 1);
),
);
+my %empty = (
+ '.ssh' => My::PathStatus->new(
+ path => '.ssh'
+ ),
+ '.ssh/authorized_keys' => My::PathStatus->new(
+ path => '.ssh/authorized_keys'
+ )
+);
+
my %path_status;
my $solver = DX::Solver->new(
$solver->add_rule(@$_) for (
[ path_status => [ qw(PS) ],
- [ member_of => 'PS', [ value => 'path_status' ] ] ],
+ [ member_of => 'PS', \'path_status' ] ],
[ path => [ qw(PS P) ],
- [ constrain => [ qw(PS P) ], sub { $_[0]->path eq $_[1] } ] ],
+ [ prop => 'PS', \'path', 'P' ] ],
+ [ info_prop => [ qw(PS N V) ],
+ [ prop => 'PS', \'info', 'PSI' ],
+ [ prop => 'PSI', 'N', 'V' ] ],
[ mode => [ qw(PS M) ],
- [ constrain => [ qw(PS M) ],
- sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
+ [ info_prop => 'PS', \'mode', 'M' ] ],
+ [ exists_path => [ qw(PS) ],
+ [ info_prop => 'PS', \'is_directory', \1 ] ],
+ [ exists_path => [ qw(PS) ],
+ [ info_prop => 'PS', \'is_file', \1 ] ],
[ is_directory => [ qw(PS) ],
- [ constrain => [ qw(PS) ],
- sub { $_[0]->info and $_[0]->info->is_directory } ] ],
+ [ info_prop => 'PS', \'is_directory', \1 ] ],
[ is_file => [ qw(PS) ],
- [ constrain => [ qw(PS) ],
- sub { $_[0]->info and $_[0]->info->is_file } ] ],
+ [ info_prop => 'PS', \'is_file', \1 ] ],
);
%path_status = %protos;
sub paths_for_simple {
- join ' ', map $_->{PS}->path, $solver->query(
- [ qw(PS) ], [ path_status => 'PS' ], @_
+ join ' ', map $_->value_for('PS')->path, $solver->solve(
+ [ path_status => 'PS' ], @_
)->results;
}
is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys');
-is(paths_for_simple([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
+is(paths_for_simple([ mode => 'PS', \'0755' ]), '.ssh');
$solver->add_rule(
path_status_at => [ 'PS', 'P' ],
);
throws_ok {
- $solver->query(
- [ qw(PS) ],
- [ path_status_at => 'PS', [ value => '.ssh' ] ]
+ $solver->solve(
+ [ path_status_at => 'PS', \'.ssh' ]
)->results
} qr/ARGH/;
my @res;
lives_ok {
- @res = $solver->query(
- [ qw(PS) ],
- [ path_status_at => 'PS', [ value => '.ssh' ] ]
+ @res = $solver->solve(
+ [ path_status_at => 'PS', \'.ssh' ]
)->results
};
-is(join(' ', map $_->{PS}->path, @res), '.ssh');
+is(join(' ', map $_->value_for('PS')->path, @res), '.ssh');
delete $solver->rule_set->rules->{'path_status_at/2'};
[ path => qw(PS P) ],
);
-%path_status = ('.ssh/authorized_keys' => $protos{'.ssh/authorized_keys'});
+%path_status = ();
$ob_res{'.ssh'} = $protos{'.ssh'};
sub paths_for {
- join ' ', map $_->{PS}->path, $solver->query([ 'PS' ], @_)->results;
+ join ' ', map $_->value_for('PS')->path, $solver->solve(@_)->results;
}
is(
- paths_for([ path_status => 'PS' ], [ path => 'PS', [ value => '.ssh' ] ]),
+ paths_for([ path_status => 'PS' ], [ path => 'PS', \'.ssh' ]),
'',
'no .ssh entry'
);
-throws_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
+throws_ok { paths_for([ path_status_at => 'PS', \'.ssh' ]) }
qr/refused/;
$solver->{observation_policy} = sub { 1 };
is(
- paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]),
+ paths_for([ path_status_at => 'PS', \'.ssh' ]),
'.ssh',
'observation'
);
delete $solver->{observation_policy};
-lives_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
+lives_ok { paths_for([ path_status_at => 'PS', \'.ssh' ]) }
'No observation required anymore';
+$path_status{'.ssh/authorized_keys'} = $protos{'.ssh/authorized_keys'};
+
+is(
+ paths_for([ path_status => 'PS' ], [ not => [ is_directory => 'PS' ] ]),
+ '.ssh/authorized_keys',
+ 'Negation'
+);
+
+$solver->add_rule(@$_) for (
+ [ directory_at => [ qw(PS P) ],
+ [ path_status_at => qw(PS P) ],
+ [ is_directory => 'PS' ] ],
+ [ file_at => [ qw(PS P) ],
+ [ path_status_at => qw(PS P) ],
+ [ is_file => 'PS' ] ],
+);
+
+%path_status = ();
+
+$ob_res{'.ssh'} = $empty{'.ssh'};
+
+#%path_status = %protos;
+
+$solver->{observation_policy} = sub { 1 };
+
+sub dot_ssh_query {
+ $solver->solve([ directory_at => 'PS' => \'.ssh' ]);
+}
+
+is_deeply(
+ [ dot_ssh_query()->results ],
+ []
+);
+
+#::Dwarn(paths_for([ directory_at => 'PS', \'.ssh' ]));
+
+$solver->add_rule(@$_) for (
+ [ is_directory => [ qw(PS) ],
+ [ not => [ exists_path => 'PS' ] ],
+ [ act => [ 'PS' ],
+ sub {
+ my ($value) = @_;
+ DX::Action::FromCode->new(
+ expect => sub {
+ (path_status => My::PathStatus->new(
+ path => $value->path,
+ info => My::PathStatusInfo->new(
+ is_directory => 1, mode => ''
+ )
+ ))
+ },
+ perform => sub {
+ $ob_res{$value->path} = $protos{$value->path};
+ (path_status => $value);
+ }
+ )
+ } ] ]
+);
+
+%path_status = ();
+
+@res = dot_ssh_query()->results;
+
+is(scalar(@res),1,'Single result');
+
+is($path_status{'.ssh'}, $empty{'.ssh'}, 'Empty observed');
+
+is(
+ scalar(my ($action) = $res[0]->actions), 1
+);
+
+$solver->run_action($action);
+
+ok(!$path_status{'.ssh'}, 'Empty retracted');
+
+@res = dot_ssh_query()->results;
+
+is(scalar(@res),1,'Single result');
+
+is($path_status{'.ssh'}, $protos{'.ssh'}, 'Created observed');
+
+ok(!$res[0]->actions, 'No action');
+
+$solver->add_predicate(
+ catfile => [ qw(DirPath FileName FilePath) ],
+ [ qw(+ + -) ] => sub {
+ +(FilePath => [ value => File::Spec->catfile($_{DirPath}, $_{FileName}) ])
+ },
+);
+
+$solver->add_rule(@$_) for (
+ [ file_in => [ qw(DirStatus FileName FileStatus) ],
+ [ is_directory => qw(DirStatus) ],
+ [ path => qw(DirStatus DirPath) ],
+ [ catfile => qw(DirPath FileName FilePath) ],
+ [ file_at => qw(FileStatus FilePath) ] ],
+ [ is_file => [ qw(PS) ],
+ [ not => [ exists_path => 'PS' ] ],
+ [ act => [ 'PS' ],
+ sub {
+ my ($value) = @_;
+ DX::Action::FromCode->new(
+ expect => sub {
+ (path_status => My::PathStatus->new(
+ path => $value->path,
+ info => My::PathStatusInfo->new(
+ is_file => 1, mode => ''
+ )
+ ))
+ },
+ perform => sub {
+ $ob_res{$value->path} = $protos{$value->path};
+ (path_status => $value);
+ }
+ )
+ } ] ]
+);
+
+%path_status = ();
+%ob_res = %empty;
+
+sub keys_file {
+ $solver->solve(
+ [ directory_at => 'D' => \'.ssh' ],
+ [ file_in => 'D' => \'authorized_keys' => 'F' ],
+ );
+}
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(scalar(my @act = $res[0]->actions), 2, 'Two actions');
+
+#::Dwarn(\@act);
+
+is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible');
+
+$solver->run_action($poss);
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(
+ scalar(($poss) = grep !@{$_->dependencies}, $res[0]->actions), 1,
+ 'One possible'
+);
+
+$solver->run_action($poss);
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(scalar($res[0]->actions), 0, 'No actions');
+
done_testing;
projects / scpubgit/DKit.git / blobdiff