videorm

1 files changed, 206 insertions, 0 deletions

diff --git a/videorm.pl b/videorm.pl
new file mode 100755
index 0000000..f94a52e
--- /dev/null
+++ b/videorm.pl
@@ -0,0 +1,206 @@
+#! /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.
+
+
+$VERSION = "0.1, 09 January 2012";
+
+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;
+
+################################################################################
+
+# Configuration
+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;
+
+
+################################################################################
+
+=head1 NAME
+
+videorm.pl - remove movies from your collection without altering its sanity
+
+=head1 SYNOPSIS
+
+B<videorm.pl> [B<-q>] [B<-f>] I<path/to/file>
+
+=head1 DISCLAIMER
+
+Your collection is assumed to have the following structure: two
+folders, I<DIRECTORS> and I<MOVIES>, that have the same parent.
+I<DIRECTORS> contains one subdirectory for each director, and each movie
+lies (B<as a regular file>) in the subdirectory of its director.
+The folder I<MOVIES> contains symlinks - one for each movie - that target
+to I<../DIRECTORS/director_of_the_movie/movie>.
+The behavior of B<videomv.pl> is NOT specified if your collection does
+not verify these conventions!
+
+  |- ...
+  |- DIRECTORS
+  |    |- director1
+  |    |-   |- movie11
+  |    |    `- movie12
+  |    |- director2/
+  |    `- ...
+  `- MOVIES
+       |- movie11 -> ../DIRECTORS/director1/movie1
+       |- movie12 -> ../DIRECTORS/director1/movie2
+       `- ...
+
+=head1 DESCRIPTION
+
+B<videorm> provides a way to safely remove movies from your collection.
+More precisely, if I<file> is the basename of its argument, B<videorm>
+will remove the symlink I<MOVIES/file>, its target
+I<DIRECTORS/director/file>, and the corresponding entry in the database.
+
+If your collection is not detected as being sane that is, if there is no
+symlink I<MOVIES/file>, or if its target I<../DIRECTORS/director/file> is
+not a regular file, or if there is not exactly one entry in the database,
+B<videorm> will stop. See the flag B<--force> to go through anyway.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-f>, B<--force>
+
+Force the removal even if the collection is not detected as being sane.
+Use at your own risk.
+
+=item B<-q>, B<--quiet>
+
+By default, B<videomv.pl> prints every action it performs, with the
+return status. This flag supresses this behavior. Use at your own risk.
+
+=back
+
+=head1 CONFIGURATION
+
+B<videodb-check> 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 the file, the symlink and the corresponding
+entry in the database have all been deleted.
+The exit status is 1 otherwise.
+
+=head1 REQUIREMENTS
+
+The imported modules are available on CPAN. See the source for details.
+
+=head1 AUTHOR
+
+Copyright 2011 Guilhem Moulin. See the source for copying conditions.
+
+=cut
+
+################################################################################
+
+
+#TODO: explore depth>1 in DIRECTORS/
+
+my $force;
+
+# Get options
+GetOptions( "f|force" => \$force,
+            "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);
+*LOG = *STDERR  unless  defined (fileno LOG);
+
+my $file = basename ($ARGV[0]);
+
+my $file_s = catfile ($symlinks, $file);
+my $file_d;
+$file_d = catfile ($symlinks, readlink $file_s) if -l $file_s;
+
+
+# Connect to database
+my $dsn = "DBI:$config{driver}:database=$config{database};host=$config{hostname};port=$config{port}";
+my $dbh = DBI->connect($dsn, $config{user}, $config{password})
+            or die "Can't connect do database.\n";
+$dbh->do( "set names utf8" ) or die;
+
+
+# Lookup for the file in the videodb database
+my $res = $dbh->selectall_arrayref ( "SELECT id FROM $config{videodata} WHERE filename = ?",
+                                     undef, $file )
+    or die "Can't select: " .$dbh->errstr. "\n";
+
+die "Error: Your collection is not sane! (and `--force' is not set).\n"
+    unless ( (-l $file_s and (defined ($file_d) and -f $file_d) and $#$res == 0)
+             or (defined $force) );
+
+
+my $r = 0;
+
+&ack ( "Updating database... ",
+       $dbh->do ( "DELETE FROM $config{videodata} WHERE filename = ?", undef, $file ) > 0);
+
+&ack ( "Deleting symlink...  ",
+       -l $file_s && unlink $file_s );
+
+# TODO: if $ARGV[0] is in DIRECTORS, then --force could suppress it even
+# if the database is not sane.
+&ack ( "Deleting target...   ",
+       (defined $file_d) && -f $file_d && unlink $file_d );
+
+$dbh->disconnect();
+
+exit $r;
+
+
+
+################################################################################
+
+
+
+# Acknowledge the result of a test
+sub ack {
+    print LOG $_[0];
+    if ($_[1]) {
+        print LOG "OK\n";
+    } else {
+        print LOG "failed!\n";
+        $r = 1;
+    }
+}