From ef0fd3acd538e3ccd51502ed1482342771046fdf Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 8 Aug 2011 15:56:36 +0200 Subject: update db --- videomv.pl | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100755 videomv.pl diff --git a/videomv.pl b/videomv.pl new file mode 100755 index 0000000..cc894f2 --- /dev/null +++ b/videomv.pl @@ -0,0 +1,69 @@ +#! /usr/bin/perl -w + +# This program is free software. It comes without any warranty, to the +# extent permitted by applicable law. You can redistribute it and/or +# modify it under the terms of the Do What The Fuck You Want To Public +# License, Version 2, as published by Sam Hocevar. +# See http://sam.zoy.org/wtfpl/COPYING for more details. + +use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat + bundling auto_version auto_help); +use DBI; +use strict; + + +# Database +my $driver = "mysql"; +my $database = "videodb"; +my $hostname = "127.0.0.1"; +my $user = "videodb"; +my $port = 3306; +my $password = "videodb"; +my $videodata = "videodb_videodata"; + +################################################################################ + +# 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 +$dbh->do( "set names utf8" ) or die; + + +my ($from, $to) = @ARGV; + + +my $RES = + $dbh->selectall_hashref ( "SELECT id,title,director FROM $videodata + WHERE filename = ?", + 'id', undef, $from + ) + 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"; +} +else { + my ($id,$v) = each %$RES; + print STDERR "Update filename for " . $v->{director} . + " - " . $v->{title} . ":\n"; + print STDERR "`" . $from . "' -> `" . $to, "'\n"; + + + $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?", + undef, $to, $id + ) + or die "Can't update: " . $dbh->errstr; +} + + + +# Disconnect +$dbh->disconnect(); -- cgit v1.2.3 From 82806fd253a0bfb3f6c3c84087d94c7ff0e78ecd Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 8 Aug 2011 20:59:49 +0200 Subject: rename, update --- videomv.pl | 198 +++++++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file 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 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 ; + 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; + } +} -- cgit v1.2.3 From 6903356ad5c7d966207f41688854288e739aa2e3 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 9 Aug 2011 15:03:54 +0200 Subject: man --- videomv.pl | 183 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 178 insertions(+), 5 deletions(-) diff --git a/videomv.pl b/videomv.pl index 8ef89ad..9c42979 100755 --- a/videomv.pl +++ b/videomv.pl @@ -41,11 +41,184 @@ videomv.pl - TODO =head1 SYNOPSIS -B TODO +B [B<--sort>] I [I<.../>{I,I}I[I]] + +video + |- ... + |- DIRECTORS + | |- director1/ + | |- director2/ + | `- ... + `- MOVIES/ =head1 DESCRIPTION +Depending on whether I is I<.../MOVIES/>, +I<.../DIRECTORS/director/>, or something +else, one has one of the six behaviors below. For the sake of +readability the paths are absolute here, but relative paths are fine as +well. + +=over 4 + +=item B [B<--sort>] I<.../MOVIES/oldfile> I<.../MOVIES/newfile> + +I is supposed to be an existing symlink in I<.../MOVIES/>, +which targets to I<../DIRECTORS/director/oldfile>. If +I=I, an error will be raised. Otherwise, the following +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 symlink will be deleted, and + +=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile> +will be created. + +=back + +If the B<--sort> flag is set, the new I will be find on the +database instead of from the old target. + + +=item B I<.../MOVIES/oldfile> I<.../DIRECTOR/newdirector/>[I] + +I is supposed to be an existing symlink in I<.../MOVIES/>, +which targets to I<../DIRECTORS/olddirector/oldfile>. If +I=I +(or if I=I and I was not given), +an error will be raised. +Otherwise, the following actions will be performed: + +=over 4 + +=item * The filename in the database will be updated if I<>I, + +=item * the old target will be moved to I<../DIRECTORS/newdirector/newfile>, +(or to I<../DIRECTORS/newdirector/oldfile> if I was not given), + +=item * the old symlink will be deleted, and + +=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile> +(or -> I<../DIRECTORS/newdirector/oldfile> if I was not given) +will be created. + +=back + + +=item B [B<--sort>] I<.../DIRECTORS/director/oldfile> I<.../MOVIES/newfile> + +A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> is +supposed to exist. +If I=I, an error will be raised. Otherwise, the following +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 +I<../DIRECTORS/director/newfile>, + +=item * the old symlink will be deleted, and + +=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile> +will be created. + +=back + + +=item B I<.../DIRECTORS/olddirector/oldfile> I<.../DIRECTOR/newdirector/>[I] + +A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/olddirector/oldfile> is +supposed to exist. +If I=I +(or if I=I and I was not given), +an error will be raised. +Otherwise, the following actions will be performed: + +=over 4 + +=item * The filename in the database will be updated if I<>I, + +=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 * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile> +will be created. + +=back + + +=item B B<--sort> I [I<.../MOVIES/newfile>] + +Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>. +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<>I, + +=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. + +=back + +Note that the B<--sort> has to set for this to work; if not, an error +will be raised. + + +=item B I I<.../DIRECTOR/director/>[I] + +Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>. +The following actions will be performed: + +=over 4 + +=item * The filename in the database will be updated if I<>I, + +=item * the old file will be moved to I<../DIRECTORS/director/newfile> +(or to I<../DIRECTORS/director/oldfile> if I 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. + +=back + +=back + + +=head1 OPTIONS + +=over 8 + +=item B<--sort> + +TODO + +=back + +=head1 EXIT STATUS + +TODO + +=head1 REQUIREMENTS + TODO =head1 AUTHOR @@ -130,9 +303,6 @@ $dbh->disconnect(); ################################################################################ # 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; @@ -154,7 +324,7 @@ sub rename { chdir $video .'/'. $symlinks or die "Can't cd to `$video/$symlinks': $!"; - # Find the director on the + # Find the previous directory of the file TODO my $old_target = readlink $old_symlink; my $new_target = dirname($old_target) .'/'. $new_filename; @@ -171,6 +341,9 @@ sub rename { } +# TODO: if the second argument is a directory, don't update database but +# only symlinks (and mv the file in the dir) + sub arrange { my ($old_filename, $director) = @_; my $r; -- cgit v1.2.3 From 8be52d49a18dc2ee21f10d2d0d75f8d6dd33f822 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 00:56:12 +0200 Subject: v0.1 :D --- videomv.pl | 397 ++++++++++++++++++++++++++++++++++++++++--------------------- 1 file 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 [B<--sort>] I [I<.../>{I,I}I[I]] +B [B<--sort>] +I [I<.../>{I,I}I[I]] 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<>I, - -=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 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 was not given) -will be created. +will be created, and + +=item * the filename in the database will be updated if I<>I. =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<>I, - -=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<>I. =back =item B B<--sort> I [I<.../MOVIES/newfile>] -Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>. +Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>, +and I 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<>I, - -=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<>I. =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 I I<.../DIRECTOR/director/>[I] -Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>. +Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>, +and I is a regular file. The following actions will be performed: =over 4 -=item * The filename in the database will be updated if I<>I, - -=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 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<>I. + =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 ; + 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 ; - 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" + } +} -- cgit v1.2.3 From 951466e527d5c2872f7113d08329e614df51b0b0 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 02:22:34 +0200 Subject: doc --- videomv.pl | 160 +++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 93 insertions(+), 67 deletions(-) diff --git a/videomv.pl b/videomv.pl index aa7a9ad..9eb1a5e 100755 --- a/videomv.pl +++ b/videomv.pl @@ -38,35 +38,50 @@ my $videodata = "videodb_videodata"; =head1 NAME -videomv.pl - TODO +videomv.pl - Move your videos to or within your collection. =head1 SYNOPSIS -B [B<--sort>] -I [I<.../>{I,I}I[I]] +B [B<--db>] [B<-q>] +I [{I,I}I[I]] + +=head1 DESCRIPTION + +Your collection is assumed to have the following structure: two +folders, here I and I that have the same parent. +I contains one subdirectory for each director, and each movie +lies (B) in the subdirectory of its director. +The I folders contains symlinks, one for each movie, that target +to I<../DIRECTORS/director_of_the_movie/movie>. +The behavior of B is NOT specified if your collection does +not verify these conventions! -video |- ... |- DIRECTORS - | |- director1/ + | |- director1 + | |- |- movie11 + | | `- movie12 | |- director2/ | `- ... - `- MOVIES/ + `- MOVIES + |- movie11 -> ../DIRECTORS/director1/movie1 + |- movie12 -> ../DIRECTORS/director1/movie2 + `- ... -=head1 DESCRIPTION -Depending on whether I is I<.../MOVIES/>, -I<.../DIRECTORS/director/>, or something -else, one has one of the six behaviors below. For the sake of -readability the paths are absolute here, but relative paths are fine as -well. +Depending on whether I is I, +I, or something +else, you will get one of the six behaviors below. For the sake of +readability the paths are relative to the root of your video collection +here, but hopefully other origins or +paths that contain symlinks are fine as well. =over 4 -=item B [B<--sort>] I<.../MOVIES/oldfile> I<.../MOVIES/newfile> +=item B [B<--db>] I I -I is supposed to be an existing symlink in I<.../MOVIES/>, +I is expected to be an existing symlink in I, which targets to I<../DIRECTORS/director/oldfile>. If I=I, an error will be raised. Otherwise, the following actions will be performed: @@ -74,24 +89,24 @@ actions will be performed: =over 4 -=item * The old target will be renamed to I<../DIRECTORS/director/newfile>, +=item * The old target will be renamed to I, =item * the old symlink will be deleted, -=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile> +=item * a new symlink I -> I<../DIRECTORS/director/newfile> will be created, and =item * the filename in the database will be updated. =back -If the B<--sort> flag is set, the new I will be find on the -database instead of from the old target. +If the B<--db> flag is set, the new I will be found on the +database instead of by parsing the path of the old target. -=item B I<.../MOVIES/oldfile> I<.../DIRECTOR/newdirector/>[I] +=item B I I[I] -I is supposed to be an existing symlink in I<.../MOVIES/>, +I is expected to be an existing symlink in I, which targets to I<../DIRECTORS/olddirector/oldfile>. If I=I (or if I=I and I was not given), @@ -100,46 +115,49 @@ Otherwise, the following actions will be performed: =over 4 -=item * The old target will be moved to I<../DIRECTORS/newdirector/newfile>, -(or to I<../DIRECTORS/newdirector/oldfile> if I was not given), +=item * The old target will be moved to I, +(or to I if I was not given), =item * the old symlink will be deleted, -=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile> +=item * a new symlink I -> I<../DIRECTORS/newdirector/newfile> (or -> I<../DIRECTORS/newdirector/oldfile> if I was not given) will be created, and -=item * the filename in the database will be updated if I<>I. +=item * the filename in the database will be updated unless I=I. =back -=item B [B<--sort>] I<.../DIRECTORS/director/oldfile> I<.../MOVIES/newfile> +=item B [B<--db>] I I -A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> is -supposed to exist. +A symlink I -> I<../DIRECTORS/director/oldfile> is +expected to exist. If I=I, an error will be raised. Otherwise, the following actions will be performed: =over 4 -=item * The old target I<../DIRECTORS/director/oldfile> will be renamed to -I<../DIRECTORS/director/newfile>, +=item * The old target I will be renamed to +I, =item * the old symlink will be deleted, -=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile> +=item * a new symlink I -> I<../DIRECTORS/director/newfile> will be created, and =item * the filename in the database will be updated. =back +If the B<--db> flag is set, the new I will be found on the +database instead of by parsing the path of the old target. -=item B I<.../DIRECTORS/olddirector/oldfile> I<.../DIRECTOR/newdirector/>[I] -A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/olddirector/oldfile> is -supposed to exist. +=item B I I[I] + +A symlink I -> I<../DIRECTORS/olddirector/oldfile> is +expected to exist. If I=I (or if I=I and I was not given), an error will be raised. @@ -152,56 +170,55 @@ I<../DIRECTORS/newdirector/newfile>, =item * the old symlink will be deleted, -=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile> +=item * a new symlink I -> I<../DIRECTORS/newdirector/newfile> will be created, and -=item * the filename in the database will be updated if I<>I. +=item * the filename in the database will be updated unless I=I. =back -=item B B<--sort> I [I<.../MOVIES/newfile>] +=item B B<--db> I [I[I]] -Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>, +Where I is neither of I nor I, and I 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: +The I will found in the database, and and error will be +raised if no entry is (or multiple entries are) found. +In case of success, the following actions will be performed: =over 4 -=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 * I will be moved to I +(or to I if I 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, and +=item * a symlink I -> I<../DIRECTORS/director/newfile> +(or I -> I<../DIRECTORS/director/oldfile> if I +was not given) will be created, and -=item * the filename in the database will be updated if I<>I. +=item * the filename in the database will be updated unless I=I. =back -Note that the B<--sort> has to be set for this to work; if not, an error +Note that the B<--db> flag has to be set for this to work; if not, an error will be raised. -=item B I I<.../DIRECTOR/director/>[I] +=item B I I[I] -Where I is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>, +Where I is neither of I nor I, and I is a regular file. The following actions will be performed: =over 4 -=item * The old file will be moved to I<../DIRECTORS/director/newfile> -(or to I<../DIRECTORS/director/oldfile> if I was not given), +=item * I will be moved to I +(or to I if I was not given), -=item * a symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile> -(or I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second +=item * a symlink I -> I<../DIRECTORS/director/newfile> +(or I -> I<../DIRECTORS/director/oldfile> if the second argument was not given) will be created, -=item * the filename in the database will be updated if I<>I. +=item * the filename in the database will be updated unless I=I. =back @@ -213,23 +230,26 @@ argument was not given) will be created, =over 8 -=item B<--sort> +=item B<--db> -TODO +If the second argument is in I and this flag is set, B +will search the I in the data base. An error will be raied if +no entry is (or multiple entries are) found. Look above for details. -=item B<--fail> +=item B<-q>, B<--quiet> -TODO +By default, B prints each action it performs, with their +return status. This flag supresses this behavior. =back =head1 EXIT STATUS -TODO +The exit status is 0 if all the actions went through, and 1 otherwise. =head1 REQUIREMENTS -TODO +The imported modules are available on CPAN. See the source for details. =head1 AUTHOR @@ -239,10 +259,15 @@ Copyright 2011 Guilhem Moulin. See the source for copying conditions. ################################################################################ -my $sort; + +#TODO: overwrite existing files? +#TODO: revert in case of error +#TODO: explore depth>1 in DIRECTORS/ + +my $db_flag; # Get options -GetOptions( "sort" => \$sort, +GetOptions( "db" => \$db_flag, "q|quiet" => sub { open LOG, '>', '/dev/null' or die "Cannot open `/dev/null': $!" }, "man" => sub { pod2usage(-exitstatus => 0, -verbose => 2) } @@ -302,13 +327,13 @@ if (&is_symlink($real_new_path)) { # The destination is under $symlinks - if (defined $sort) { + if (defined $db_flag) { # Find the new director on the database # Ensure there is exactly one entry in the db - die "Error: No entry found in the database while the flag `--sort' was set.\n" + die "Error: No entry found in the database while the flag `--db' was set.\n" if $nRES == 0; - die "Error: Multiples entries found in the database while the flag `--sort' was set.\n" + die "Error: Multiples entries found in the database while the flag `--db' was set.\n" if $nRES > 1; $new_director = $RES->{$id}->{director}; @@ -373,7 +398,7 @@ if (&is_symlink($real_new_path)) { $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" + die "Error: Dunno where to put this file. Try the `--db' flag.\n" unless defined $new_director; $new_target = catfile ($directors, $new_director, $new_filename); @@ -462,6 +487,7 @@ unless ($old_filename eq $new_filename) { # Disconnect $dbh->disconnect(); +return $r; ################################################################################ -- cgit v1.2.3 From d0d62f517db4e5559bade48a87e93984e076cddd Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 02:24:34 +0200 Subject: typo --- videomv.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/videomv.pl b/videomv.pl index 9eb1a5e..9afd61c 100755 --- a/videomv.pl +++ b/videomv.pl @@ -51,7 +51,7 @@ Your collection is assumed to have the following structure: two folders, here I and I that have the same parent. I contains one subdirectory for each director, and each movie lies (B) in the subdirectory of its director. -The I folders contains symlinks, one for each movie, that target +The folder I contains symlinks - one for each movie - that target to I<../DIRECTORS/director_of_the_movie/movie>. The behavior of B is NOT specified if your collection does not verify these conventions! -- cgit v1.2.3 From d3083a686983131b5cbb645ac9fdd54199d07426 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 14:41:57 +0200 Subject: revert --- videomv.pl | 212 ++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 148 insertions(+), 64 deletions(-) diff --git a/videomv.pl b/videomv.pl index 9afd61c..bce7064 100755 --- a/videomv.pl +++ b/videomv.pl @@ -7,7 +7,7 @@ # See http://sam.zoy.org/wtfpl/COPYING for more details. -$VERSION = "0.1, 10 August 2011"; +$VERSION = "0.2, 10 August 2011"; use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version auto_help/; @@ -23,8 +23,12 @@ use strict; ################################################################################ # Configuration -my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder -my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder + +my $symlinks = catdir('/','tmp','video','MOVIES'); # Symlinks folder +my $directors = catdir('', 'tmp','video','DIRECTORS'); # Directors folder + +#my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder +#my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder my $driver = "mysql"; my $database = "videodb"; @@ -42,7 +46,7 @@ videomv.pl - Move your videos to or within your collection. =head1 SYNOPSIS -B [B<--db>] [B<-q>] +B [B<--lookup-db>] [B<--ignore-db>] [B<-q>] I [{I,I}I[I]] =head1 DESCRIPTION @@ -69,7 +73,6 @@ not verify these conventions! `- ... - Depending on whether I is I, I, or something else, you will get one of the six behaviors below. For the sake of @@ -79,7 +82,7 @@ paths that contain symlinks are fine as well. =over 4 -=item B [B<--db>] I I +=item B [B<--lookup-db>] I I I is expected to be an existing symlink in I, which targets to I<../DIRECTORS/director/oldfile>. If @@ -100,8 +103,8 @@ will be created, and =back -If the B<--db> flag is set, the new I will be found on the -database instead of by parsing the path of the old target. +If the B<--lookup-db> flag is set, the new I will be found on the +database instead of by parsing the path of the old target. =item B I I[I] @@ -129,7 +132,7 @@ will be created, and =back -=item B [B<--db>] I I +=item B [B<--lookup-db>] I I A symlink I -> I<../DIRECTORS/director/oldfile> is expected to exist. @@ -150,14 +153,14 @@ will be created, and =back -If the B<--db> flag is set, the new I will be found on the -database instead of by parsing the path of the old target. +If the B<--lookup-db> flag is set, the new I will be found on the +database instead of by parsing the path of the old target. =item B I I[I] A symlink I -> I<../DIRECTORS/olddirector/oldfile> is -expected to exist. +expected to exist. If I=I (or if I=I and I was not given), an error will be raised. @@ -178,7 +181,7 @@ will be created, and =back -=item B B<--db> I [I[I]] +=item B B<--lookup-db> I [I[I]] Where I is neither of I nor I, and I is a regular file. @@ -199,7 +202,7 @@ was not given) will be created, and =back -Note that the B<--db> flag has to be set for this to work; if not, an error +Note that the B<--lookup-db> flag has to be set for this to work; if not, an error will be raised. @@ -225,27 +228,37 @@ argument was not given) will be created, =back +The actions above will be performed in the given order. If some action +fails, B will try to revert the successful ones (in reverse +order). =head1 OPTIONS =over 8 -=item B<--db> +=item B<--lookup-db> -If the second argument is in I and this flag is set, B +If the second argument is in I and this flag is set, B will search the I in the data base. An error will be raied if no entry is (or multiple entries are) found. Look above for details. +=item B<--ignore-db> + +Do not connect to the database, (thus do not update it with the new +filename). This flag is incompatible with B<--lookup-db>. + =item B<-q>, B<--quiet> By default, B prints each action it performs, with their -return status. This flag supresses this behavior. +return status. This flag supresses this behavior. Use at your own risk. =back =head1 EXIT STATUS -The exit status is 0 if all the actions went through, and 1 otherwise. +The exit status is 0 if all the actions went through, 1 if some error +happened, and 2 if some action fails and the successful ones have been +smoothly reverted. =head1 REQUIREMENTS @@ -261,16 +274,17 @@ Copyright 2011 Guilhem Moulin. See the source for copying conditions. #TODO: overwrite existing files? -#TODO: revert in case of error #TODO: explore depth>1 in DIRECTORS/ -my $db_flag; +my $lookupdb_flag; +my $ignoredb_flag; # Get options -GetOptions( "db" => \$db_flag, - "q|quiet" => sub { open LOG, '>', '/dev/null' - or die "Cannot open `/dev/null': $!" }, - "man" => sub { pod2usage(-exitstatus => 0, -verbose => 2) } +GetOptions( "lookup-db"=> \$lookupdb_flag, + "ignore-db"=> \$ignoredb_flag, + "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); @@ -279,12 +293,15 @@ pod2usage(2) if ($#ARGV < 0 or $#ARGV > 1); my ($old_path,$new_path) = @ARGV; $new_path = $symlinks unless defined $new_path; -die "Error: `" .$old_path. "' does not exist\n" +die "Error: incompatible options.\n" if + (defined $lookupdb_flag) and (defined $ignoredb_flag); + +die "Error: `" .$old_path. "' does not exist.\n" unless (-l $old_path or -f $old_path); $new_path = catfile ($new_path, basename($old_path)) if -d realpath($new_path); -die "Error: `" .$new_path. "' exists\n" +die "Error: `" .$new_path. "' exists.\n" if (-l $new_path or -f $new_path); my $old_filename = basename($old_path); @@ -301,25 +318,28 @@ my @real_directors = splitdir($real_directors); # Connect to database -my $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port"; -my $dbh = DBI->connect($dsn, $user, $password) - or die "Can't connect do database"; -$dbh->do( "set names utf8" ) or die; - - -# Lookup for the file in the videodb database -my $RES = - $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata - WHERE filename = ?", - 'id', undef, $old_filename - ) +my ($dsn, $dbh, $RES, $nRES, $id); +unless (defined $ignoredb_flag) { + $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port"; + $dbh = DBI->connect($dsn, $user, $password) + or die "Can't connect do database"; + $dbh->do( "set names utf8" ) or die; + + + # Lookup for the file in the videodb database + $RES = + $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata + WHERE filename = ?", + 'id', undef, $old_filename + ) or die "Can't select: " .$dbh->errstr. "\n"; -my $nRES = scalar (keys %$RES); + $nRES = scalar (keys %$RES); -# The ID of the first movie found in the database, if any -my $id = each %$RES; + # The ID of the first movie found in the database, if any + $id = each %$RES; +} -my $r; +my $r = 0; my ($old_director, $new_director); my ($old_symlink, $new_symlink, $new_target, $old_target); @@ -327,20 +347,20 @@ if (&is_symlink($real_new_path)) { # The destination is under $symlinks - if (defined $db_flag) { + if (defined $lookupdb_flag) { # Find the new director on the database # Ensure there is exactly one entry in the db - die "Error: No entry found in the database while the flag `--db' was set.\n" + die "Error: No entry found in the database while the flag `--lookup-db' was set.\n" if $nRES == 0; - die "Error: Multiples entries found in the database while the flag `--db' was set.\n" + die "Error: Multiples entries found in the database while the flag `--lookup-db' was set.\n" if $nRES > 1; $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) { @@ -398,7 +418,7 @@ if (&is_symlink($real_new_path)) { $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 `--db' flag.\n" + die "Error: Dunno where to put this file. Try the `--lookup-db' flag.\n" unless defined $new_director; $new_target = catfile ($directors, $new_director, $new_filename); @@ -448,33 +468,39 @@ else { } +my @actions; # Successful actions 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); - } + &perform ("Renaming target... ", rename $old_target, $new_target) + unless ($old_filename eq $new_filename); } else { - print LOG "Moving target... "; - &ack (\$r, move $old_target, $new_target); + &perform ("Moving target... ", move $old_target, $new_target); } + +my $old_tar; if (defined $old_symlink) { - print LOG "Deleting old symlink... "; - &ack (\$r, unlink $old_symlink); + $old_tar = readlink $old_symlink; + &perform ("Deleting old symlink... ", 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) { +&perform ("Creating new symlink... ", + symlink catfile(updir(),'DIRECTORS',$new_director,$new_filename), + $new_symlink); + + +unless (defined $ignoredb_flag || $old_filename eq $new_filename) { print LOG "Updating database... "; if ($nRES == 0) { + $r = 2; print LOG "failed!: no entry found.\n"; + &revert(@actions); } elsif ($nRES > 1) { + $r = 2; print LOG "failed!: multiple entries found.\n"; + &revert(@actions); } else { my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?", @@ -484,10 +510,12 @@ unless ($old_filename eq $new_filename) { } } + # Disconnect -$dbh->disconnect(); +$dbh->disconnect() unless defined $ignoredb_flag; + +exit $r; -return $r; ################################################################################ @@ -499,12 +527,68 @@ sub ack { my ($r, $test) = @_; if ($test) { print LOG "OK\n"; + return 0; } else { print LOG "failed!: $!\n"; - $$r = 1; + $$r = 2 if defined $r; + return 1; + } +} + +# Perform the given action; revert successful changes in case of failing +sub perform { + return if $r; + + my ($action,$test) = @_; + + print LOG $action; + if (&ack (\$r, $test)) { + &revert(@actions); + } + else { + push @actions, $action; } } +# Revert successful changes +sub revert { + my @actions = reverse @_; + + print LOG "\n"; + print STDERR "Failed!: reverting successful changes...\n"; + + while ($#actions >= 0) { + my $rev; + if ($actions[0] =~ /^Renaming target/) { + $rev = rename $new_target, $old_target; + } + elsif ($actions[0] =~ /^Moving target/) { + $rev = move $new_target, $old_target; + } + elsif ($actions[0] =~ /^Moving target/) { + $rev = move $new_target, $old_target; + } + elsif ($actions[0] =~ /^Deleting( old symlink.*)/) { + $actions[0] = 'Creating'. $1; + $rev = symlink $old_tar, $old_symlink; + } + elsif ($actions[0] =~ /^Creating( new symlink.*)/) { + $actions[0] = 'Deleting'. $1; + $rev = unlink $new_symlink; + } + else { + print STDERR "Error: unknown action `" .$actions[0]. "'!\n"; + $actions[0] = undef; + $r = 1; + } + + if (defined $actions[0]) { + print LOG $actions[0]; + &ack (\$r, $rev); + } + shift @actions; + } +} # Check wether a path starts with $movies sub is_symlink { @@ -515,7 +599,7 @@ sub is_symlink { shift @real_symlinks; shift @path; }; - + if ($#real_symlinks<0 && $#path==0) { return 1; # That's a "symlink" } else { @@ -533,7 +617,7 @@ sub is_director { shift @real_directors; shift @path; }; - + if ($#real_directors<0 && $#path>=0) { ${$_[0]} = $path[0] if defined $_[0]; return 1; # That's a "director" -- cgit v1.2.3 From 0b6c492c04694247edc09e7838247d05d730fe5e Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 14:54:38 +0200 Subject: dirs --- videomv.pl | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/videomv.pl b/videomv.pl index bce7064..45ad208 100755 --- a/videomv.pl +++ b/videomv.pl @@ -24,11 +24,8 @@ use strict; # Configuration -my $symlinks = catdir('/','tmp','video','MOVIES'); # Symlinks folder -my $directors = catdir('', 'tmp','video','DIRECTORS'); # Directors folder - -#my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder -#my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder +my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder +my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder my $driver = "mysql"; my $database = "videodb"; @@ -554,6 +551,8 @@ sub perform { sub revert { my @actions = reverse @_; + return if $#actions < 0; + print LOG "\n"; print STDERR "Failed!: reverting successful changes...\n"; -- cgit v1.2.3 From f7b925955aab3802ee3918a7cc592cdd1e0c6682 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 16:20:53 +0200 Subject: crap --- videomv.pl | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/videomv.pl b/videomv.pl index 45ad208..5f40811 100755 --- a/videomv.pl +++ b/videomv.pl @@ -23,10 +23,12 @@ use strict; ################################################################################ # Configuration - my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder +$symlinks = catdir('','tmp','video','MOVIES'); # Symlinks folder +$directors = catdir('','tmp','video','DIRECTORS'); # Directors folder + my $driver = "mysql"; my $database = "videodb"; my $hostname = "127.0.0.1"; @@ -293,7 +295,7 @@ $new_path = $symlinks unless defined $new_path; die "Error: incompatible options.\n" if (defined $lookupdb_flag) and (defined $ignoredb_flag); -die "Error: `" .$old_path. "' does not exist.\n" +die "Error: `" .$old_path. "' is neither a symlink nor a plain file.\n" unless (-l $old_path or -f $old_path); $new_path = catfile ($new_path, basename($old_path)) @@ -558,13 +560,12 @@ sub revert { while ($#actions >= 0) { my $rev; - if ($actions[0] =~ /^Renaming target/) { + if ($actions[0] =~ /^(Renaming target)(\.{3}) {5}( *)/) { + $actions[0] = $1 .' back'. $2.$3; $rev = rename $new_target, $old_target; } - elsif ($actions[0] =~ /^Moving target/) { - $rev = move $new_target, $old_target; - } - elsif ($actions[0] =~ /^Moving target/) { + elsif ($actions[0] =~ /^(Moving target)(\.{3}) {5}( *)/) { + $actions[0] = $1 .' back'. $2.$3; $rev = move $new_target, $old_target; } elsif ($actions[0] =~ /^Deleting( old symlink.*)/) { -- cgit v1.2.3 From d8e2daec70222199767b19b2d37a91657aa46cfc Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 10 Aug 2011 16:21:30 +0200 Subject: -tmp --- videomv.pl | 3 --- 1 file changed, 3 deletions(-) diff --git a/videomv.pl b/videomv.pl index 5f40811..02ebedb 100755 --- a/videomv.pl +++ b/videomv.pl @@ -26,9 +26,6 @@ use strict; my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder -$symlinks = catdir('','tmp','video','MOVIES'); # Symlinks folder -$directors = catdir('','tmp','video','DIRECTORS'); # Directors folder - my $driver = "mysql"; my $database = "videodb"; my $hostname = "127.0.0.1"; -- cgit v1.2.3 From b31a12dfa02dc30ead4850f0222688de5ac3c1ff Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 17 Dec 2011 21:27:42 +0100 Subject: videodb.rc --- videodb.rc | 13 +++++++++++++ videomv.pl | 30 +++++++++++++++++------------- 2 files changed, 30 insertions(+), 13 deletions(-) create mode 100644 videodb.rc diff --git a/videodb.rc b/videodb.rc new file mode 100644 index 0000000..dad2f22 --- /dev/null +++ b/videodb.rc @@ -0,0 +1,13 @@ +######################################################################### +# This is a sample configuration file for video-*. Extend it and rename # +# it to `~/.videodb.rc' # +######################################################################### + +videodir => catdir($HOME,'video'), +driver => 'mysql', +database => 'videodb', +hostname => '127.0.0.1', +user => 'username', +port => 3306, +password => '******', +videodata => "videodb_videodata", diff --git a/videomv.pl b/videomv.pl index 02ebedb..1d192c8 100755 --- a/videomv.pl +++ b/videomv.pl @@ -23,16 +23,20 @@ use strict; ################################################################################ # Configuration -my $symlinks = catdir($HOME,'video','MOVIES'); # Symlinks folder -my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder +my $confile = catfile ($HOME, '.videodb.rc'); +die "Can't read `" .$confile. "'\n" unless -f $confile; +my %config = do $confile; +die "Error in `" .$confile. "'\n" if $@ || not %config; + +map { exists $config{$_} || die "Error: Missing `${_}'.\n" } + qw /videodir driver database hostname user port password videodata/; + +my $symlinks = catdir($config{videodir},'MOVIES'); # Symlinks folder +die "Error: No such directory: `" .$symlinks. "'.\n" unless -d $symlinks; + +my $directors = catdir($config{videodir},'DIRECTORS'); # Directors folder +die "Error: No such directory: `" .$directors. "'.\n" unless -d $symlinks; -my $driver = "mysql"; -my $database = "videodb"; -my $hostname = "127.0.0.1"; -my $user = "videodb"; -my $port = 3306; -my $password = "videodb"; -my $videodata = "videodb_videodata"; ################################################################################ @@ -316,15 +320,15 @@ my @real_directors = splitdir($real_directors); # Connect to database my ($dsn, $dbh, $RES, $nRES, $id); unless (defined $ignoredb_flag) { - $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port"; - $dbh = DBI->connect($dsn, $user, $password) + $dsn = "DBI:$config{driver}:database=$config{database};host=$config{hostname};port=$config{port}"; + $dbh = DBI->connect($dsn, $config{user}, $config{password}) or die "Can't connect do database"; $dbh->do( "set names utf8" ) or die; # Lookup for the file in the videodb database $RES = - $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata + $dbh->selectall_hashref ( "SELECT id,director,title FROM $config{videodata} WHERE filename = ?", 'id', undef, $old_filename ) @@ -499,7 +503,7 @@ unless (defined $ignoredb_flag || $old_filename eq $new_filename) { &revert(@actions); } else { - my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?", + my $rv = $dbh->do ( "UPDATE $config{videodata} SET filename = ? WHERE id = ?", undef, $new_filename, $id ); &ack (\$r, $rv); -- cgit v1.2.3 From 0be67fcf95573bf3966dad63fdc7b3e85a560f42 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 6 Jan 2012 19:53:23 +0100 Subject: man --- videodb.rc | 8 +++--- videomv.pl | 90 +++++++++++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 70 insertions(+), 28 deletions(-) diff --git a/videodb.rc b/videodb.rc index dad2f22..198b60a 100644 --- a/videodb.rc +++ b/videodb.rc @@ -1,7 +1,7 @@ -######################################################################### -# This is a sample configuration file for video-*. Extend it and rename # -# it to `~/.videodb.rc' # -######################################################################### +######################################################################## +# This is a sample configuration file for video*. Extend it and rename # +# it to `~/.videodb.rc' # +######################################################################## videodir => catdir($HOME,'video'), driver => 'mysql', diff --git a/videomv.pl b/videomv.pl index 1d192c8..d579f9a 100755 --- a/videomv.pl +++ b/videomv.pl @@ -42,7 +42,7 @@ die "Error: No such directory: `" .$directors. "'.\n" unless -d $symlinks; =head1 NAME -videomv.pl - Move your videos to or within your collection. +videomv.pl - move your videos to or within your collection =head1 SYNOPSIS @@ -52,7 +52,7 @@ I [{I,I}I[I]] =head1 DESCRIPTION Your collection is assumed to have the following structure: two -folders, here I and I that have the same parent. +folders, I and I, that have the same parent. I contains one subdirectory for each director, and each movie lies (B) in the subdirectory of its director. The folder I contains symlinks - one for each movie - that target @@ -91,15 +91,22 @@ actions will be performed: =over 4 +=item * -=item * The old target will be renamed to I, +The old target will be renamed to I, -=item * the old symlink will be deleted, +=item * -=item * a new symlink I -> I<../DIRECTORS/director/newfile> +The old symlink will be deleted, + +=item * + +A new symlink I -> I<../DIRECTORS/director/newfile> will be created, and -=item * the filename in the database will be updated. +=item * + +The filename in the database will be updated. =back @@ -118,16 +125,24 @@ Otherwise, the following actions will be performed: =over 4 -=item * The old target will be moved to I, +=item * + +The old target will be moved to I, (or to I if I was not given), -=item * the old symlink will be deleted, +=item * + +The old symlink will be deleted, -=item * a new symlink I -> I<../DIRECTORS/newdirector/newfile> +=item * + +A new symlink I -> I<../DIRECTORS/newdirector/newfile> (or -> I<../DIRECTORS/newdirector/oldfile> if I was not given) will be created, and -=item * the filename in the database will be updated unless I=I. +=item * + +The filename in the database will be updated unless I=I. =back @@ -141,15 +156,23 @@ actions will be performed: =over 4 -=item * The old target I will be renamed to +=item * + +The old target I will be renamed to I, -=item * the old symlink will be deleted, +=item * + +The old symlink will be deleted, + +=item * -=item * a new symlink I -> I<../DIRECTORS/director/newfile> +A new symlink I -> I<../DIRECTORS/director/newfile> will be created, and -=item * the filename in the database will be updated. +=item * + +The filename in the database will be updated. =back @@ -168,15 +191,23 @@ Otherwise, the following actions will be performed: =over 4 -=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, +=item * + +The old symlink will be deleted, -=item * a new symlink I -> I<../DIRECTORS/newdirector/newfile> +=item * + +A new symlink I -> I<../DIRECTORS/newdirector/newfile> will be created, and -=item * the filename in the database will be updated unless I=I. +=item * + +The filename in the database will be updated unless I=I. =back @@ -191,14 +222,20 @@ In case of success, the following actions will be performed: =over 4 -=item * I will be moved to I +=item * + +I will be moved to I (or to I if I was not given), -=item * a symlink I -> I<../DIRECTORS/director/newfile> +=item * + +A symlink I -> I<../DIRECTORS/director/newfile> (or I -> I<../DIRECTORS/director/oldfile> if I was not given) will be created, and -=item * the filename in the database will be updated unless I=I. +=item * + +The filename in the database will be updated unless I=I. =back @@ -214,15 +251,20 @@ The following actions will be performed: =over 4 -=item * I will be moved to I +=item * + +I will be moved to I (or to I if I was not given), -=item * a symlink I -> I<../DIRECTORS/director/newfile> +=item * + +A symlink I -> I<../DIRECTORS/director/newfile> (or I -> I<../DIRECTORS/director/oldfile> if the second argument was not given) will be created, -=item * the filename in the database will be updated unless I=I. +=item * +The filename in the database will be updated unless I=I. =back -- cgit v1.2.3 From f31af5c89c25176897428bcfde17bc1e1fb72784 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 6 Jan 2012 20:12:56 +0100 Subject: disclaimer --- videomv.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/videomv.pl b/videomv.pl index d579f9a..2828853 100755 --- a/videomv.pl +++ b/videomv.pl @@ -49,7 +49,7 @@ videomv.pl - move your videos to or within your collection B [B<--lookup-db>] [B<--ignore-db>] [B<-q>] I [{I,I}I[I]] -=head1 DESCRIPTION +=head1 DISCLAIMER Your collection is assumed to have the following structure: two folders, I and I, that have the same parent. @@ -72,6 +72,7 @@ not verify these conventions! |- movie12 -> ../DIRECTORS/director1/movie2 `- ... +=head1 DESCRIPTION Depending on whether I is I, I, or something -- cgit v1.2.3 From 209934e01e21ffbe5d7e25c7d72ceb221916ecc5 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 6 Jan 2012 20:27:37 +0100 Subject: configuration --- videomv.pl | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/videomv.pl b/videomv.pl index 2828853..a21bc33 100755 --- a/videomv.pl +++ b/videomv.pl @@ -297,6 +297,21 @@ return status. This flag supresses this behavior. Use at your own risk. =back +=head1 CONFIGURATION + +B reads its database configuration from the file +I<$HOME/.videodb.rc>. This file has to be the content of a Perl hash +e.g., + + videodir => catdir($HOME,'video'), + driver => 'mysql', + database => 'videodb', + hostname => '127.0.0.1', + user => 'username', + port => 3306, + password => '******', + videodata => "videodb_videodata", + =head1 EXIT STATUS The exit status is 0 if all the actions went through, 1 if some error -- cgit v1.2.3 From 869a38ba87e998889b27248f1595746c0e714170 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 10 Jan 2012 20:51:24 +0100 Subject: support for multi-directors --- videomv.pl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/videomv.pl b/videomv.pl index a21bc33..9ba34c5 100755 --- a/videomv.pl +++ b/videomv.pl @@ -419,6 +419,13 @@ if (&is_symlink($real_new_path)) { $new_director =~ tr@/@_@; $new_director =~ s/[[:cntrl:]]//; + my @new_directors = split / *, */, $new_director; + die "Can't find a suitable director.\n" unless @new_directors; + my $lastdir = pop @new_directors; + $new_director = join ", ", @new_directors; + $new_director .= " & " if @new_directors; + $new_director .= $lastdir; + # Create directory if it doesn't exist my $new_dirname = catfile ($directors, $new_director); unless (-d $new_dirname) { -- cgit v1.2.3 From db842af5629fce914a087df1ba536a63d4eaf87e Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Wed, 11 Jan 2012 14:47:36 +0100 Subject: reverting support for multi-directors --- videomv.pl | 7 ------- 1 file changed, 7 deletions(-) diff --git a/videomv.pl b/videomv.pl index 9ba34c5..a21bc33 100755 --- a/videomv.pl +++ b/videomv.pl @@ -419,13 +419,6 @@ if (&is_symlink($real_new_path)) { $new_director =~ tr@/@_@; $new_director =~ s/[[:cntrl:]]//; - my @new_directors = split / *, */, $new_director; - die "Can't find a suitable director.\n" unless @new_directors; - my $lastdir = pop @new_directors; - $new_director = join ", ", @new_directors; - $new_director .= " & " if @new_directors; - $new_director .= $lastdir; - # Create directory if it doesn't exist my $new_dirname = catfile ($directors, $new_director); unless (-d $new_dirname) { -- cgit v1.2.3