#!/usr/bin/perl -CAL

# 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 warnings;
use strict;

use DBI;
use Pod::Usage;
use File::Spec::Functions;
use Cwd;
use Env qw /HOME/;

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

# 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 password/;
$config{prefix} = "" unless exists $config{prefix};

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

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.

=item *

No movie in the database has invalid release date, empty title or empty
language.

=back

=head1 CONFIGURATION

B<videodb-check> 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  => 'example.org',
  user      => 'username',
  port      => 3306,
  password  => '******',
  prefix    => "videodb_",

=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}";
$dsn .= ";port=$config{port}" if defined $config{port};
if (defined $config{dbi_misc}) {
    while (my ($k,$v) = each %{$config{dbi_misc}}) {
        $dsn .= ";$k=$v";
    }
}
my $dbh = DBI->connect($dsn, $config{user}, $config{password})
           or die "Can't connect do database\n";
$dbh->do( "SET NAMES UTF8" ) or die "Error: Can't set names to UTF-8.\n";

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

# 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{prefix}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{prefix}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{prefix}videodata
                                         WHERE " .$_[1] )
        or die "Can't select: " .$dbh->errstr. "\n";
    &report ("The following files have " .$_[0], [map {$_->[0]} @$bad]);
}