1 files changed, 257 insertions, 0 deletions
diff --git a/videodb-check.pl b/videodb-check.pl
new file mode 100755
index 0000000..8acff46
--- /dev/null
+++ b/videodb-check.pl
@@ -0,0 +1,257 @@
+#!/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, 27 November 2011";
+
+use DBI;
+use Pod::Usage;
+use File::Spec::Functions;
+use Cwd;
+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;
+
+################################################################################
+
+=head1 NAME
+
+videodb-check.pl - a sanity check for your video collection
+
+=head1 SYNOPSIS
+
+B<videodb-check.pl>
+
+=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<videodb-check.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<videodb-check> performs the following sanity checks on your database
+and collection:
+
+=over 4
+
+=item *
+
+Each entry in the database has a corresponding symlink under the
+directory I<MOVIES> of your collection, that in turn has a valid target
+in the directory I<DIRECTORS>.
+
+=item *
+
+The directory in I<DIRECTORS> coincides with the director(s) found in
+the database.
+
+=item *
+
+Each symlink in the directory I<MOVIES> of your collection has exactly
+one corresponding entry in the database.
+
+=item *
+
+No movie in the database has invalid release date, empty title or empty
+language.
+
+=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 your collection and database are sane, and 1
+otherwise.
+
+=head1 REQUIREMENTS
+
+The imported modules are available on CPAN. See the source for details.
+
+=head1 AUTHOR
+
+Copyright 2011-2012 Guilhem Moulin. See the source for copying conditions.
+
+=cut
+
+################################################################################
+
+if (@ARGV) {
+    pod2usage(-exitstatus => 0, -verbose => 2) if $ARGV[0] eq '--man';
+    pod2usage(2);
+}
+*LOG = *STDOUT;
+
+################################################################################
+
+# 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;
+
+################################################################################
+
+# Check that all entries in the DB have a symlink, that in turn have a
+# valid target
+
+my $r = 0;  # Exit status
+my $res = $dbh->selectall_arrayref ( "SELECT filename,director FROM $config{videodata}" )
+    or die "Can't select: " .$dbh->errstr. "\n";
+
+
+my @links;  # List of missing symlinks
+my @files;  # List of symlinks that have a non existing/valid target
+my @dirs;   # List of symlinks that target to a wrong director
+foreach (@$res) {
+    my @ls = File::Spec->splitdir($_->[0]);
+    my $l = File::Spec->catfile ($symlinks, $ls[0]);
+
+    unless (-l $l) {
+        push @links, $_->[0];
+        next;
+    }
+
+    my @target = File::Spec->splitdir (readlink $l);
+    push @files, $_->[0]
+        unless ( $target[0] eq File::Spec->updir()
+             and $target[1] eq "DIRECTORS"
+             and -f File::Spec->catfile ($symlinks, $_->[0]) );
+
+    if ( not (defined $_->[1]) or $_->[1] eq '' ) {
+        push @dirs, $_->[0]. " (no director)";
+    }
+    elsif ( $target[2] ne $_->[1] ) {
+        push @dirs, $_->[0]. " (" .$target[2]. " <> " .$_->[1]. ")";
+    }
+}
+
+
+&report ("The following entries are in the DB, but I can't find the files", \@links);
+&report ("The following entries don't have a valid target", \@files);
+&report ("The following entries target to a wrong director", \@dirs);
+
+
+################################################################################
+
+# Check that each symlink has exactly one entry in the DB
+
+my @filelist; # List of filenames that have <> 1 entry in the DB
+opendir (DIR, $symlinks) or die "Can't open dir `" .$symlinks. ".:" .$!. "\n";
+while (my $l = readdir(DIR)) {
+    next if $l eq File::Spec->curdir();
+    next if $l eq File::Spec->updir(); 
+
+    my $f = File::Spec->catfile($symlinks, $l);
+    if ( -d Cwd::realpath($f) ) {
+        opendir (SUBDIR, Cwd::realpath($f))
+            or die "Can't open dir `" .Cwd::realpath($f). ".:" .$!. "\n";
+        while (my $d = readdir(SUBDIR)) {
+            next if $d eq File::Spec->curdir();
+            next if $d eq File::Spec->updir(); 
+            push @filelist, File::Spec->catfile($l,$d);
+        }
+        closedir(SUBDIR) or die "Can't close: $!\n";
+    }
+    elsif ( -l $f or -f $f ) {
+        push @filelist, $l;
+    }
+}
+closedir(DIR) or die "Can't close: $!\n";
+
+
+undef @files;
+my $sth = $dbh->prepare ( "SELECT id FROM $config{videodata} WHERE filename = ?" )
+             or die "Error: " .$dbh->errstr;
+foreach (@filelist) {
+    $sth->execute ($_) or die "Can't select: " .$dbh->errstr. "\n";
+    my @res = $sth->fetchrow_array;
+    die $sth->errstr if $sth->err;
+
+    push @files, $_  unless $#res == 0;
+}
+$sth->finish;
+&report ("The following files have <> 1 corresponding entries in the DB", \@files);
+
+
+&check ( "no release date", "year = 0" );
+&check ( "no language set", "language IS NULL OR language =''" );
+&check ( "no title set", "title IS NULL OR title =''" );
+
+
+################################################################################
+
+
+$dbh->disconnect;
+exit $r;
+
+
+################################################################################
+
+
+sub report {
+    my ($str, $bad) = @_;
+    if (@$bad) {
+        print LOG "* " .$str. ":\n";
+        foreach (@$bad) {
+            print LOG "    ", $_, "\n";
+        }
+        $r = 1;
+    }
+}
+
+sub check {
+    my $bad = $dbh->selectall_arrayref( "SELECT filename
+                                         FROM $config{videodata}
+                                         WHERE " .$_[1] )
+        or die "Can't select: " .$dbh->errstr. "\n";
+    &report ("The following files have " .$_[0], [map {$_->[0]} @$bad]);
+}