summaryrefslogtreecommitdiffstats
path: root/videomv.pl
diff options
context:
space:
mode:
Diffstat (limited to 'videomv.pl')
-rwxr-xr-xvideomv.pl212
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"