diff options
| -rwxr-xr-x | videomv.pl | 397 |
1 files changed, 261 insertions, 136 deletions
@@ -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" + } +} |