summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xvideomv.pl198
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;
+ }
+}