summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--videodb.rc4
-rwxr-xr-xvideomv.pl686
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"
+ }
+}