#!/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 database

=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 *

Each symlink in the directory I<MOVIES> of your collection has exactly
one corresponding entry in the database.

=back

=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 Guilhem Moulin. See the source for copying conditions.

=cut

################################################################################

if (@ARGV) {
    pod2usage(-exitstatus => 0, -verbose => 2) if $ARGV[0] eq '--man';
    pod2usage(2);
}

################################################################################

# 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 $res = $dbh->selectall_arrayref ( "SELECT filename FROM $config{videodata}" )
    or die "Can't select: " .$dbh->errstr. "\n";

my @links;
my @files;
foreach (@$res) {
    my $l = File::Spec->catfile ($symlinks, $_->[0]);
    unless (-l $l or -f $l) {
        push @links, $_->[0];
    }

    if (-l $l and not -f File::Spec->catfile ($symlinks, readlink $l)) {
        push @files, $_->[0];
    }

}

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";
    }
    $r = 1;
}

if (@files) {
    print STDERR "* The following entries don't have a valid target:\n";
    foreach (@files) {
        print STDERR "    ", $_, "\n";
    }
    $r = 1;
}


################################################################################

# For all symlink, check that it has exactly one entry in the DB

my @filelist;
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;
$dbh->disconnect;


if (@files) {
    print STDERR "* The following files have <> 1 corresponding entries in the DB:\n";
    foreach (@files) {
        print STDERR "    ", $_, "\n";
    }
    $r = 1;
}


################################################################################

exit $r;