From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 22 Feb 2014 20:00:20 +0000 (+0000)
Subject: env dir code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a7c71ffb2075a9349e22e39fb19abdaad7e84e7;p=scpubgit%2FDKit.git

env dir code
---

diff --git a/lib/DX/Lib/FS.pm b/lib/DX/Lib/FS.pm
index 4b391ad..0e2b51b 100644
--- a/lib/DX/Lib/FS.pm
+++ b/lib/DX/Lib/FS.pm
@@ -1,6 +1,7 @@
 package DX::Lib::FS;
 
 use DX::Lib::FS::Observation::PathStatus;
+use DX::Lib::FS::Observation::EnvDir;
 use DX::Lib::FS::Action::CreateDirectory;
 use DX::Lib::FS::Action::CreateFile;
 use DX::Lib::FS::Action::SetPathMode;
@@ -186,12 +187,43 @@ our @RULES = (
     [ catfile => qw(DirPath FileName FilePath) ],
     [ is_directory => 'DirPath' ],
     [ is_file => 'FilePath' ] ],
+
+  [ directory_in => [ qw(DirPath DirName SubdirPath) ],
+    [ catfile => qw(DirPath DirName SubdirPath) ],
+    [ is_directory => 'DirPath' ],
+    [ is_directory => 'SubdirPath' ] ],
+
+  [ env_dir => [ qw(ED) ],
+    [ member_of => 'ED', \'env_dir' ] ],
+
+  [ _env_dir_at => [ qw(ED P) ],
+    [ env_dir => 'ED' ],
+    [ prop => ED => \'path' => 'P' ] ],
+
+  [ env_dir_at => [ qw(ED P) ],
+    [ _env_dir_at => qw(ED P) ],
+    [ 'cut' ] ],
+
+  [ env_dir_at => [ 'ED', 'P' ],
+    [ observe => [ 'P' ], sub {
+        DX::Lib::FS::Observation::EnvDir->new(
+          path => $_[0]
+        )
+      } ],
+    [ _env_dir_at => qw(ED P) ] ],
+
+  [ home_dir_on => [ qw(A D) ],
+    [ path_on => 'A', \'HOME', 'P' ],
+    [ env_dir_at => ED => 'P' ],
+    [ prop => ED => \'value' => 'H' ],
+    [ path_on => 'A', 'H', 'D' ] ],
 );
 
 sub load_into {
   my ($self, $solver) = @_;
   $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
   $solver->facts->{file_content} = DX::SetOver->new(over => 'path');
+  $solver->facts->{env_dir} = DX::SetOver->new(over => 'path');
   $solver->add_predicate(
     catdir => [ qw(DirPath DirName SubDirPath) ],
       [ qw(+ + -) ] => sub {
diff --git a/lib/DX/Lib/FS/Fact/EnvDir.pm b/lib/DX/Lib/FS/Fact/EnvDir.pm
new file mode 100644
index 0000000..e0c824b
--- /dev/null
+++ b/lib/DX/Lib/FS/Fact/EnvDir.pm
@@ -0,0 +1,10 @@
+package DX::Lib::FS::Fact::EnvDir;
+
+use Moo;
+
+with 'DX::Role::Fact';
+
+has path => (is => 'ro', required => 1);
+has value => (is => 'ro', required => 1);
+
+1;
diff --git a/lib/DX/Lib/FS/Guts.pm b/lib/DX/Lib/FS/Guts.pm
index 994e648..29c3cd4 100644
--- a/lib/DX/Lib/FS/Guts.pm
+++ b/lib/DX/Lib/FS/Guts.pm
@@ -84,4 +84,10 @@ sub file_content {
   return $data;
 }
 
+sub env_dir {
+  my ($self, $key) = @_;
+  $key =~ s/^\.\///;
+  return $ENV{$key}|| die "${key} not set";
+}
+
 1;
diff --git a/lib/DX/Lib/FS/Observation/EnvDir.pm b/lib/DX/Lib/FS/Observation/EnvDir.pm
new file mode 100644
index 0000000..1f59003
--- /dev/null
+++ b/lib/DX/Lib/FS/Observation/EnvDir.pm
@@ -0,0 +1,18 @@
+package DX::Lib::FS::Observation::EnvDir;
+
+use DX::Lib::FS::Fact::EnvDir;
+use Moo;
+
+with 'DX::Lib::FS::Role::RunOn';
+
+has path => (is => 'ro', required => 1);
+
+sub run {
+  my ($self) = @_;
+  +(env_dir => DX::Lib::FS::Fact::EnvDir->new(
+    path => $self->path,
+    value => $self->_call_guts('env_dir')
+  ));
+}
+
+1;
diff --git a/lib/DX/Lib/FS/Role/RunOn.pm b/lib/DX/Lib/FS/Role/RunOn.pm
new file mode 100644
index 0000000..9191cd2
--- /dev/null
+++ b/lib/DX/Lib/FS/Role/RunOn.pm
@@ -0,0 +1,24 @@
+package DX::Lib::FS::Role::RunOn;
+
+use DX::Lib::FS::Guts;
+use Moo::Role;
+
+my $local = DX::Lib::FS::Guts->new;
+my %conn_cache; # HEINOUS
+
+sub _call_guts {
+  my ($self, $type, @args) = @_;
+  my ($on, $path) = $self->path =~ /^(?:([^\/]+):)?(.*)$/;
+  my $guts = $on ? $self->_conn_to($on) : $local;
+  $guts->$type($path, @args);
+}
+
+sub _conn_to {
+  my ($self, $on) = @_;
+  $conn_cache{$on} ||= do {
+    require Object::Remote;
+    DX::Lib::FS::Guts->new::on($on);
+  };
+}
+
+1;