summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xvideodb-check.pl257
-rw-r--r--videodb.rc3
2 files changed, 260 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]);
+}
diff --git a/videodb.rc b/videodb.rc
index 6928736..7babf8f 100644
--- a/videodb.rc
+++ b/videodb.rc
@@ -11,6 +11,9 @@ user => 'username',
port => 3306,
password => '******',
videodata => "videodb_videodata",
+<<<<<<< HEAD
+=======
imdb => 'akas.imdb.com',
url => 'https://videodb.example.org'
+>>>>>>> origin/videoadd