diff options
| -rwxr-xr-x | videodb-check.pl | 88 |
1 files changed, 55 insertions, 33 deletions
diff --git a/videodb-check.pl b/videodb-check.pl index 674696a..4755886 100755 --- a/videodb-check.pl +++ b/videodb-check.pl @@ -77,6 +77,11 @@ 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. @@ -108,7 +113,7 @@ The imported modules are available on CPAN. See the source for details. =head1 AUTHOR -Copyright 2011 Guilhem Moulin. See the source for copying conditions. +Copyright 2011-2012 Guilhem Moulin. See the source for copying conditions. =cut @@ -132,46 +137,53 @@ $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 $res = $dbh->selectall_arrayref ( "SELECT filename FROM $config{videodata}" ) +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; -my @files; + +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 $l = File::Spec->catfile ($symlinks, $_->[0]); - unless (-l $l or -f $l) { + my @ls = File::Spec->splitdir($_->[0]); + my $l = File::Spec->catfile ($symlinks, $ls[0]); + + unless (-l $l) { push @links, $_->[0]; + next; } - if (-l $l and not -f File::Spec->catfile ($symlinks, readlink $l)) { - push @files, $_->[0]; + 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]) ); + + my @directors = split / *, */, $_->[1]; + if (@directors) { + my $lastdir = pop @directors; + my $directors = join ", ", @directors; + $directors .= " & " if @directors; + $directors .= $lastdir; + push @dirs, $_->[0]. " (" .$target[2]. " <> " .$_->[1]. ")" unless $target[2] eq $directors; } - -} - -my $r = 0; -if (@links) { - print STDERR "* The following entries are in the DB, but I can't file the files:\n"; - foreach (@links) { - print STDERR " ", $_, "\n"; + else { + push @dirs, $_->[0]. " (no director)" ; } - $r = 1; } -if (@files) { - print STDERR "* The following entries don't have a valid target:\n"; - foreach (@files) { - print STDERR " ", $_, "\n"; - } - $r = 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); ################################################################################ -# For all symlink, check that it has exactly one entry in the DB +# Check that each symlink has exactly one entry in the DB -my @filelist; +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(); @@ -209,15 +221,25 @@ $sth->finish; $dbh->disconnect; -if (@files) { - print STDERR "* The following files have <> 1 corresponding entries in the DB:\n"; - foreach (@files) { - print STDERR " ", $_, "\n"; - } - $r = 1; -} +&report ("The following files have <> 1 corresponding entries in the DB", \@files); ################################################################################ + exit $r; + + +################################################################################ + + +sub report { + my ($str, $bad) = @_; + if (@$bad) { + print STDERR "* " .$str. ":\n"; + foreach (@$bad) { + print STDERR " ", $_, "\n"; + } + $r = 1; + } +} |