revert

1 files changed, 148 insertions, 64 deletions

diff --git a/videomv.pl b/videomv.pl
index 9afd61c..bce7064 100755
--- a/videomv.pl
+++ b/videomv.pl
@@ -7,7 +7,7 @@
 # See http://sam.zoy.org/wtfpl/COPYING for more details.
 
 
-$VERSION = "0.1, 10 August 2011";
+$VERSION = "0.2, 10 August 2011";
 
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
                             bundling auto_version auto_help/;
@@ -23,8 +23,12 @@ use strict;
 ################################################################################
 
 # Configuration
-my $symlinks  = catdir($HOME,'video','MOVIES');    # Symlinks folder
-my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder
+
+my $symlinks  = catdir('/','tmp','video','MOVIES');    # Symlinks folder
+my $directors = catdir('', 'tmp','video','DIRECTORS'); # Directors folder
+
+#my $symlinks  = catdir($HOME,'video','MOVIES');    # Symlinks folder
+#my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder
 
 my $driver    = "mysql";
 my $database  = "videodb";
@@ -42,7 +46,7 @@ videomv.pl - Move your videos to or within your collection.
 
 =head1 SYNOPSIS
 
-B<videomv.pl> [B<--db>] [B<-q>]
+B<videomv.pl> [B<--lookup-db>] [B<--ignore-db>] [B<-q>]
 I<path/to/oldfile> [{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]
 
 =head1 DESCRIPTION
@@ -69,7 +73,6 @@ not verify these conventions!
        `- ...
 
 
-
 Depending on whether I<path/to/> is I<MOVIES/>,
 I<DIRECTORS/*/>, or something
 else, you will get one of the six behaviors below. For the sake of
@@ -79,7 +82,7 @@ paths that contain symlinks are fine as well.
 
 =over 4
 
-=item B<videomv.pl> [B<--db>] I<MOVIES/oldfile> I<MOVIES/newfile>
+=item B<videomv.pl> [B<--lookup-db>] I<MOVIES/oldfile> I<MOVIES/newfile>
 
 I<oldfile> is expected to be an existing symlink in I<MOVIES/>,
 which targets to I<../DIRECTORS/director/oldfile>. If
@@ -100,8 +103,8 @@ will be created, and
 
 =back
 
-If the B<--db> flag is set, the new I<director> will be found on the
-database instead of by parsing the path of the old target. 
+If the B<--lookup-db> flag is set, the new I<director> will be found on the
+database instead of by parsing the path of the old target.
 
 
 =item B<videomv.pl> I<MOVIES/oldfile> I<DIRECTORS/newdirector/>[I<newfile>]
@@ -129,7 +132,7 @@ will be created, and
 =back
 
 
-=item B<videomv.pl> [B<--db>] I<DIRECTORS/director/oldfile> I<MOVIES/newfile>
+=item B<videomv.pl> [B<--lookup-db>] I<DIRECTORS/director/oldfile> I<MOVIES/newfile>
 
 A symlink I<MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> is
 expected to exist.
@@ -150,14 +153,14 @@ will be created, and
 
 =back
 
-If the B<--db> flag is set, the new I<director> will be found on the
-database instead of by parsing the path of the old target. 
+If the B<--lookup-db> flag is set, the new I<director> will be found on the
+database instead of by parsing the path of the old target.
 
 
 =item B<videomv.pl> I<DIRECTORS/olddirector/oldfile> I<DIRECTOR/newdirector/>[I<newfile>]
 
 A symlink I<MOVIES/oldfile> -> I<../DIRECTORS/olddirector/oldfile> is
-expected to exist.  
+expected to exist.
 If I<olddirector/oldfile>=I<newdirector/newfile>
 (or if I<olddirector>=I<newdirector> and I<newfile> was not given),
 an error will be raised.
@@ -178,7 +181,7 @@ will be created, and
 =back
 
 
-=item B<videomv.pl> B<--db> I<path/to/oldfile> [I<MOVIES>[I</newfile>]]
+=item B<videomv.pl> B<--lookup-db> I<path/to/oldfile> [I<MOVIES>[I</newfile>]]
 
 Where I<path/to/> is neither of I<MOVIES/> nor I<DIRECTORS/*/>,
 and I<oldfile> is a regular file.
@@ -199,7 +202,7 @@ was not given) will be created, and
 
 =back
 
-Note that the B<--db> flag has to be set for this to work; if not, an error
+Note that the B<--lookup-db> flag has to be set for this to work; if not, an error
 will be raised.
 
 
@@ -225,27 +228,37 @@ argument was not given) will be created,
 
 =back
 
+The actions above will be performed in the given order. If some action
+fails, B<videomv.pl> will try to revert the successful ones (in reverse
+order).
 
 =head1 OPTIONS
 
 =over 8
 
-=item B<--db>
+=item B<--lookup-db>
 
-If the second argument is in I<MOVIES/*/> and this flag is set, B<videomv.pl> 
+If the second argument is in I<MOVIES/*/> and this flag is set, B<videomv.pl>
 will search the I<director> in the data base. An error will be raied if
 no entry is (or multiple entries are) found. Look above for details.
 
+=item B<--ignore-db>
+
+Do not connect to the database, (thus do not update it with the new
+filename). This flag is incompatible with B<--lookup-db>.
+
 =item B<-q>, B<--quiet>
 
 By default, B<videomv.pl> prints each action it performs, with their
-return status. This flag supresses this behavior.
+return status. This flag supresses this behavior. Use at your own risk.
 
 =back
 
 =head1 EXIT STATUS
 
-The exit status is 0 if all the actions went through, and 1 otherwise.
+The exit status is 0 if all the actions went through, 1 if some error
+happened, and 2 if some action fails and the successful ones have been
+smoothly reverted.
 
 =head1 REQUIREMENTS
 
@@ -261,16 +274,17 @@ Copyright 2011 Guilhem Moulin. See the source for copying conditions.
 
 
 #TODO: overwrite existing files?
-#TODO: revert in case of error
 #TODO: explore depth>1 in DIRECTORS/
 
-my $db_flag;
+my $lookupdb_flag;
+my $ignoredb_flag;
 
 # Get options
-GetOptions( "db"      => \$db_flag,
-            "q|quiet" => sub { open LOG, '>', '/dev/null'
-                               or die "Cannot open `/dev/null': $!" },
-            "man"     => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
+GetOptions( "lookup-db"=> \$lookupdb_flag,
+            "ignore-db"=> \$ignoredb_flag,
+            "q|quiet"  => sub { open LOG, '>', '/dev/null'
+                                or die "Cannot open `/dev/null': $!" },
+            "man"      => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
           )
     or  pod2usage(2);
 pod2usage(2)  if  ($#ARGV < 0 or $#ARGV > 1);
@@ -279,12 +293,15 @@ pod2usage(2)  if  ($#ARGV < 0 or $#ARGV > 1);
 my ($old_path,$new_path) = @ARGV;
 $new_path = $symlinks unless defined $new_path;
 
-die "Error: `" .$old_path. "' does not exist\n"
+die "Error: incompatible options.\n" if
+    (defined $lookupdb_flag) and (defined $ignoredb_flag);
+
+die "Error: `" .$old_path. "' does not exist.\n"
     unless (-l $old_path or -f $old_path);
 
 $new_path = catfile ($new_path, basename($old_path))
     if -d realpath($new_path);
-die "Error: `" .$new_path. "' exists\n"
+die "Error: `" .$new_path. "' exists.\n"
     if (-l $new_path or -f $new_path);
 
 my $old_filename = basename($old_path);
@@ -301,25 +318,28 @@ my @real_directors = splitdir($real_directors);
 
 
 # Connect to database
-my $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port";
-my $dbh = DBI->connect($dsn, $user, $password)
-              or die "Can't connect do database";
-$dbh->do( "set names utf8" ) or die;
-
-
-# Lookup for the file in the videodb database
-my $RES =
-    $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata
-                               WHERE filename = ?",
-                              'id', undef, $old_filename
-    )
+my ($dsn, $dbh, $RES, $nRES, $id);
+unless (defined $ignoredb_flag) {
+    $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port";
+    $dbh = DBI->connect($dsn, $user, $password)
+               or die "Can't connect do database";
+    $dbh->do( "set names utf8" ) or die;
+
+
+    # Lookup for the file in the videodb database
+    $RES =
+        $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata
+                                   WHERE filename = ?",
+                                  'id', undef, $old_filename
+        )
         or die "Can't select: " .$dbh->errstr. "\n";
-my $nRES = scalar (keys %$RES);
+    $nRES = scalar (keys %$RES);
 
-# The ID of the first movie found in the database, if any
-my $id = each %$RES;
+    # The ID of the first movie found in the database, if any
+    $id = each %$RES;
+}
 
-my $r;
+my $r = 0;
 my ($old_director, $new_director);
 my ($old_symlink, $new_symlink, $new_target, $old_target);
 
@@ -327,20 +347,20 @@ if (&is_symlink($real_new_path)) {
 
     # The destination is under $symlinks
 
-    if (defined $db_flag) {
+    if (defined $lookupdb_flag) {
         # Find the new director on the database
 
         # Ensure there is exactly one entry in the db
-        die "Error: No entry found in the database while the flag `--db' was set.\n"
+        die "Error: No entry found in the database while the flag `--lookup-db' was set.\n"
             if $nRES == 0;
-        die "Error: Multiples entries found in the database while the flag `--db' was set.\n"
+        die "Error: Multiples entries found in the database while the flag `--lookup-db' was set.\n"
             if $nRES > 1;
 
         $new_director = $RES->{$id}->{director};
         $new_director =~ s/ ?: ?/ -/;
         $new_director =~ tr@/@_@;
         $new_director =~ s/[[:cntrl:]]//;
-        
+
         # Create directory if it doesn't exist
         my $new_dirname = catfile ($directors, $new_director);
         unless (-d $new_dirname) {
@@ -398,7 +418,7 @@ if (&is_symlink($real_new_path)) {
         $old_target = $old_path;
         die "Error: `" .$old_path. "' is expected to be a regular file.\n"
             unless -f $old_path;
-        die "Error: Dunno where to put this file. Try the `--db' flag.\n"
+        die "Error: Dunno where to put this file. Try the `--lookup-db' flag.\n"
             unless defined $new_director;
 
         $new_target = catfile ($directors, $new_director, $new_filename);
@@ -448,33 +468,39 @@ else {
 }
 
 
+my @actions;    # Successful actions
 
 if (dirname (realpath $old_target) eq dirname (realpath $new_target)) {
-    unless ($old_filename eq $new_filename) {
-        print LOG "Renaming target...      ";
-        &ack (\$r, rename $old_target, $new_target);
-    }
+    &perform ("Renaming target...      ", rename $old_target, $new_target)
+        unless ($old_filename eq $new_filename);
 }
 else {
-    print LOG "Moving target...        ";
-    &ack (\$r, move $old_target, $new_target);
+    &perform ("Moving target...        ", move $old_target, $new_target);
 }
+
+my $old_tar;
 if (defined $old_symlink) {
-    print LOG "Deleting old symlink... ";
-    &ack (\$r, unlink $old_symlink);
+    $old_tar = readlink $old_symlink;
+    &perform ("Deleting old symlink... ", unlink $old_symlink);
 }
 
-print LOG "Creating new symlink... ";
-&ack (\$r, symlink catfile(updir(),'DIRECTORS',$new_director,$new_filename),
-                   $new_symlink);
 
-unless ($old_filename eq $new_filename) {
+&perform ("Creating new symlink... ",
+          symlink catfile(updir(),'DIRECTORS',$new_director,$new_filename),
+                  $new_symlink);
+
+
+unless (defined $ignoredb_flag || $old_filename eq $new_filename) {
     print LOG "Updating database...    ";
     if ($nRES == 0) {
+        $r = 2;
         print LOG "failed!: no entry found.\n";
+        &revert(@actions);
     }
     elsif ($nRES > 1) {
+        $r = 2;
         print LOG "failed!: multiple entries found.\n";
+        &revert(@actions);
     }
     else {
         my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
@@ -484,10 +510,12 @@ unless ($old_filename eq $new_filename) {
     }
 }
 
+
 # Disconnect
-$dbh->disconnect();
+$dbh->disconnect() unless defined $ignoredb_flag;
+
+exit $r;
 
-return $r;
 
 
 ################################################################################
@@ -499,12 +527,68 @@ sub ack {
     my ($r, $test) = @_;
     if ($test) {
         print LOG "OK\n";
+        return 0;
     } else {
         print LOG "failed!: $!\n";
-        $$r = 1;
+        $$r = 2 if defined $r;
+        return 1;
+    }
+}
+
+# Perform the given action; revert successful changes in case of failing
+sub perform {
+    return if $r;
+
+    my ($action,$test) = @_;
+
+    print LOG $action;
+    if (&ack (\$r, $test)) {
+        &revert(@actions);
+    }
+    else {
+        push @actions, $action;
     }
 }
 
+# Revert successful changes
+sub revert {
+    my @actions = reverse @_;
+
+    print LOG "\n";
+    print STDERR "Failed!: reverting successful changes...\n";
+
+    while ($#actions >= 0) {
+        my $rev;
+        if ($actions[0] =~ /^Renaming target/) {
+            $rev = rename $new_target, $old_target;
+        }
+        elsif ($actions[0] =~ /^Moving target/) {
+            $rev = move $new_target, $old_target;
+        }
+        elsif ($actions[0] =~ /^Moving target/) {
+            $rev = move $new_target, $old_target;
+        }
+        elsif ($actions[0] =~ /^Deleting( old symlink.*)/) {
+            $actions[0] = 'Creating'. $1;
+            $rev = symlink $old_tar, $old_symlink;
+        }
+        elsif ($actions[0] =~ /^Creating( new symlink.*)/) {
+            $actions[0] = 'Deleting'. $1;
+            $rev = unlink $new_symlink;
+        }
+        else {
+            print STDERR "Error: unknown action `" .$actions[0]. "'!\n";
+            $actions[0] = undef;
+            $r = 1;
+        }
+
+        if (defined $actions[0]) {
+            print LOG $actions[0];
+            &ack (\$r, $rev);
+        }
+        shift @actions;
+    }
+}
 
 # Check wether a path starts with $movies
 sub is_symlink {
@@ -515,7 +599,7 @@ sub is_symlink {
         shift @real_symlinks;
         shift @path;
     };
-     
+
     if ($#real_symlinks<0 && $#path==0) {
         return 1; # That's a "symlink"
     } else {
@@ -533,7 +617,7 @@ sub is_director {
         shift @real_directors;
         shift @path;
     };
-    
+
     if ($#real_directors<0 && $#path>=0) {
         ${$_[0]} = $path[0] if defined $_[0];
         return 1; # That's a "director"