diff options
| -rwxr-xr-x | videodb-check.pl | 257 | ||||
| -rw-r--r-- | videodb.rc | 3 |
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]); +} @@ -11,6 +11,9 @@ user => 'username', port => 3306, password => '******', videodata => "videodb_videodata", +<<<<<<< HEAD +======= imdb => 'akas.imdb.com', url => 'https://videodb.example.org' +>>>>>>> origin/videoadd |