allow value scalarref, refactor

[scpubgit/DKit.git] / t / dot_ssh.t

diff --git a/t/dot_ssh.t b/t/dot_ssh.t
index 58f36e6..6e0a1c6 100644 (file)
--- a/t/dot_ssh.t
+++ b/t/dot_ssh.t
@@ -2,6 +2,8 @@ use strictures 1;
 use Test::More;
 use DX::Solver;
 use DX::SetOver;
+use DX::Observer::FromCode;
+use DX::Action::FromCode;
 use Test::Exception;
 
 {
@@ -10,7 +12,7 @@ use Test::Exception;
   use Moo;
 
   has path => (is => 'ro', required => 1);
-  has info => (is => 'ro', required => 1);
+  has info => (is => 'ro', predicate => 1);
 
   package My::PathStatusInfo;
 
@@ -34,6 +36,12 @@ my %protos = (
   ),
 );
 
+my %empty = (
+  '.ssh' => My::PathStatus->new(
+    path => '.ssh'
+  )
+);
+
 my %path_status;
 
 my $solver = DX::Solver->new(
@@ -45,35 +53,40 @@ 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) ],
+    [ exists => [ qw(PSI) ],
+      [ 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 {
-  join ' ', map $_->{PS}->path, $solver->query(
+sub paths_for_simple {
+  join ' ', map $_->{PS}->bound_value->path, $solver->query(
     [ qw(PS) ], [ path_status => 'PS' ], @_
   )->results;
 }
 
-is(paths_for(), '.ssh .ssh/authorized_keys');
+is(paths_for_simple(), '.ssh .ssh/authorized_keys');
 
-is(paths_for([ is_directory => 'PS' ]), '.ssh');
+is(paths_for_simple([ is_directory => 'PS' ]), '.ssh');
 
-is(paths_for([ is_file => 'PS' ]), '.ssh/authorized_keys');
+is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys');
 
-is(paths_for([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
+is(paths_for_simple([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
 
 $solver->add_rule(
   path_status_at => [ 'PS', 'P' ],
@@ -114,8 +127,144 @@ lives_ok {
   )->results
 };
 
-is(join(' ', map $_->{PS}->path, @res), '.ssh');
+is(join(' ', map $_->{PS}->bound_value->path, @res), '.ssh');
+
+delete $solver->rule_set->rules->{'path_status_at/2'};
+
+$solver->add_rule(
+  path_status_at => [ 'PS', 'P' ],
+    [ path_status => 'PS' ],
+    [ path => qw(PS P) ],
+    [ 'cut' ],
+);
+
+my %ob_res;
+
+$solver->add_rule(
+  path_status_at => [ 'PS', 'P' ],
+    [ observe => [ 'P' ],
+        sub {
+          my ($path) = $_[0];
+          DX::Observer::FromCode->new(
+            code => sub { (path_status => $ob_res{$path}) }
+          )
+        }
+    ],
+    [ path_status => 'PS' ],
+    [ path => qw(PS P) ],
+);
+
+%path_status = ();
+
+$ob_res{'.ssh'} = $protos{'.ssh'};
+
+sub paths_for {
+  join ' ', map $_->{PS}->bound_value->path, $solver->query([ 'PS' ], @_)->results;
+}
+
+is(
+  paths_for([ path_status => 'PS' ], [ path => 'PS', [ value => '.ssh' ] ]),
+  '',
+  'no .ssh entry'
+);
+
+throws_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
+  qr/refused/;
+
+$solver->{observation_policy} = sub { 1 };
+
+is(
+  paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]),
+  '.ssh',
+  'observation'
+);
+
+is($path_status{'.ssh'}, $ob_res{'.ssh'});
+
+delete $solver->{observation_policy};
+
+lives_ok { paths_for([ path_status_at => 'PS', [ value => '.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' ] ],
+);
+
+%path_status = ();
+
+$ob_res{'.ssh'} = $empty{'.ssh'};
+
+#%path_status = %protos;
+
+$solver->{observation_policy} = sub { 1 };
+
+sub dot_ssh_query {
+  $solver->query([ 'PS' ], [ directory_at => 'PS' => [ value => '.ssh' ] ]);
+}
+
+is_deeply(
+  [ dot_ssh_query()->results ],
+  []
+);
+
+#::Dwarn(paths_for([ directory_at => 'PS', [ value => '.ssh' ] ]));
+
+$solver->add_rule(@$_) for (
+  [ is_directory => [ qw(PS) ],
+    [ not => [ exists_path => 'PS' ] ],
+    [ act => [ 'PS' ],
+        sub {
+          my ($ps_var) = @_;
+          my ($id, $value) = ($ps_var->id, $ps_var->bound_value);
+          DX::Action::FromCode->new(
+            expect => sub {
+              ($id => 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');
+
+ok(my $action = $res[0]->{PS}->action);
+
+my ($type, $value) = $action->run;
+
+$solver->facts->{$type}->remove_value($value);
+
+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');
 
-#::Dwarn($solver->query([ qw(PS) ], [ path_status_at => 'PS', [ value => '.ssh' ] ])->results);
+ok(!$res[0]->{PS}->action, 'No action');
 
 done_testing;