observers

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

diff --git a/t/dot_ssh.t b/t/dot_ssh.t
index 73efcc4..7a3491d 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 Test::Exception;
 
 {
   package My::PathStatus;
@@ -42,7 +44,7 @@ my $solver = DX::Solver->new(
              ) },
 );
 
-my @rules = (
+$solver->add_rule(@$_) for (
   [ path_status => [ qw(PS) ],
     [ member_of => 'PS', [ value => 'path_status' ] ] ],
   [ path => [ qw(PS P) ],
@@ -58,20 +60,118 @@ my @rules = (
         sub { $_[0]->info and $_[0]->info->is_file } ] ],
 );
 
-$solver->add_rule(@$_) for @rules;
-
 %path_status = %protos;
 
-sub paths_for {
-  join ' ', map $_->{PS}{path}, $solver->query(
-    [ qw(PS) ], [ path_status => 'PS'], @_
+sub paths_for_simple {
+  join ' ', map $_->{PS}->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_simple([ is_directory => 'PS' ]), '.ssh');
+
+is(paths_for_simple([ is_file => 'PS' ]), '.ssh/authorized_keys');
+
+is(paths_for_simple([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
+
+$solver->add_rule(
+  path_status_at => [ 'PS', 'P' ],
+    [ path_status => 'PS' ],
+    [ path => qw(PS P) ],
+);
+$solver->add_rule(
+  path_status_at => [ 'PS', 'P' ],
+    [ constrain => [] => sub { die "ARGH" } ]
+);
+
+throws_ok {
+  $solver->query(
+    [ qw(PS) ],
+      [ path_status_at => 'PS', [ value => '.ssh' ] ]
+  )->results
+} qr/ARGH/;
+
+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' ],
+);
+$solver->add_rule(
+  path_status_at => [ 'PS', 'P' ],
+    [ constrain => [] => sub { die "ARGH" } ]
+);
+
+my @res;
+
+lives_ok {
+  @res = $solver->query(
+    [ qw(PS) ],
+      [ path_status_at => 'PS', [ value => '.ssh' ] ]
+  )->results
+};
+
+is(join(' ', map $_->{PS}->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 = ('.ssh/authorized_keys' => $protos{'.ssh/authorized_keys'});
+
+$ob_res{'.ssh'} = $protos{'.ssh'};
+
+sub paths_for {
+  join ' ', map $_->{PS}->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'});
 
-is(paths_for([ is_directory => 'PS' ]), '.ssh');
+delete $solver->{observation_policy};
 
-is(paths_for([ is_file => 'PS' ]), '.ssh/authorized_keys');
+lives_ok { paths_for([ path_status_at => 'PS', [ value => '.ssh' ] ]) }
+  'No observation required anymore';
 
-is(paths_for([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
+done_testing;