diff options
| -rwxr-xr-x | videomv.pl | 212 |
1 files changed, 148 insertions, 64 deletions
@@ -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" |