diff options
| -rwxr-xr-x | videomv.pl | 198 |
1 files changed, 174 insertions, 24 deletions
@@ -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; + } +} |