director check

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;
+    }
+}