From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 14 Feb 2014 06:23:50 +0000 (+0000)
Subject: beginnings of FS lib
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4d2ad771f927fbb7e516cb90da3e8953a733c570;p=scpubgit%2FDKit.git

beginnings of FS lib
---

diff --git a/lib/DX/Lib/FS.pm b/lib/DX/Lib/FS.pm
new file mode 100644
index 0000000..a11622f
--- /dev/null
+++ b/lib/DX/Lib/FS.pm
@@ -0,0 +1,110 @@
+package DX::Lib::FS;
+
+use DX::Lib::FS::Observation::PathStatus;
+use DX::Lib::FS::Action::CreateDirectory;
+use DX::Lib::FS::Action::CreateFile;
+use File::Spec;
+use DX::SetOver;
+use Moo;
+
+our @RULES = (
+  [ path_status => [ qw(PS) ],
+    [ member_of => 'PS', \'path_status' ] ],
+  [ path => [ qw(PS P) ],
+    [ 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) ],
+    [ 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) ],
+    [ info_prop => 'PS', \'is_directory', \1 ] ],
+  [ is_file => [ qw(PS) ],
+    [ info_prop => 'PS', \'is_file', \1 ] ],
+  [ path_status_at => [ 'PS', 'P' ],
+    [ path_status => 'PS' ],
+    [ path => qw(PS P) ],
+    [ 'cut' ] ],
+  [ path_status_at => [ 'PS', 'P' ],
+    [ observe => [ 'P' ], sub {
+        DX::Lib::FS::Observation::PathStatus->new(
+          path => $_[0]
+        )
+      } ],
+    [ path_status => 'PS' ],
+    [ path => qw(PS P) ] ],
+  [ directory_at => [ qw(PS P) ],
+    [ path_status_at => qw(PS P) ],
+    [ is_directory => 'PS' ] ],
+  [ file_at => [ qw(PS P) ],
+    [ path_status_at => qw(PS P) ],
+    [ is_file => 'PS' ] ],
+  [ is_directory => [ qw(PS) ],
+    [ not => [ exists_path => 'PS' ] ],
+    [ act => [ 'PS' ], sub {
+        DX::Lib::FS::Action::CreateDirectory->new(
+          path => $_[0]->path
+        )
+      } ] ],
+  [ is_file => [ qw(PS) ],
+    [ not => [ exists_path => 'PS' ] ],
+    [ act => [ 'PS' ], sub {
+        DX::Lib::FS::Action::CreateFile->new(
+          path => $_[0]->path
+        )
+      } ] ],
+  [ directory_in => [ qw(DirStatus DirName SubDirStatus) ],
+    [ is_directory => qw(DirStatus) ],
+    [ exists => [ qw(DirPath) ],
+      [ path => qw(DirStatus DirPath) ],
+      [ exists => [ qw(SubDirPath) ],
+        [ catfile => qw(DirPath DirName SubDirPath) ],
+        [ directory_at => qw(SubDirStatus SubDirPath) ] ] ] ],
+  [ file_in => [ qw(DirStatus FileName FileStatus) ],
+    [ is_directory => qw(DirStatus) ],
+    [ exists => [ qw(DirPath) ],
+      [ path => qw(DirStatus DirPath) ],
+      [ exists => [ qw(FilePath) ],
+        [ catfile => qw(DirPath FileName FilePath) ],
+        [ file_at => qw(FileStatus FilePath) ] ] ] ],
+);
+
+sub load_into {
+  my ($self, $solver) = @_;
+  $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
+  $solver->add_predicate(
+    catdir => [ qw(DirPath DirName SubDirPath) ],
+      [ qw(+ + -) ] => sub {
+        +(SubDirPath => [
+           value => File::Spec->catdir($_{DirPath}, $_{DirName})
+        ])
+      },
+      [ qw(- - +) ] => sub {
+        my @split = File::Spec->splitdir($_{SubDirPath});
+        my $last = pop @split;
+        my $rest = File::Spec->catdir(@split);
+        +(DirPath => [ value => $rest ], DirName => [ value => $last ])
+      }
+  );
+  $solver->add_predicate(
+    catfile => [ qw(DirPath FileName FilePath) ],
+      [ qw(+ + -) ] => sub {
+        my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1);
+        my $file_path = File::Spec->catpath($vol, $dir, $_{FilePath});
+        +(FilePath => [ value => $file_path ])
+      },
+      [ qw(- - +) ] => sub {
+        my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath});
+        my $dir_path = File::Spec->catpath($vol, $dir);
+        +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
+      }
+  );
+  $solver->add_rule(@$_) for @RULES;
+}
+
+1;
diff --git a/lib/DX/Lib/FS/Action/CreateDirectory.pm b/lib/DX/Lib/FS/Action/CreateDirectory.pm
new file mode 100644
index 0000000..ef11a20
--- /dev/null
+++ b/lib/DX/Lib/FS/Action/CreateDirectory.pm
@@ -0,0 +1,25 @@
+package DX::Lib::FS::Action::CreateDirectory;
+
+use aliased 'DX::Lib::FS::Fact::PathStatus';
+use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
+use Moo;
+
+with 'DX::Role::Action';
+
+has path => (is => 'ro', required => 1);
+
+sub expected_effect {
+  my ($self) = @_;
+  return +(path_status => PathStatus->new(
+    path => $self->path,
+    info => PathStatusInfo->new(is_directory => 1, mode => '')
+  ));
+}
+
+sub _do_run {
+  my ($self) = @_;
+  mkdir($self->path) or die "Couldn't mkdir ${\$self->path}: $!";
+  +(path_status => PathStatus->new(path => $self->path));
+}
+
+1;
diff --git a/lib/DX/Lib/FS/Action/CreateFile.pm b/lib/DX/Lib/FS/Action/CreateFile.pm
new file mode 100644
index 0000000..80379e3
--- /dev/null
+++ b/lib/DX/Lib/FS/Action/CreateFile.pm
@@ -0,0 +1,25 @@
+package DX::Lib::FS::Action::CreateFile;
+
+use aliased 'DX::Lib::FS::Fact::PathStatus';
+use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
+use Moo;
+
+with 'DX::Role::Action';
+
+has path => (is => 'ro', required => 1);
+
+sub expected_effect {
+  my ($self) = @_;
+  return +(path_status => PathStatus->new(
+    path => $self->path,
+    info => PathStatusInfo->new(is_file => 1, mode => '')
+  ));
+}
+
+sub _do_run {
+  my ($self) = @_;
+  open my $fh, '>>', $self->path or die "Couldn't create ${\$self->path}: $!";
+  +(path_status => PathStatus->new(path => $self->path));
+}
+
+1;
diff --git a/lib/DX/Lib/FS/Fact/PathStatus.pm b/lib/DX/Lib/FS/Fact/PathStatus.pm
new file mode 100644
index 0000000..e234224
--- /dev/null
+++ b/lib/DX/Lib/FS/Fact/PathStatus.pm
@@ -0,0 +1,10 @@
+package DX::Lib::FS::Fact::PathStatus;
+
+use Moo;
+
+with 'DX::Role::Fact';
+
+has path => (is => 'ro', required => 1);
+has info => (is => 'ro', predicate => 1);
+
+1;
diff --git a/lib/DX/Lib/FS/Fact/PathStatusInfo.pm b/lib/DX/Lib/FS/Fact/PathStatusInfo.pm
new file mode 100644
index 0000000..a7201ff
--- /dev/null
+++ b/lib/DX/Lib/FS/Fact/PathStatusInfo.pm
@@ -0,0 +1,9 @@
+package DX::Lib::FS::Fact::PathStatusInfo;
+
+use Moo;
+
+has is_directory => (is => 'ro', default => 0);
+has is_file => (is => 'ro', default => 0);
+has mode => (is => 'ro', required => 1);
+
+1;
diff --git a/lib/DX/Lib/FS/Observation/PathStatus.pm b/lib/DX/Lib/FS/Observation/PathStatus.pm
new file mode 100644
index 0000000..ac397a1
--- /dev/null
+++ b/lib/DX/Lib/FS/Observation/PathStatus.pm
@@ -0,0 +1,29 @@
+package DX::Lib::FS::Observation::PathStatus;
+
+use aliased 'DX::Lib::FS::Fact::PathStatus';
+use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
+use POSIX qw(ENOENT);
+use File::stat;
+use Moo;
+
+has path => (is => 'ro', required => 1);
+
+sub run {
+  my ($self) = @_;
+  if (my $stat = stat(my $path = $self->path)) {
+    (path_status => PathStatus->new(
+      path => $path,
+      info => PathStatusInfo->new(
+        is_directory => -d _,
+        is_file => -f _,
+        mode => sprintf("%04o", ($stat->mode & 07777)),
+      )
+    ));
+  } elsif ($! == ENOENT) {
+    (path_status => PathStatus->new(path => $path));
+  } else {
+    die "Couldn't stat ${path}: $!";
+  }
+}
+
+1;