Merge branch 'videomv' of ssh://guilhem.org/home/git/public/videodb-tools into videodb-check

Conflicts:
	videodb.rc

2 files changed, 686 insertions, 4 deletions

diff --git a/videodb.rc b/videodb.rc
index 7babf8f..8a3ce70 100644
--- a/videodb.rc
+++ b/videodb.rc
@@ -11,9 +11,5 @@ user      => 'username',
 port      => 3306,
 password  => '******',
 videodata => "videodb_videodata",
-<<<<<<< HEAD
-=======
 imdb      => 'akas.imdb.com',
 url       => 'https://videodb.example.org'
-
->>>>>>> origin/videoadd
diff --git a/videomv.pl b/videomv.pl
new file mode 100755
index 0000000..a21bc33
--- /dev/null
+++ b/videomv.pl
@@ -0,0 +1,686 @@
+#! /usr/bin/perl -w
+
+# This program is free software. It comes without any warranty, to the
+# extent permitted by applicable law. You can redistribute it and/or
+# modify it under the terms of the Do What The Fuck You Want To Public
+# License, Version 2, as published by Sam Hocevar.
+# See http://sam.zoy.org/wtfpl/COPYING for more details.
+
+
+$VERSION = "0.2, 10 August 2011";
+
+use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
+                            bundling auto_version auto_help/;
+use Pod::Usage;
+use DBI;
+use File::Basename;
+use File::Spec::Functions qw /catfile catdir splitdir updir/;
+use File::Copy;
+use Cwd qw /realpath/;
+use Env qw /HOME/;
+use strict;
+
+################################################################################
+
+# Configuration
+my $confile = catfile ($HOME, '.videodb.rc');
+die "Can't read `" .$confile. "'\n" unless -f $confile;
+my %config = do $confile;
+die "Error in `" .$confile. "'\n" if $@ || not %config;
+
+map { exists $config{$_} || die "Error: Missing `${_}'.\n" }
+    qw /videodir driver database hostname user port password videodata/;
+
+my $symlinks  = catdir($config{videodir},'MOVIES');    # Symlinks folder
+die "Error: No such directory: `" .$symlinks. "'.\n" unless -d $symlinks;
+
+my $directors = catdir($config{videodir},'DIRECTORS'); # Directors folder
+die "Error: No such directory: `" .$directors. "'.\n" unless -d $symlinks;
+
+
+################################################################################
+
+=head1 NAME
+
+videomv.pl - move your videos to or within your collection
+
+=head1 SYNOPSIS
+
+B<videomv.pl> [B<--lookup-db>] [B<--ignore-db>] [B<-q>]
+I<path/to/oldfile> [{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]
+
+=head1 DISCLAIMER
+
+Your collection is assumed to have the following structure: two
+folders, I<DIRECTORS> and I<MOVIES>, that have the same parent.
+I<DIRECTORS> contains one subdirectory for each director, and each movie
+lies (B<as a regular file>) in the subdirectory of its director.
+The folder I<MOVIES> contains symlinks - one for each movie - that target
+to I<../DIRECTORS/director_of_the_movie/movie>.
+The behavior of B<videomv.pl> is NOT specified if your collection does
+not verify these conventions!
+
+  |- ...
+  |- DIRECTORS
+  |    |- director1
+  |    |-   |- movie11
+  |    |    `- movie12
+  |    |- director2/
+  |    `- ...
+  `- MOVIES
+       |- movie11 -> ../DIRECTORS/director1/movie1
+       |- movie12 -> ../DIRECTORS/director1/movie2
+       `- ...
+
+=head1 DESCRIPTION
+
+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
+readability the paths are relative to the root of your video collection
+here, but hopefully other origins or
+paths that contain symlinks are fine as well.
+
+=over 4
+
+=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
+I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
+actions will be performed:
+
+=over 4
+
+=item *
+
+The old target will be renamed to I<DIRECTORS/director/newfile>,
+
+=item *
+
+The old symlink will be deleted,
+
+=item *
+
+A new symlink I<MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
+will be created, and
+
+=item *
+
+The filename in the database will be updated.
+
+=back
+
+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>]
+
+I<oldfile> is expected to be an existing symlink in I<MOVIES/>,
+which targets to I<../DIRECTORS/olddirector/oldfile>. If
+I<olddirector/oldfile>=I<newdirector/newfile>
+(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
+an error will be raised.
+Otherwise, the following actions will be performed:
+
+=over 4
+
+=item *
+
+The old target will be moved to I<DIRECTORS/newdirector/newfile>,
+(or to I<DIRECTORS/newdirector/oldfile> if I<newfile> was not given),
+
+=item *
+
+The old symlink will be deleted,
+
+=item *
+
+A new symlink I<MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
+(or -> I<../DIRECTORS/newdirector/oldfile> if I<newfile> was not given)
+will be created, and
+
+=item *
+
+The filename in the database will be updated unless I<oldfile>=I<newfile>.
+
+=back
+
+
+=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.
+If I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
+actions will be performed:
+
+=over 4
+
+=item *
+
+The old target I<DIRECTORS/director/oldfile> will be renamed to
+I<DIRECTORS/director/newfile>,
+
+=item *
+
+The old symlink will be deleted,
+
+=item *
+
+A new symlink I<MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
+will be created, and
+
+=item *
+
+The filename in the database will be updated.
+
+=back
+
+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.
+If I<olddirector/oldfile>=I<newdirector/newfile>
+(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
+an error will be raised.
+Otherwise, the following actions will be performed:
+
+=over 4
+
+=item *
+
+The old target I<../DIRECTORS/olddirector/oldfile> will be moved to
+I<../DIRECTORS/newdirector/newfile>,
+
+=item *
+
+The old symlink will be deleted,
+
+=item *
+
+A new symlink I<MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
+will be created, and
+
+=item *
+
+The filename in the database will be updated unless I<oldfile>=I<newfile>.
+
+=back
+
+
+=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.
+The I<director> will found in the database, and and error will be
+raised if no entry is (or multiple entries are) found.
+In case of success, the following actions will be performed:
+
+=over 4
+
+=item *
+
+I<oldfile> will be moved to I<DIRECTORS/director/newfile>
+(or to I<DIRECTORS/director/oldfile> if I<newfile> was not given),
+
+=item *
+
+A symlink I<MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
+(or I<MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if I<newfile>
+was not given) will be created, and
+
+=item *
+
+The filename in the database will be updated unless I<oldfile>=I<newfile>.
+
+=back
+
+Note that the B<--lookup-db> flag has to be set for this to work; if not, an error
+will be raised.
+
+
+=item B<videomv.pl> I<path/to/oldfile> I<DIRECTOR/director/>[I<newfile>]
+
+Where I<path/to/> is neither of I<MOVIES/> nor I<DIRECTORS/*/>,
+and I<oldfile> is a regular file.
+The following actions will be performed:
+
+=over 4
+
+=item *
+
+I<oldfile> will be moved to I<DIRECTORS/director/newfile>
+(or to I<DIRECTORS/director/oldfile> if I<newfile> was not given),
+
+=item *
+
+A symlink I<MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
+(or I<MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second
+argument was not given) will be created,
+
+=item * 
+
+The filename in the database will be updated unless I<oldfile>=I<newfile>.
+
+=back
+
+=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<--lookup-db>
+
+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. Use at your own risk.
+
+=back
+
+=head1 CONFIGURATION
+
+B<videodb-check> reads its database configuration from the file
+I<$HOME/.videodb.rc>. This file has to be the content of a Perl hash
+e.g.,
+
+  videodir  => catdir($HOME,'video'),
+  driver    => 'mysql',
+  database  => 'videodb',
+  hostname  => '127.0.0.1',
+  user      => 'username',
+  port      => 3306,
+  password  => '******',
+  videodata => "videodb_videodata",
+
+=head1 EXIT STATUS
+
+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
+
+The imported modules are available on CPAN. See the source for details.
+
+=head1 AUTHOR
+
+Copyright 2011 Guilhem Moulin. See the source for copying conditions.
+
+=cut
+
+################################################################################
+
+
+#TODO: overwrite existing files?
+#TODO: explore depth>1 in DIRECTORS/
+
+my $lookupdb_flag;
+my $ignoredb_flag;
+
+# Get options
+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);
+*LOG = *STDERR  unless  defined (fileno LOG);
+
+my ($old_path,$new_path) = @ARGV;
+$new_path = $symlinks unless defined $new_path;
+
+die "Error: incompatible options.\n" if
+    (defined $lookupdb_flag) and (defined $ignoredb_flag);
+
+die "Error: `" .$old_path. "' is neither a symlink nor a plain file.\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"
+    if (-l $new_path or -f $new_path);
+
+my $old_filename = basename($old_path);
+my $new_filename = basename($new_path);
+
+# Get the real paths, {..,symlink}-collapse and so on
+my $real_old_path = catfile (realpath (dirname($old_path)), $old_filename);
+my $real_new_path = catfile (realpath (dirname($new_path)), $new_filename);
+
+my $real_symlinks  = realpath($symlinks);
+my @real_symlinks = splitdir($real_symlinks);
+my $real_directors = realpath($directors);
+my @real_directors = splitdir($real_directors);
+
+
+# Connect to database
+my ($dsn, $dbh, $RES, $nRES, $id);
+unless (defined $ignoredb_flag) {
+    $dsn = "DBI:$config{driver}:database=$config{database};host=$config{hostname};port=$config{port}";
+    $dbh = DBI->connect($dsn, $config{user}, $config{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 $config{videodata}
+                                   WHERE filename = ?",
+                                  'id', undef, $old_filename
+        )
+        or die "Can't select: " .$dbh->errstr. "\n";
+    $nRES = scalar (keys %$RES);
+
+    # The ID of the first movie found in the database, if any
+    $id = each %$RES;
+}
+
+my $r = 0;
+my ($old_director, $new_director);
+my ($old_symlink, $new_symlink, $new_target, $old_target);
+
+if (&is_symlink($real_new_path)) {
+
+    # The destination is under $symlinks
+
+    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 `--lookup-db' was set.\n"
+            if $nRES == 0;
+        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) {
+            print STDERR "Directory `$new_dirname' does not exist. ";
+            until (-d $new_dirname) {
+                print STDERR "Should I create it? (Y/n) ";
+                my $a = lc <STDIN>;
+                chomp $a;
+                if ($a eq 'y' or $a eq '') {
+                    mkdir $new_dirname
+                        or die "Error: Cannot mkdir `$new_dirname': $!\n";
+                }
+                elsif ($a eq 'n') {
+                    exit 0;
+                }
+            }
+        }
+    }
+
+    $new_symlink = $new_path;
+
+    if (&is_symlink($real_old_path)) {
+
+        $old_symlink = $old_path;
+
+        # Source is presumably a symlink: ensure it is
+        die "Error: `" .$old_path. "' is expected to be a symlink.\n"
+            unless -l $real_old_path;
+
+        $old_target = realpath ($old_path);
+        die "Error: `" .$old_path. "' is expected to target to `"
+                       .catfile(updir(),'DIRECTORS','*',$old_filename). "'.\n"
+            unless (defined $new_director
+                    || &is_director(\$new_director, $old_target));
+        $new_target = catfile ($directors, $new_director, $new_filename);
+    }
+
+    elsif (&is_director(\$old_director, $real_old_path)) {
+
+        $old_symlink = catfile ($symlinks, $old_filename);
+        die "Error: `" .$old_symlink. "' is expected to be a symlink.\n"
+            unless -l $old_symlink;
+        die "Error: `" .$old_symlink. "' is expected to target to `"
+                       .catfile(updir(),'DIRECTORS',$old_director,$old_filename)
+                       ."'.\n"
+            unless realpath($old_symlink) eq realpath($old_path);
+
+        $old_target = $old_path;
+
+        $new_director = $old_director unless defined $new_director;
+        $new_target = catfile ($directors, $new_director, $new_filename);
+    }
+
+    else {
+        $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 `--lookup-db' flag.\n"
+            unless defined $new_director;
+
+        $new_target = catfile ($directors, $new_director, $new_filename);
+    }
+}
+
+elsif (&is_director(\$new_director, $real_new_path)) {
+
+    # The destination is under $directors/*
+
+    $new_target = $new_path;
+    $new_symlink = catfile ($symlinks, $new_filename);
+
+    if (&is_symlink($real_old_path)) {
+
+        # Source is presumably a symlink: ensure it is
+        die "Error: `" .$old_path. "' is expected to be a symlink.\n"
+            unless -l $real_old_path;
+
+        $old_symlink = $old_path;
+        $old_target = realpath ($old_path);
+    }
+
+    elsif (&is_director(\$old_director, $real_old_path)) {
+
+        $old_symlink = catfile ($symlinks, $old_filename);
+        die "Error: `" .$old_symlink. "' is expected to be a symlink.\n"
+            unless -l $old_symlink;
+        die "Error: `" .$old_symlink. "' is expected to target to `"
+                       .catfile(updir(),'DIRECTORS',$old_director,$old_filename)
+                       ."'.\n"
+            unless realpath($old_symlink) eq realpath($old_path);
+
+        $old_target = $old_path;
+    }
+
+    else {
+        $old_target = $old_path;
+        die "Error: `" .$old_path. "' is expected to be a regular file.\n"
+            unless -f $old_path;
+    }
+}
+else {
+    die "Error: destination has to be in `"
+                  .$symlinks. "' or in `" .catfile($directors,'*'). "'.\n"
+       ."See `" .$0. " --man' for details\n";
+}
+
+
+my @actions;    # Successful actions
+
+if (dirname (realpath $old_target) eq dirname (realpath $new_target)) {
+    &perform ("Renaming target...      ", rename $old_target, $new_target)
+        unless ($old_filename eq $new_filename);
+}
+else {
+    &perform ("Moving target...        ", move $old_target, $new_target);
+}
+
+my $old_tar;
+if (defined $old_symlink) {
+    $old_tar = readlink $old_symlink;
+    &perform ("Deleting old symlink... ", unlink $old_symlink);
+}
+
+
+&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 $config{videodata} SET filename = ? WHERE id = ?",
+                            undef, $new_filename, $id
+                 );
+        &ack (\$r, $rv);
+    }
+}
+
+
+# Disconnect
+$dbh->disconnect() unless defined $ignoredb_flag;
+
+exit $r;
+
+
+
+################################################################################
+
+
+
+# Acknowledge the result of a test
+sub ack {
+    my ($r, $test) = @_;
+    if ($test) {
+        print LOG "OK\n";
+        return 0;
+    } else {
+        print LOG "failed!: $!\n";
+        $$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 @_;
+
+    return if $#actions < 0;
+
+    print LOG "\n";
+    print STDERR "Failed!: reverting successful changes...\n";
+
+    while ($#actions >= 0) {
+        my $rev;
+        if ($actions[0] =~ /^(Renaming target)(\.{3}) {5}( *)/) {
+            $actions[0] = $1 .' back'. $2.$3;
+            $rev = rename $new_target, $old_target;
+        }
+        elsif ($actions[0] =~ /^(Moving target)(\.{3}) {5}( *)/) {
+            $actions[0] = $1 .' back'. $2.$3;
+            $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 {
+    my @path = splitdir ($_[0]);
+    my @real_symlinks = @real_symlinks; #local copy
+
+    while ($#real_symlinks>=0 && $#path>=0 && $real_symlinks[0] eq $path[0]) {
+        shift @real_symlinks;
+        shift @path;
+    };
+
+    if ($#real_symlinks<0 && $#path==0) {
+        return 1; # That's a "symlink"
+    } else {
+        return 0; # That's not a "symlink"
+    }
+}
+
+# Check wether a path starts with $director/dir, and put `dir' in the
+# first argument if that's the case
+sub is_director {
+    my @path = splitdir ($_[1]);
+    my @real_directors = @real_directors; #local copy
+
+    while ($#real_directors>=0 && $#path>=0 && $real_directors[0] eq $path[0]) {
+        shift @real_directors;
+        shift @path;
+    };
+
+    if ($#real_directors<0 && $#path>=0) {
+        ${$_[0]} = $path[0] if defined $_[0];
+        return 1; # That's a "director"
+    } else {
+        return 0; # That's not a "director"
+    }
+}