Finish first implementation

.gitignore

@@ -1,3 +1,3 @@
-File-Prepend-Undoable-*
+File-Patch-Undoable-*
 .build
 *~

Changes

@@ -1,5 +1,5 @@
-Revision history for File-Prepend-Undoable
+Revision history for File-Patch-Undoable
 
-0.01    2012-09-06 (SHARYANTO) (not yet released)
+0.01    2012-09-07 (SHARYANTO) (not yet released)
 
         First release.

dist.ini

@@ -1,13 +1,13 @@
 version=0.01
 
-name    = File-Prepend-Undoable
+name    = File-Patch-Undoable
 author  = Steven Haryanto <stevenharyanto@gmail.com>
 license = Perl_5
 copyright_holder = Steven Haryanto
 
 [MetaResources]
-homepage   = http://metacpan.org/release/File-Prepend-Undoable
-repository = http://github.com/sharyanto/perl-File-Prepend-Undoable
+homepage   = http://metacpan.org/release/File-Patch-Undoable
+repository = http://github.com/sharyanto/perl-File-Patch-Undoable
 
 [@SHARYANTO]
 
@@ -22,5 +22,7 @@ Test::Perinci::Tx::Manager=0.42
 Rinci=1.1.29
 
 perl=5.010001
-File::Trash::Undoable=0.08
+Builtin::Logged=0
 Log::Any=0
+SHARYANTO::Proc::ChildError=0
+Text::Patch=1.8

lib/File/Patch/Undoable.pm

