t/dot_ssh.t

   1 use strictures 1;
   2 use Test::More;
   3 use DX::Solver;
   4 use DX::SetOver;
   5 use Test::Exception;
   6
   7 {
   8   package My::PathStatus;
   9
  10   use Moo;
  11
  12   has path => (is => 'ro', required => 1);
  13   has info => (is => 'ro', required => 1);
  14
  15   package My::PathStatusInfo;
  16
  17   use Moo;
  18
  19   has is_directory => (is => 'ro', default => 0);
  20   has is_file => (is => 'ro', default => 0);
  21   has mode => (is => 'ro', required => 1);
  22 }
  23
  24 @INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__);
  25
  26 my %protos = (
  27   '.ssh' => My::PathStatus->new(
  28     path => '.ssh',
  29     info => My::PathStatusInfo->new(is_directory => 1, mode => '0755')
  30   ),
  31   '.ssh/authorized_keys' => My::PathStatus->new(
  32     path => '.ssh/authorized_keys',
  33     info => My::PathStatusInfo->new(is_file => 1, mode => '0644')
  34   ),
  35 );
  36
  37 my %path_status;
  38
  39 my $solver = DX::Solver->new(
  40   facts => { path_status => DX::SetOver->new(
  41                over => 'path',
  42                values => \%path_status,
  43              ) },
  44 );
  45
  46 $solver->add_rule(@$_) for (
  47   [ path_status => [ qw(PS) ],
  48     [ member_of => 'PS', [ value => 'path_status' ] ] ],
  49   [ path => [ qw(PS P) ],
  50     [ constrain => [ qw(PS P) ], sub { $_[0]->path eq $_[1] } ] ],
  51   [ mode => [ qw(PS M) ],
  52     [ constrain => [ qw(PS M) ],
  53        sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
  54   [ is_directory => [ qw(PS) ],
  55     [ constrain => [ qw(PS) ],
  56         sub { $_[0]->info and $_[0]->info->is_directory } ] ],
  57   [ is_file => [ qw(PS) ],
  58     [ constrain => [ qw(PS) ],
  59         sub { $_[0]->info and $_[0]->info->is_file } ] ],
  60 );
  61
  62 %path_status = %protos;
  63
  64 sub paths_for {
  65   join ' ', map $_->{PS}->path, $solver->query(
  66     [ qw(PS) ], [ path_status => 'PS' ], @_
  67   )->results;
  68 }
  69
  70 is(paths_for(), '.ssh .ssh/authorized_keys');
  71
  72 is(paths_for([ is_directory => 'PS' ]), '.ssh');
  73
  74 is(paths_for([ is_file => 'PS' ]), '.ssh/authorized_keys');
  75
  76 is(paths_for([ mode => 'PS', [ value => '0755' ] ]), '.ssh');
  77
  78 $solver->add_rule(
  79   path_status_at => [ 'PS', 'P' ],
  80     [ path_status => 'PS' ],
  81     [ path => qw(PS P) ],
  82 );
  83 $solver->add_rule(
  84   path_status_at => [ 'PS', 'P' ],
  85     [ constrain => [] => sub { die "ARGH" } ]
  86 );
  87
  88 throws_ok {
  89   $solver->query(
  90     [ qw(PS) ],
  91       [ path_status_at => 'PS', [ value => '.ssh' ] ]
  92   )->results
  93 } qr/ARGH/;
  94
  95 delete $solver->rule_set->rules->{'path_status_at/2'};
  96
  97 $solver->add_rule(
  98   path_status_at => [ 'PS', 'P' ],
  99     [ path_status => 'PS' ],
 100     [ path => qw(PS P) ],
 101     [ 'cut' ],
 102 );
 103 $solver->add_rule(
 104   path_status_at => [ 'PS', 'P' ],
 105     [ constrain => [] => sub { die "ARGH" } ]
 106 );
 107
 108 my @res;
 109
 110 lives_ok {
 111   @res = $solver->query(
 112     [ qw(PS) ],
 113       [ path_status_at => 'PS', [ value => '.ssh' ] ]
 114   )->results
 115 };
 116
 117 is(join(' ', map $_->{PS}->path, @res), '.ssh');
 118
 119 #::Dwarn($solver->query([ qw(PS) ], [ path_status_at => 'PS', [ value => '.ssh' ] ])->results);
 120
 121 done_testing;