From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 3 Feb 2014 03:46:25 +0000 (+0000)
Subject: start of dot_ssh test
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9a4942da4e55d62a7cd7a5b5b9159d0f4dfc564d;p=scpubgit%2FDKit.git

start of dot_ssh test
---

diff --git a/t/dot_ssh.t b/t/dot_ssh.t
new file mode 100644
index 0000000..73efcc4
--- /dev/null
+++ b/t/dot_ssh.t
@@ -0,0 +1,77 @@
+use strictures 1;
+use Test::More;
+use DX::Solver;
+use DX::SetOver;
+
+{
+  package My::PathStatus;
+
+  use Moo;
+
+  has path => (is => 'ro', required => 1);
+  has info => (is => 'ro', required => 1);
+
+  package My::PathStatusInfo;
+
+  use Moo;
+
+  has is_directory => (is => 'ro', default => 0);
+  has is_file => (is => 'ro', default => 0);
+  has mode => (is => 'ro', required => 1);
+}
+
+@INC{qw(My/PathStatus.pm My/PathStatusInfo.pm)} = (__FILE__,__FILE__);
+
+my %protos = (
+  '.ssh' => My::PathStatus->new(
+    path => '.ssh',
+    info => My::PathStatusInfo->new(is_directory => 1, mode => '0755')
+  ),
+  '.ssh/authorized_keys' => My::PathStatus->new(
+    path => '.ssh/authorized_keys',
+    info => My::PathStatusInfo->new(is_file => 1, mode => '0644')
+  ),
+);
+
+my %path_status;
+
+my $solver = DX::Solver->new(
+  facts => { path_status => DX::SetOver->new(
+               over => 'path',
+               values => \%path_status,
+             ) },
+);
+
+my @rules = (
+  [ path_status => [ qw(PS) ],
+    [ member_of => 'PS', [ value => 'path_status' ] ] ],
+  [ path => [ qw(PS P) ],
+    [ constrain => [ qw(PS P) ], sub { $_[0]->path eq $_[1] } ] ],
+  [ mode => [ qw(PS M) ],
+    [ constrain => [ qw(PS M) ],
+       sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
+  [ is_directory => [ qw(PS) ],
+    [ constrain => [ qw(PS) ],
+        sub { $_[0]->info and $_[0]->info->is_directory } ] ],
+  [ is_file => [ qw(PS) ],
+    [ constrain => [ qw(PS) ],
+        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'], @_
+  )->results;
+}
+
+is(paths_for(), '.ssh .ssh/authorized_keys');
+
+is(paths_for([ is_directory => 'PS' ]), '.ssh');
+
+is(paths_for([ is_file => 'PS' ]), '.ssh/authorized_keys');
+
+is(paths_for([ mode => 'PS', [ value => '0755' ] ]), '.ssh');