From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 14 Feb 2014 21:19:43 +0000 (+0000)
Subject: file content handling
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c3eab7b6e8673436ef6891743a503cb948a7795;p=scpubgit%2FDKit.git

file content handling
---

diff --git a/lib/DX/Lib/FS.pm b/lib/DX/Lib/FS.pm
index 00b5420..e8b9ea1 100644
--- a/lib/DX/Lib/FS.pm
+++ b/lib/DX/Lib/FS.pm
@@ -4,6 +4,8 @@ use DX::Lib::FS::Observation::PathStatus;
 use DX::Lib::FS::Action::CreateDirectory;
 use DX::Lib::FS::Action::CreateFile;
 use DX::Lib::FS::Action::SetPathMode;
+use DX::Lib::FS::Observation::FileContent;
+use DX::Lib::FS::Action::RewriteFile;
 use File::Spec;
 use DX::SetOver;
 use Moo;
@@ -97,11 +99,90 @@ our @RULES = (
          path_status => $_[0], mode => $_[1]
        )
     } ] ],
+  [ file_content => [ qw(FC) ],
+    [ member_of => 'FC', \'file_content' ] ],
+  [ file_content_at => [ qw(FC P) ],
+    [ file_content => 'FC' ],
+    [ path => qw(FC P) ],
+    [ 'cut' ] ],
+  [ file_content_at => [ qw(FC P) ],
+    [ observe => [ 'P' ], sub {
+        DX::Lib::FS::Observation::FileContent->new(
+          path => $_[0]
+        )
+      } ],
+    [ file_content => 'FC' ],
+    [ path => qw(FC P) ] ],
+  [ file_data => [ qw(FC D) ], [ prop => 'FC', \'data', 'D' ] ],
+  [ file_content_line => [ qw(FC L) ],
+    [ exists => [ 'Lines' ],
+      [ prop => 'FC' => \'lines' => 'Lines' ],
+      [ member_of => 'L' => 'Lines' ] ] ],
+  [ contains_line => [ qw(PS L) ],
+    [ is_file => 'PS' ],
+    [ exists => [ qw(FC P) ],
+      [ path => qw(PS P) ],
+      [ file_content_at => qw(FC P) ],
+      [ file_content_line => qw(FC L) ] ] ],
+  [ file_content_line => [ qw(FC L) ],
+    [ not =>
+      [ exists => [ 'Lines' ],
+        [ prop => 'FC' => \'lines' => 'Lines' ],
+        [ member_of => 'L' => 'Lines' ] ] ],
+    [ exists => [ 'A' ],
+      [ has_action => qw(FC A) ],
+      [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ],
+    [ react => [ qw(FC L) ], sub { $_[0]->but_add($_[1]) } ],
+    [ 'cut' ] ],
+  [ file_content_line => [ qw(FC L) ],
+    [ not =>
+      [ exists => [ 'Lines' ],
+        [ prop => 'FC' => \'lines' => 'Lines' ],
+        [ member_of => 'L' => 'Lines' ] ] ],
+    [ act => [ qw(FC L) ], sub {
+        DX::Lib::FS::Action::RewriteFile->new(
+          from => $_[0],
+          add_lines => [ $_[1] ]
+        );
+      } ],
+    [ 'cut' ] ],
+  [ not_file_content_line => [ qw(FC L) ],
+    [ not =>
+      [ exists => [ 'Lines' ],
+        [ prop => 'FC' => \'lines' => 'Lines' ],
+        [ member_of => 'L' => 'Lines' ] ] ] ],
+  [ not_contains_line => [ qw(PS L) ],
+    [ is_file => 'PS' ],
+    [ exists => [ qw(FC P) ],
+      [ path => qw(PS P) ],
+      [ file_content_at => qw(FC P) ],
+      [ not_file_content_line => qw(FC L) ] ] ],
+  [ not_file_content_line => [ qw(FC L) ],
+    [ exists => [ 'Lines' ],
+      [ prop => 'FC' => \'lines' => 'Lines' ],
+      [ member_of => 'L' => 'Lines' ] ],
+    [ exists => [ 'A' ],
+      [ has_action => qw(FC A) ],
+      [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ],
+    [ react => [ qw(FC L) ], sub { $_[0]->but_remove($_[1]) } ],
+    [ 'cut' ] ],
+  [ not_file_content_line => [ qw(FC L) ],
+    [ exists => [ 'Lines' ],
+      [ prop => 'FC' => \'lines' => 'Lines' ],
+      [ member_of => 'L' => 'Lines' ] ],
+    [ act => [ qw(FC L) ], sub {
+        DX::Lib::FS::Action::RewriteFile->new(
+          from => $_[0],
+          remove_lines => { $_[1] => 1 }
+        );
+      } ],
+    [ 'cut' ] ],
 );
 
 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->add_predicate(
     catdir => [ qw(DirPath DirName SubDirPath) ],
       [ qw(+ + -) ] => sub {
diff --git a/lib/DX/Lib/FS/Action/CreateFile.pm b/lib/DX/Lib/FS/Action/CreateFile.pm
index feed8f7..426b241 100644
--- a/lib/DX/Lib/FS/Action/CreateFile.pm
+++ b/lib/DX/Lib/FS/Action/CreateFile.pm
@@ -2,7 +2,7 @@ package DX::Lib::FS::Action::CreateFile;
 
 use aliased 'DX::Lib::FS::Fact::PathStatus';
 use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
-use POSIX ();
+use Fcntl qw(O_CREAT O_WRONLY);
 use Moo;
 
 with 'DX::Role::Action';
@@ -24,15 +24,16 @@ sub expected_effect {
 
 sub _do_run {
   my ($self) = @_;
+  my $fh;
   if ($self->has_mode) {
     my $umask = umask(0000);
-    my $fd = POSIX::open(
-      $self->path, POSIX::O_CREAT | POSIX::O_RDONLY, oct($self->mode)
+    sysopen(
+      $fh, $self->path, O_CREAT | O_WRONLY, oct($self->mode)
     ) or do { umask($umask); die "Couldn't create ${\$self->path}: $!" };
-    POSIX::close($fd);
     umask($umask);
   } else {
-    open my $fh, '>>', $self->path or die "Couldn't create ${\$self->path}: $!";
+    sysopen($fh, $self->path, O_CREAT | O_WRONLY)
+      or die "Couldn't create ${\$self->path}: $!";
   }
   +(path_status => PathStatus->new(path => $self->path));
 }
diff --git a/lib/DX/Lib/FS/Action/RewriteFile.pm b/lib/DX/Lib/FS/Action/RewriteFile.pm
new file mode 100644
index 0000000..0e7548f
--- /dev/null
+++ b/lib/DX/Lib/FS/Action/RewriteFile.pm
@@ -0,0 +1,42 @@
+package DX::Lib::FS::Action::RewriteFile;
+
+use DX::Lib::FS::Fact::FileContent;
+use Moo;
+
+with 'DX::Role::Action';
+
+has from => (is => 'ro', required => 1);
+
+has add_lines => (is => 'ro', default => sub { [] });
+
+has remove_lines => (is => 'ro', default => sub { {} });
+
+has final_content => (is => 'lazy', init_arg => undef, builder => sub {
+  my ($self) = @_;
+  my %remove = %{$self->remove_lines};
+  join("\n",
+    (grep !$remove{$_}, $self->from->lines->all),
+    @{$self->add_lines},
+    ''
+  );
+});
+
+sub but_add {
+  $_[0]->but(add_lines => [ @{$_[0]->add_lines}, $_[1] ]);
+}
+
+sub but_remove {
+  $_[0]->but(remove_lines => [ %{$_[0]->remove_lines}, $_[1] => 1 ]);
+}
+
+sub expected_effect {
+  my ($self) = @_;
+  +(file_content => DX::Lib::FS::Fact::FileContent->new(
+    path => $self->from->path,
+    data => $self->final_content
+  ));
+}
+
+sub _do_run { die }
+
+1;
diff --git a/lib/DX/Lib/FS/Fact/FileContent.pm b/lib/DX/Lib/FS/Fact/FileContent.pm
new file mode 100644
index 0000000..bc564c1
--- /dev/null
+++ b/lib/DX/Lib/FS/Fact/FileContent.pm
@@ -0,0 +1,19 @@
+package DX::Lib::FS::Fact::FileContent;
+
+use DX::OrderedSet;
+use Data::Munge qw(mapval);
+use Moo;
+
+with 'DX::Role::Fact';
+
+has path => (is => 'ro', required => 1);
+
+has data => (is => 'ro', required => 1);
+
+has lines => (is => 'lazy', init_arg => undef, builder => sub {
+  my ($self) = @_;
+  my @lines = mapval { chomp } split(/^/m, $self->data);
+  DX::OrderedSet->new(values => \@lines);
+});
+
+1;
diff --git a/lib/DX/Lib/FS/Observation/FileContent.pm b/lib/DX/Lib/FS/Observation/FileContent.pm
new file mode 100644
index 0000000..84bb263
--- /dev/null
+++ b/lib/DX/Lib/FS/Observation/FileContent.pm
@@ -0,0 +1,21 @@
+package DX::Lib::FS::Observation::FileContent;
+
+use DX::Lib::FS::Fact::FileContent;
+use Moo;
+
+has path => (is => 'ro', required => 1);
+
+sub run {
+  my ($self) = @_;
+  my $data = do {
+    open my $fh, '<', $self->path or die "Couldn't open ${\$self->path}: $!";
+    local $/;
+    readline($fh)
+  };
+  +(file_content => DX::Lib::FS::Fact::FileContent->new(
+    path => $self->path,
+    data => $data
+  ));
+}
+
+1;
diff --git a/lib/DX/Op/ProposeAction.pm b/lib/DX/Op/ProposeAction.pm
index e63eb40..9076fd3 100644
--- a/lib/DX/Op/ProposeAction.pm
+++ b/lib/DX/Op/ProposeAction.pm
@@ -18,6 +18,7 @@ sub run {
   my ($self, $state) = @_;
   ($state, my %args) = $self->_expand_args($state, %{$self->_arg_map});
   my @vars = @args{sort keys %args};
+  return $state->backtrack unless @vars == grep $_->is_bound, @vars;
   my @deps = $state->action_dependencies(map $_->id, @vars);
   my $action = $self->builder->(map $state->resolve_value($_), @vars)
                     ->but(dependencies => \@deps);
diff --git a/lib/DX/OrderedSet.pm b/lib/DX/OrderedSet.pm
new file mode 100644
index 0000000..f3a860e
--- /dev/null
+++ b/lib/DX/OrderedSet.pm
@@ -0,0 +1,12 @@
+package DX::OrderedSet;
+
+use DX::ArrayStream;
+use Moo;
+
+has values => (is => 'ro', default => sub { [] });
+
+sub all { @{$_[0]->values} }
+
+sub to_stream { DX::ArrayStream->from_array($_[0]->all) }
+
+1;