@@ -0,0 +1,156 @@
+package File::Patch::Undoable;
+
+use 5.010;
+use strict;
+use warnings;
+use Log::Any '$log';
+
+use Builtin::Logged qw(system);
+use File::Temp qw(tempfile);
+use SHARYANTO::Proc::ChildError qw(explain_child_error);
+
+# VERSION
+
+our %SPEC;
+
+$SPEC{patch} = {
+    v           => 1.1,
+    summary     => 'Patch a file, with undo support',
+    description => <<'_',
+
+On do, will patch file with the supplied patch. On undo, will apply the reverse
+of the patch.
+
+Note: Symlink is currently not permitted (except for the patch file). Patching
+is currently done with the `patch` program.
+
+Unfixable state: file does not exist or not a regular file (directory and
+symlink included), patch file does not exist or not a regular file (but symlink
+allowed).
+
+Fixed state: file exists, patch file exists, and patch has been applied.
+
+Fixable state: file exists, patch file exists, and patch has not been applied.
+
+_
+    args        => {
+        # naming the args 'path' and 'patch' can be rather error prone
+        file => {
+            summary => 'Path to file to be patched',
+            schema => 'str*',
+            req    => 1,
+            pos    => 0,
+        },
+        patch => {
+            summary => 'Path to patch file',
+            description => <<'_',
+
+Patch can be in unified or context format, it will be autodetected.
+
+_
+            schema => 'str*',
+            req    => 1,
+            pos    => 1,
+        },
+        reverse => {
+            summary => 'Whether to apply reverse of patch',
+            schema => [bool => {default=>0}],
+            cmdline_aliases => {R=>{}},
+        },
+    },
+    features => {
+        tx => {v=>2},
+        idempotent => 1,
+    },
+    deps => {
+        prog => 'patch',
+    },
+};
+sub patch {
+    my %args = @_;
+
+    # TMP, schema
+    my $tx_action  = $args{-tx_action} // '';
+    my $dry_run    = $args{-dry_run};
+    my $file       = $args{file};
+    defined($file) or return [400, "Please specify file"];
+    my $patch      = $args{patch};
+    defined($patch) or return [400, "Please specify patch"];
+    my $rev        = !!$args{reverse};
+
+    my $is_sym  = (-l $file);
+    my @st      = stat($file);
+    my $exists  = $is_sym || (-e _);
+    my $is_file = (-f _);
+    my $patch_exists  = (-e $patch);
+    my $patch_is_file = (-f _);
+
+    my @cmd;
+
+    if ($tx_action eq 'check_state') {
+        return [412, "File $file does not exist"] unless $exists;
+        return [412, "File $file is not a regular file"] if $is_sym||!$is_file;
+        return [412, "Patch $patch does not exist"] unless $patch_exists;
+        return [412,"Patch $patch is not a regular file"] unless $patch_is_file;
+
+        # check whether patch has been applied by testing the reverse patch
+        @cmd = ("patch", "--dry-run", "-sf", "-r","-", ("-R")x!$rev,
+                $file, "-i",$patch);
+        system @cmd;
+        if (!$?) {
+            return [304, "Patch $patch already applied to $file"];
+        } elsif (($? >> 8) == 1) {
+            $log->info("(DRY) Patching file $file with $patch ...") if $dry_run;
+            return [200, "File $file needs to be patched with $patch", undef,
+                    {undo_actions=>[
+                        [patch=>{file=>$file, patch=>$patch, reverse=>!$rev}],
+                    ]}];
+        } else {
+            return [500, "Can't patch: ".explain_child_error()];
+        }
+
+    } elsif ($tx_action eq 'fix_state') {
+        $log->info("Patching file $file with $patch ...");
+
+        # first patch to a temporary output first, because patch can produce
+        # half-patched file.
+        my ($tmpfh, $tmpname) = tempfile(DIR=>".");
+
+        @cmd = ("patch", "-sf","-r","-", ("-R")x!!$rev,
+                $file, "-i",$patch, "-o", $tmpname);
+        system @cmd;
+        if ($?) {
+            unlink $tmpname;
+            return [500, "Can't patch: ".explain_child_error()];
+        }
+
+        # now rename the temp file to the original file
+        unless (rename $tmpname, $file) {
+            unlink $tmpname;
+            return [500, "Can't rename $tmpname -> $file: $!"];
+        }
+
+        return [200, "OK"];
+    }
+    [400, "Invalid -tx_action"];
+}
+
+1;
+# ABSTRACT: Patch a file, with undo support
+
+=head1 FAQ
+
+=head2 Why use the patch program? Why not use a Perl module like Text::Patch?
+
+The B<patch> program has many nice features that L<Text::Patch> lacks, e.g.
+applying reverse patch (needed to check fixed state and to undo), autodetection
+of patch type, ignoring whitespace and fuzz factor, etc.
+
+
+=head1 SEE ALSO
+
+L<Rinci::Transaction>
+
+L<Text::Patch>, L<PatchReader>, L<Text::Patch::Rred>
+
+=cut

t/data/file.c.patch

@@ -0,0 +1,19 @@
+*** file.old	2012-09-07 12:58:02.000000000 +0700
+--- file.new	2012-09-07 12:58:39.000000000 +0700
+***************
+*** 1,6 ****
+  line 1
+- line 2
+  line 3
+! line 4
+! line 5
+  line 6
+--- 1,8 ----
+  line 1
+  line 3
+! 
+!   line 4 - modified
+!   modified line 5
+  line 6
++ line 7
++ line 8

t/data/file.ed.patch

@@ -0,0 +1,10 @@
+6a
+line 7
+line 8
+.
+4,5c
+
+  line 4 - modified
+  modified line 5
+.
+2d

t/data/file.new

@@ -0,0 +1,8 @@
+line 1
+line 3
+
+  line 4 - modified
+  modified line 5
+line 6
+line 7
+line 8

t/data/file.old

@@ -0,0 +1,6 @@
+line 1
+line 2
+line 3
+line 4
+line 5
+line 6

t/data/file.u.patch

@@ -0,0 +1,14 @@
+--- file.old	2012-09-07 12:58:02.000000000 +0700
++++ file.new	2012-09-07 12:58:39.000000000 +0700
+@@ -1,6 +1,8 @@
+ line 1
+-line 2
+ line 3
+-line 4
+-line 5
++
++  line 4 - modified
++  modified line 5
+ line 6
++line 7
++line 8