#!/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 =head1 DISCLAIMER Your collection is assumed to have the following structure: two 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 to I<../DIRECTORS/director_of_the_movie/movie>. The behavior of B 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 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 of your collection, that in turn has a valid target in the directory I. =item * The directory in I coincides with the director(s) found in the database. =item * Each symlink in the directory I 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 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]); }