summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xvideomv.pl397
1 files changed, 261 insertions, 136 deletions
diff --git a/videomv.pl b/videomv.pl
index 9c42979..aa7a9ad 100755
--- a/videomv.pl
+++ b/videomv.pl
@@ -7,24 +7,25 @@
# See http://sam.zoy.org/wtfpl/COPYING for more details.
-$VERSION = "0.1, 08 August 2011";
+$VERSION = "0.1, 10 August 2011";
-use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat
- bundling auto_version auto_help);
+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;
################################################################################
-# This path has to be absolute!
-my $video = "/home/guilhem/video";
+# Configuration
+my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder
+my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder
-my $symlinks = "MOVIES"; # Symlinks folder in $video
-my $directors = "DIRECTORS"; # Directors folder in $video
-
-# Database configuration
my $driver = "mysql";
my $database = "videodb";
my $hostname = "127.0.0.1";
@@ -41,7 +42,8 @@ videomv.pl - TODO
=head1 SYNOPSIS
-B<videomv.pl> [B<--sort>] I<path/to/oldfile> [I<.../>{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]
+B<videomv.pl> [B<--sort>]
+I<path/to/oldfile> [I<.../>{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]
video
|- ...
@@ -71,14 +73,15 @@ actions will be performed:
=over 4
-=item * The filename in the database will be updated,
-=item * the old target will be renamed to I<../DIRECTORS/director/newfile>,
+=item * The old target will be renamed to I<../DIRECTORS/director/newfile>,
-=item * the old symlink will be deleted, and
+=item * the old symlink will be deleted,
=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
-will be created.
+will be created, and
+
+=item * the filename in the database will be updated.
=back
@@ -97,16 +100,16 @@ Otherwise, the following actions will be performed:
=over 4
-=item * The filename in the database will be updated if I<oldfile><>I<newfile>,
-
-=item * the old target will be moved to I<../DIRECTORS/newdirector/newfile>,
+=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, and
+=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.
+will be created, and
+
+=item * the filename in the database will be updated if I<oldfile><>I<newfile>.
=back
@@ -120,15 +123,15 @@ actions will be performed:
=over 4
-=item * The filename in the database will be updated,
-
-=item * the old target I<../DIRECTORS/director/oldfile> will be renamed to
+=item * The old target I<../DIRECTORS/director/oldfile> will be renamed to
I<../DIRECTORS/director/newfile>,
-=item * the old symlink will be deleted, and
+=item * the old symlink will be deleted,
=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
-will be created.
+will be created, and
+
+=item * the filename in the database will be updated.
=back
@@ -144,59 +147,62 @@ Otherwise, the following actions will be performed:
=over 4
-=item * The filename in the database will be updated if I<oldfile><>I<newfile>,
-
-=item * the old target I<../DIRECTORS/olddirector/oldfile> will be moved to
+=item * The old target I<../DIRECTORS/olddirector/oldfile> will be moved to
I<../DIRECTORS/newdirector/newfile>,
-=item * the old symlink will be deleted, and
+=item * the old symlink will be deleted,
=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
-will be created.
+will be created, and
+
+=item * the filename in the database will be updated if I<oldfile><>I<newfile>.
=back
=item B<videomv.pl> B<--sort> I<path/to/oldfile> [I<.../MOVIES/newfile>]
-Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>.
+Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>,
+and I<oldfile> is a regular file.
The director will looked for in the database, and and error will be
raised if no entry is found.
Otherwise, the following actions will be performed:
=over 4
-=item * The filename in the database will be updated if I<oldfile><>I<newfile>,
-
-=item * the old file will be moved to I<../DIRECTORS/director/newfile>
+=item * The old file will be moved to I<../DIRECTORS/director/newfile>
(or to I<../DIRECTORS/director/oldfile> if the second argument 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.
+argument was not given) will be created, and
+
+=item * the filename in the database will be updated if I<oldfile><>I<newfile>.
=back
-Note that the B<--sort> has to set for this to work; if not, an error
+Note that the B<--sort> 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/*/>.
+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 * The filename in the database will be updated if I<oldfile><>I<newfile>,
-
-=item * the old file will be moved to I<../DIRECTORS/director/newfile>
+=item * The old file 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.
+argument was not given) will be created,
+
+=item * the filename in the database will be updated if I<oldfile><>I<newfile>.
+
=back
@@ -211,6 +217,10 @@ argument was not given) will be created.
TODO
+=item B<--fail>
+
+TODO
+
=back
=head1 EXIT STATUS
@@ -229,12 +239,11 @@ Copyright 2011 Guilhem Moulin. See the source for copying conditions.
################################################################################
-my $man;
-my $quiet;
-
+my $sort;
# Get options
-GetOptions( "q|quiet" => sub { open LOG, '>', '/dev/null'
+GetOptions( "sort" => \$sort,
+ "q|quiet" => sub { open LOG, '>', '/dev/null'
or die "Cannot open `/dev/null': $!" },
"man" => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
)
@@ -242,12 +251,28 @@ GetOptions( "q|quiet" => sub { open LOG, '>', '/dev/null'
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: `" .$old_path. "' does not exist\n"
+ unless (-l $old_path or -f $old_path);
-# File to rename/sort, with its path
-my $old_file = $ARGV[0];
+$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);
-# Basenames of files to rename to / sort
-my ($old_filename, $new_filename) = map {basename($_)} @ARGV;
+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
@@ -263,120 +288,183 @@ my $RES =
WHERE filename = ?",
'id', undef, $old_filename
)
- or die "Can't select: " . $dbh->errstr;
-
+ or die "Can't select: " .$dbh->errstr. "\n";
my $nRES = scalar (keys %$RES);
-die "Error: no entry entry found in the database.\n" if $nRES == 0;
-die "Error: $nRES > 1 entries found in the database.\n" if $nRES > 1;
+# The ID of the first movie found in the database, if any
+my $id = each %$RES;
+my $r;
+my ($old_director, $new_director);
+my ($old_symlink, $new_symlink, $new_target, $old_target);
-# The *unique* ID of the movie found in the database
-my $id = each %$RES;
+if (&is_symlink($real_new_path)) {
+ # The destination is under $symlinks
-print LOG "One entry found: " .
- $RES->{$id}->{director} . " - " . $RES->{$id}->{title} . "\n";
+ if (defined $sort) {
+ # Find the new director on the database
-if (defined $new_filename) {
-# print LOG "Update filename for " .
-# $RES->{$id}->{director} . " - " . $RES->{$id}->{title} .
-# ":\n";
-# print LOG "`" . $old_filename . "' -> `" . $new_filename, "'\n";
+ # Ensure there is exactly one entry in the db
+ die "Error: No entry found in the database while the flag `--sort' was set.\n"
+ if $nRES == 0;
+ die "Error: Multiples entries found in the database while the flag `--sort' was set.\n"
+ if $nRES > 1;
- &rename ($id, $old_filename, $new_filename);
-}
-else {
- # TODO: this might not be a valid dirname!
- my $dirname = $directors .'/'. $RES->{$id}->{director};
-# print LOG "Sort " .
-# $RES->{$id}->{director} . " - " . $RES->{$id}->{title} . ":\n";
-# print LOG "`" . $old_filename . "' -> `" . $dirname . "'\n";
+ $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;
+ }
+ }
+ }
+ }
- &arrange ($old_file, $dirname);
-}
-
-# Disconnect
-$dbh->disconnect();
+ $new_symlink = $new_path;
+ if (&is_symlink($real_old_path)) {
-################################################################################
+ $old_symlink = $old_path;
-# TODO: find the target from the database instead (option)
-sub rename {
- my ($id, $old_filename, $new_filename) = @_;
- my $r = 0;
-
- print LOG "Updating database... ";
- my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
- undef, $new_filename, $id
- );
- &ack (\$r, $rv);
-
- my $old_symlink = $video .'/'. $symlinks .'/'. $old_filename;
- my $new_symlink = $video .'/'. $symlinks .'/'. $new_filename;
-
- unless (-l $old_symlink) {
- print LOG "Warning: `$old_symlink' does not exist!\n";
- return 1;
+ # 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);
}
- chdir $video .'/'. $symlinks
- or die "Can't cd to `$video/$symlinks': $!";
-
- # Find the previous directory of the file TODO
- my $old_target = readlink $old_symlink;
- my $new_target = dirname($old_target) .'/'. $new_filename;
-
- print LOG "Renaming file... ";
- &ack (\$r, rename $old_target, $new_target);
+ elsif (&is_director(\$old_director, $real_old_path)) {
- print LOG "Creating new symlink... ";
- &ack (\$r, symlink $new_symlink, $new_target);
-
- print LOG "Deleting old symlink... ";
- &ack (\$r, unlink $old_symlink);
-
- return $r;
+ $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 `--sort' flag.\n"
+ unless defined $new_director;
+
+ $new_target = catfile ($directors, $new_director, $new_filename);
+ }
}
+elsif (&is_director(\$new_director, $real_new_path)) {
-# TODO: if the second argument is a directory, don't update database but
-# only symlinks (and mv the file in the dir)
+ # The destination is under $directors/*
-sub arrange {
- my ($old_filename, $director) = @_;
- my $r;
+ $new_target = $new_path;
+ $new_symlink = catfile ($symlinks, $new_filename);
- my $new_dirname = $video .'/'. $director;
+ if (&is_symlink($real_old_path)) {
- 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 "Cannot mkdir `$new_dirname': $!";
- }
- elsif ($a eq 'n') {
- exit 0;
- }
- }
-
- # TODO
- print "\n";
+ # 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);
}
- print LOG "Moving file... ";
- &ack (\$r, CORE::rename $old_filename, $new_dirname);
+ elsif (&is_director(\$old_director, $real_old_path)) {
- print LOG "Creating symlink... ";
- &ack (\$r, symlink '../'. $director .'/'. basename($old_filename),
- $video .'/'. $symlinks);
+ $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);
- return $r;
+ $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";
+}
+
+
+
+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);
+ }
+}
+else {
+ print LOG "Moving target... ";
+ &ack (\$r, move $old_target, $new_target);
+}
+if (defined $old_symlink) {
+ print LOG "Deleting old symlink... ";
+ &ack (\$r, 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) {
+ print LOG "Updating database... ";
+ if ($nRES == 0) {
+ print LOG "failed!: no entry found.\n";
+ }
+ elsif ($nRES > 1) {
+ print LOG "failed!: multiple entries found.\n";
+ }
+ else {
+ my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
+ undef, $new_filename, $id
+ );
+ &ack (\$r, $rv);
+ }
+}
+
+# Disconnect
+$dbh->disconnect();
+
+
+
+################################################################################
@@ -390,3 +478,40 @@ sub ack {
$$r = 1;
}
}
+
+
+# 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"
+ }
+}