summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@ens-lyon.org>2012-01-10 23:38:24 +0100
committerGuilhem Moulin <guilhem.moulin@ens-lyon.org>2012-01-10 23:38:24 +0100
commit275793513284bde0ff98c04a168d0f6bc038b4b8 (patch)
tree727179578f2483a5f382b091164534721221a0cc
parentdd751c7c27144b99ca0811a2ef5e1294db3e992d (diff)
director check
-rwxr-xr-xvideodb-check.pl88
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;
+ }
+}