From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 22 Feb 2014 11:51:13 +0000 (+0000)
Subject: move the actual doing stuff code for FS lib into a Guts.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0d1a41d9db9e712b545964675ede067d69d40978;p=scpubgit%2FDKit.git

move the actual doing stuff code for FS lib into a Guts.pm
---

diff --git a/lib/DX/Lib/FS.pm b/lib/DX/Lib/FS.pm
index c2be166..4b391ad 100644
--- a/lib/DX/Lib/FS.pm
+++ b/lib/DX/Lib/FS.pm
@@ -219,6 +219,24 @@ sub load_into {
         +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
       }
   );
+  $solver->add_predicate(
+    path_on => [ qw(On Path FullPath) ],
+      [ qw(+ + -) ] => sub {
+        (my $path = $_{Path}) =~ s/^(:!\/)/.\//;
+        if ($_{On} eq '' or $_{On} eq 'localhost') {
+          (FullPath => [ value => $path ])
+        } else {
+          (FullPath => [ value => join(':', $_{On}, $path) ])
+        }
+      },
+      [ qw(- - +) ] => sub {
+        if (my ($on, $path) = $_{FullPath} =~ /^([^\/]+):(.*)$/) {
+          (On => [ value => $on ], Path => [ value => $path ]);
+        } else {
+          (On => [ value => 'localhost' ], Path => [ value => $_{FullPath} ]);
+        }
+      }
+  );
   $solver->add_rule(
     does => [ qw(Thing RoleName) ],
       [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ]
diff --git a/lib/DX/Lib/FS/Action/CreateDirectory.pm b/lib/DX/Lib/FS/Action/CreateDirectory.pm
index 5fcdef3..5c8346b 100644
--- a/lib/DX/Lib/FS/Action/CreateDirectory.pm
+++ b/lib/DX/Lib/FS/Action/CreateDirectory.pm
@@ -2,6 +2,7 @@ package DX::Lib::FS::Action::CreateDirectory;
 
 use aliased 'DX::Lib::FS::Fact::PathStatus';
 use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
+use DX::Lib::FS::Guts;
 use Moo;
 
 with 'DX::Role::Action';
@@ -23,15 +24,8 @@ sub expected_effect {
 
 sub _do_run {
   my ($self) = @_;
-  if ($self->has_mode) {
-    my $umask = umask(0000);
-    mkdir($self->path, oct($self->mode))
-      or do { umask($umask); die "Couldn't mkdir ${\$self->path}: $!" };
-    umask($umask);
-  } else {
-    mkdir($self->path) or die "Couldn't mkdir ${\$self->path}: $!";
-  }
-  +(path_status => PathStatus->new(path => $self->path));
+  DX::Lib::FS::Guts->create_directory($self->path, $self->mode);
+  +(path_status => $self->path);
 }
 
 1;
diff --git a/lib/DX/Lib/FS/Action/CreateFile.pm b/lib/DX/Lib/FS/Action/CreateFile.pm
index 37629aa..e2b874b 100644
--- a/lib/DX/Lib/FS/Action/CreateFile.pm
+++ b/lib/DX/Lib/FS/Action/CreateFile.pm
@@ -3,7 +3,7 @@ package DX::Lib::FS::Action::CreateFile;
 use aliased 'DX::Lib::FS::Fact::FileContent';
 use aliased 'DX::Lib::FS::Fact::PathStatus';
 use aliased 'DX::Lib::FS::Fact::PathStatusInfo';
-use Fcntl qw(O_CREAT O_WRONLY);
+use DX::Lib::FS::Guts;
 use Moo;
 
 with 'DX::Role::Action';
@@ -30,19 +30,8 @@ sub expected_effect {
 
 sub _do_run {
   my ($self) = @_;
-  my $fh;
-  if ($self->has_mode) {
-    my $umask = umask(0000);
-    sysopen(
-      $fh, $self->path, O_CREAT | O_WRONLY, oct($self->mode)
-    ) or do { umask($umask); die "Couldn't create ${\$self->path}: $!" };
-    umask($umask);
-  } else {
-    sysopen($fh, $self->path, O_CREAT | O_WRONLY)
-      or die "Couldn't create ${\$self->path}: $!";
-  }
-  print $fh $self->data if length($self->data);
-  +(path_status => PathStatus->new(path => $self->path));
+  DX::Lib::FS::Guts->create_file($self->path, $self->mode, $self->data);
+  +(path_status => $self->path);
 }
 
 sub but_add {
diff --git a/lib/DX/Lib/FS/Action/RewriteFile.pm b/lib/DX/Lib/FS/Action/RewriteFile.pm
index 64bd66b..c636e35 100644
--- a/lib/DX/Lib/FS/Action/RewriteFile.pm
+++ b/lib/DX/Lib/FS/Action/RewriteFile.pm
@@ -1,9 +1,7 @@
 package DX::Lib::FS::Action::RewriteFile;
 
 use DX::Lib::FS::Fact::FileContent;
-use File::stat;
-use File::Copy;
-use Fcntl qw(O_CREAT O_WRONLY);
+use DX::Lib::FS::Guts;
 use Moo;
 
 with 'DX::Role::Action';
@@ -42,17 +40,8 @@ sub expected_effect {
 
 sub _do_run {
   my ($self) = @_;
-  my $stat = stat($self->path) or die "Couldn't stat ${\$self->path}: $!";
-  my $perms = $stat->mode & 07777;
-  my $new = $self->path.'.new';
-  unlink($new);
-  sysopen my $fh, $new, O_CREAT | O_WRONLY, $perms
-    or die "Couldn't open ${new}: $!";
-  print $fh $self->final_content
-    or die "Couldn't write data to ${new}: $!";
-  close $fh;
-  move($new, $self->path) or die "Couldn't install ${new}: $!";
-  return +(file_content => $self->from);
+  DX::Lib::FS::Guts->rewrite_file($self->path, $self->final_content);
+  return +(file_content => $self->path);
 }
 
 1;
diff --git a/lib/DX/Lib/FS/Action/SetPathMode.pm b/lib/DX/Lib/FS/Action/SetPathMode.pm
index f7cba83..8613448 100644
--- a/lib/DX/Lib/FS/Action/SetPathMode.pm
+++ b/lib/DX/Lib/FS/Action/SetPathMode.pm
@@ -1,5 +1,6 @@
 package DX::Lib::FS::Action::SetPathMode;
 
+use DX::Lib::FS::Guts;
 use Moo;
 
 has path_status => (is => 'ro', required => 1);
@@ -15,9 +16,8 @@ sub expected_effect {
 
 sub _do_run {
   my ($self) = @_;
-  chmod oct($self->mode), $self->path_status->path
-    or die "Failed to chmod ${\$self->path_status->path} to ${\$self->mode}: $!";
-  +(path_status => $self->path_status);
+  DX::Lib::FS::Guts->set_path_mode($self->path, $self->mode);
+  +(path_status => $self->path);
 }
 
 1;
diff --git a/lib/DX/Lib/FS/Guts.pm b/lib/DX/Lib/FS/Guts.pm
new file mode 100644
index 0000000..994e648
--- /dev/null
+++ b/lib/DX/Lib/FS/Guts.pm
@@ -0,0 +1,87 @@
+package DX::Lib::FS::Guts;
+
+use File::stat;
+use File::Copy;
+use Fcntl qw(O_CREAT O_WRONLY);
+use POSIX qw(ENOENT);
+use Moo;
+
+sub create_directory {
+  my ($self, $path, $mode) = @_;
+  if (defined $mode) {
+    my $umask = umask(0000);
+    mkdir($path, oct($mode))
+      or do { umask($umask); die "Couldn't mkdir ${path}: $!" };
+    umask($umask);
+  } else {
+    mkdir($path) or die "Couldn't mkdir ${path}: $!";
+  }
+  return;
+}
+
+sub create_file {
+  my ($self, $path, $mode, $data) = @_;
+  my $fh;
+  if (defined $mode) {
+    my $umask = umask(0000);
+    sysopen(
+      $fh, $path, O_CREAT | O_WRONLY, oct($mode)
+    ) or do { umask($umask); die "Couldn't create ${path}: $!" };
+    umask($umask);
+  } else {
+    sysopen($fh, $path, O_CREAT | O_WRONLY)
+      or die "Couldn't create ${path}: $!";
+  }
+  print $fh $data if length($data);
+  return;
+}
+
+sub set_path_mode {
+  my ($self, $path, $mode) = @_;
+  chmod oct($mode), $path
+    or die "Failed to chmod ${path} to ${mode}: $!";
+  return;
+}
+
+sub rewrite_file {
+  my ($self, $path, $final_content) = @_;
+  my $stat = stat($path) or die "Couldn't stat ${path}: $!";
+  my $perms = $stat->mode & 07777;
+  my $new = $path.'.new';
+  unlink($new);
+  sysopen my $fh, $new, O_CREAT | O_WRONLY, $perms
+    or die "Couldn't open ${new}: $!";
+  print $fh $final_content
+    or die "Couldn't write data to ${new}: $!";
+  close $fh;
+  move($new, $path) or die "Couldn't install ${new}: $!";
+  return;
+}
+
+sub path_status_info {
+  my ($self, $path) = @_;
+  if (my $stat = stat($path)) {
+    return +{
+      is_directory => -d _,
+      is_file => -f _,
+      mode => sprintf("%04o", ($stat->mode & 07777))
+    };
+  } elsif ($! == ENOENT) {
+    return undef;
+  } else {
+    die "Couldn't stat ${path}: $!";
+  }
+}
+
+sub file_content {
+  my ($self, $path) = @_;
+  return undef unless -e $path;
+  my $data = do {
+    open my $fh, '<', $path or die "Couldn't open ${path}: $!";
+    local $/;
+    readline($fh)
+  };
+  return $data;
+}
+
+1;
diff --git a/lib/DX/Lib/FS/Observation/FileContent.pm b/lib/DX/Lib/FS/Observation/FileContent.pm
index f0e2bb4..ee5a441 100644
--- a/lib/DX/Lib/FS/Observation/FileContent.pm
+++ b/lib/DX/Lib/FS/Observation/FileContent.pm
@@ -1,18 +1,15 @@
 package DX::Lib::FS::Observation::FileContent;
 
 use DX::Lib::FS::Fact::FileContent;
+use DX::Lib::FS::Guts;
 use Moo;
 
 has path => (is => 'ro', required => 1);
 
 sub run {
   my ($self) = @_;
-  return () unless -e $self->path;
-  my $data = do {
-    open my $fh, '<', $self->path or die "Couldn't open ${\$self->path}: $!";
-    local $/;
-    readline($fh)
-  };
+  my $data = DX::Lib::FS::Guts->file_content($self->path);
+  return () unless defined($data);
   +(file_content => DX::Lib::FS::Fact::FileContent->new(
     path => $self->path,
     data => $data
diff --git a/lib/DX/Lib/FS/Observation/PathStatus.pm b/lib/DX/Lib/FS/Observation/PathStatus.pm
index ac397a1..a7b05cf 100644
--- a/lib/DX/Lib/FS/Observation/PathStatus.pm
+++ b/lib/DX/Lib/FS/Observation/PathStatus.pm
@@ -2,28 +2,21 @@ 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 DX::Lib::FS::Guts;
 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}: $!";
-  }
+  my $info = DX::Lib::FS::Guts->path_status_info($self->path);
+  (path_status => PathStatus->new(
+    path => $self->path,
+    ($info
+      ? (info => PathStatusInfo->new($info))
+      : ()
+    )
+  ));
 }
 
 1;
diff --git a/lib/DX/SetOver.pm b/lib/DX/SetOver.pm
index 30d7516..b267761 100644
--- a/lib/DX/SetOver.pm
+++ b/lib/DX/SetOver.pm
@@ -40,7 +40,7 @@ sub set_value {
 
 sub remove_value {
   my ($self, $value) = @_;
-  delete $self->values->{$value->${\$self->over}};
+  delete $self->values->{ref($value) ? $value->${\$self->over} : $value};
   return $self;
 }