#! /usr/bin/perl -CS -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, 09 January 2012";

use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
                            bundling auto_version auto_help/;
use Pod::Usage;
use DBI;
use File::Basename;
use File::Spec::Functions qw /catfile catdir splitdir updir/;
use File::Copy;
use Cwd qw /realpath/;
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/;
$config{prefix} = "" unless exists $config{prefix};

my $symlinks  = catdir($config{videodir},'MOVIES');    # Symlinks folder
die "Error: No such directory: `" .$symlinks. "'.\n" unless -d $symlinks;

my $directors = catdir($config{videodir},'DIRECTORS'); # Directors folder
die "Error: No such directory: `" .$directors. "'.\n" unless -d $symlinks;


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

=head1 NAME

videorm.pl - remove movies from your collection without altering its sanity

=head1 SYNOPSIS

B<videorm.pl> [B<-q>] [B<-f>] I<path/to/file>

=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<videorm.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<videorm> provides a way to safely remove movies from your collection.
More precisely, if I<file> is the basename of its argument, B<videorm>
will remove the symlink I<MOVIES/file>, its target
I<DIRECTORS/director/file>, and the corresponding entry in the database.

If your collection is not detected as being sane that is, if there is no
symlink I<MOVIES/file>, or if its target I<../DIRECTORS/director/file> is
not a regular file, or if there is not exactly one entry in the database,
B<videorm> will stop. See the flag B<--force> to go through anyway.

=head1 OPTIONS

=over 8

=item B<-f>, B<--force>

Force the removal even if the collection is not detected as being sane.
Use at your own risk.

=item B<-q>, B<--quiet>

By default, B<videorm.pl> prints every action it performs, with the
return status. This flag supresses this behavior. Use at your own risk.

=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  => '127.0.0.1',
  user      => 'username',
  port      => 3306,
  password  => '******',
  prefix    => "videodb_",

=head1 EXIT STATUS

The exit status is 0 if the file, the symlink and the corresponding
entry in the database have all been deleted.
The exit status is 1 otherwise.

=head1 REQUIREMENTS

The imported modules are available on CPAN. See the source for details.

=head1 AUTHOR

Copyright 2012 Guilhem Moulin. See the source for copying conditions.

=cut

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


#TODO: explore depth>1 in DIRECTORS/

my $force;

# Get options
GetOptions( "f|force" => \$force,
            "q|quiet" => sub { open LOG, '>', '/dev/null'
                               or die "Cannot open `/dev/null': $!" },
            "man"     => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
          )
    or  pod2usage(2);
pod2usage(2)  if  ($#ARGV != 0);
*LOG = *STDERR  unless  defined (fileno LOG);

my $file = basename ($ARGV[0]);

my $file_s = catfile ($symlinks, $file);
my $file_d;
$file_d = catfile ($symlinks, readlink $file_s) if -l $file_s;
my $director;
if (-l $file_s) {
    my @director = File::Spec->splitdir(readlink $file_s);
    $director = $director[2] if $#director >= 2;
}


# Connect to database
my $dsn = "DBI:$config{driver}:database=$config{database};host=$config{hostname};port=$config{port}";
if (exists $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;


# Lookup for the file in the videodb database
my $res = $dbh->selectall_arrayref ( "SELECT id FROM $config{prefix}videodata WHERE filename = ?",
                                     undef, $file )
    or die "Can't select: " .$dbh->errstr. "\n";

die "Error: Your collection is not sane! (and `--force' is not set).\n"
    unless ( (-l $file_s and (defined ($file_d) and -f $file_d) and $#$res == 0)
             or (defined $force) );
my $id = $res->[0]->[0];


my $r = 0;

&ack ( "Updating database... ",
       $dbh->do ( "DELETE FROM $config{prefix}videodata WHERE id = ?", undef, $id ) > 0 &&
       $dbh->do ( "DELETE FROM $config{prefix}videogenre WHERE video_id = ?", undef, $id ) > 0 &&
       $dbh->do ( "DELETE FROM $config{prefix}userseen WHERE video_id = ?", undef, $id ) > 0 );

&ack ( "Deleting symlink...  ",
       -l $file_s && unlink $file_s );

# TODO: if $ARGV[0] is in DIRECTORS, then --force could suppress it even
# if the database is not sane.
&ack ( "Deleting target...   ",
       (defined $file_d) && -f $file_d && unlink $file_d );

if (defined $director) {
    opendir my $DIR, catdir($directors, $director) or die "Can't open: $!";
    if (scalar(grep(!/^\.\.?$/, readdir $DIR) == 0)) {
        &ack ( "Removing empty dir...",
               rmdir catdir($directors, $director) );
    }
    closedir $DIR or die "Can't close: $!";
}

$dbh->disconnect();

exit $r;



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



# Acknowledge the result of a test
sub ack {
    print LOG $_[0];
    if ($_[1]) {
        print LOG "OK\n";
    } else {
        print LOG "failed!\n";
        $r = 1;
    }
}