rename, update

1 files changed, 174 insertions, 24 deletions

diff --git a/videomv.pl b/videomv.pl
index cc894f2..8ef89ad 100755
--- a/videomv.pl
+++ b/videomv.pl
@@ -6,13 +6,25 @@
 # License, Version 2, as published by Sam Hocevar.
 # See http://sam.zoy.org/wtfpl/COPYING for more details.
 
+
+$VERSION = "0.1, 08 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 strict;
 
+################################################################################
+
+# This path has to be absolute!
+my $video     = "/home/guilhem/video";
+
+my $symlinks  = "MOVIES";       # Symlinks folder in $video
+my $directors = "DIRECTORS";    # Directors folder in $video
 
-# Database
+# Database configuration
 my $driver    = "mysql";
 my $database  = "videodb";
 my $hostname  = "127.0.0.1";
@@ -23,47 +35,185 @@ my $videodata = "videodb_videodata";
 
 ################################################################################
 
+=head1 NAME
+
+videomv.pl - TODO
+
+=head1 SYNOPSIS
+
+B<videomv.pl> TODO
+
+
+=head1 DESCRIPTION
+
+TODO
+
+=head1 AUTHOR
+
+Copyright 2011 Guilhem Moulin. See the source for copying conditions.
+
+=cut
+
+################################################################################
+
+my $man;
+my $quiet;
+
+
+# Get options
+GetOptions( "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);
+
+
+# File to rename/sort, with its path
+my $old_file = $ARGV[0];
+
+# Basenames of files to rename to / sort
+my ($old_filename, $new_filename) = map {basename($_)} @ARGV;
+
+
 # Connect to database
 my $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port";
 my $dbh = DBI->connect($dsn, $user, $password)
-              or die "Failed to connect; have you tried `mktunnel --sql' first?";
-
-# Use utf8
+              or die "Can't connect do database";
 $dbh->do( "set names utf8" ) or die;
 
 
-my ($from, $to) = @ARGV;
-
-
+# Lookup for the file in the videodb database
 my $RES =
-    $dbh->selectall_hashref ( "SELECT id,title,director FROM $videodata
+    $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata
                                WHERE filename = ?",
-                              'id', undef, $from
+                              'id', undef, $old_filename
     )
         or die "Can't select: " . $dbh->errstr;
 
 my $nRES = scalar (keys %$RES);
 
-if ($nRES == 0) {
-    print STDERR "No entry found in the database: nothing to update there.\n";
-}
-elsif ($nRES > 1) {
-    print STDERR "$nRES > 1 entries found in the database: dunno what to update there.\n";
+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 *unique* ID of the movie found in the database
+my $id = each %$RES;
+
+
+print LOG "One entry found: " .
+          $RES->{$id}->{director} .  " - " . $RES->{$id}->{title} . "\n";
+
+if (defined $new_filename) {
+#    print LOG "Update filename for " .
+#              $RES->{$id}->{director} .  " - " .  $RES->{$id}->{title} .
+#              ":\n";
+#    print LOG "`" . $old_filename . "' -> `" . $new_filename, "'\n";
+
+    &rename ($id, $old_filename, $new_filename);
 }
 else {
-    my ($id,$v) = each %$RES;
-    print STDERR "Update filename for " . $v->{director} .
-                  " - " .  $v->{title} . ":\n";
-    print STDERR "`" . $from . "' -> `" . $to, "'\n";
+    # 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";
 
+    &arrange ($old_file, $dirname);
+}
+    
+# Disconnect
+$dbh->disconnect();
 
-    $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
-               undef, $to, $id
-    )
-        or die "Can't update: " . $dbh->errstr;
+
+################################################################################
+
+# TODO: find the target from the database instead (option)
+# TODO: if the second argument is a directory, don't update database but
+# only symlinks (and mv the file in the dir)
+
+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;
+    }
+
+    chdir $video .'/'. $symlinks 
+        or  die "Can't cd to `$video/$symlinks': $!";
+    
+    # Find the director on the
+    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);
+
+    print LOG "Creating new symlink... ";
+    &ack (\$r, symlink $new_symlink, $new_target);
+    
+    print LOG "Deleting old symlink... ";
+    &ack (\$r, unlink $old_symlink);
+    
+    return $r;
 }
 
 
+sub arrange {
+    my ($old_filename, $director) = @_;
+    my $r;
+
+    my $new_dirname = $video .'/'. $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 "Cannot mkdir `$new_dirname': $!";
+            }
+            elsif ($a eq 'n') {
+                exit 0;
+            }
+        }
+        
+        # TODO
+        print "\n";
+    }
+
+    print LOG "Moving file...      ";
+    &ack (\$r, CORE::rename $old_filename, $new_dirname);
+
+    print LOG "Creating symlink... ";
+    &ack (\$r, symlink '../'. $director .'/'. basename($old_filename),
+                       $video .'/'. $symlinks);
+
+    return $r;
+}
 
-# Disconnect
-$dbh->disconnect();
+
+
+# Acknowledge the result of a test
+sub ack {
+    my ($r, $test) = @_;
+    if ($test) {
+        print LOG "OK\n";
+    } else {
+        print LOG "failed!: $!\n";
+        $$r = 1;
+    }
+}