#! /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, 10 August 2011";

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 $symlinks  = catdir($HOME,'video','MOVIES');    # Symlinks folder
my $directors = catdir($HOME,'video','DIRECTORS'); # Directors folder

my $driver    = "mysql";
my $database  = "videodb";
my $hostname  = "127.0.0.1";
my $user      = "videodb";
my $port      = 3306;
my $password  = "videodb";
my $videodata = "videodb_videodata";

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

=head1 NAME

videomv.pl - TODO

=head1 SYNOPSIS

B<videomv.pl> [B<--sort>]
I<path/to/oldfile> [I<.../>{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]

video
  |- ...
  |- DIRECTORS
  |    |- director1/
  |    |- director2/
  |    `- ...
  `- MOVIES/


=head1 DESCRIPTION

Depending on whether I<path/to/> is I<.../MOVIES/>,
I<.../DIRECTORS/director/>, or something
else, one has one of the six behaviors below. For the sake of
readability the paths are absolute here, but relative paths are fine as
well.

=over 4

=item B<videomv.pl> [B<--sort>] I<.../MOVIES/oldfile> I<.../MOVIES/newfile>

I<oldfile> is supposed to be an existing symlink in I<.../MOVIES/>,
which targets to I<../DIRECTORS/director/oldfile>. If
I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
actions will be performed:

=over 4


=item * The old target will be renamed to I<../DIRECTORS/director/newfile>,

=item * the old symlink will be deleted,

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
will be created, and

=item * the filename in the database will be updated.

=back

If the B<--sort> flag is set, the new I<director> will be find on the
database instead of from the old target. 


=item B<videomv.pl> I<.../MOVIES/oldfile> I<.../DIRECTOR/newdirector/>[I<newfile>]

I<oldfile> is supposed to be an existing symlink in I<.../MOVIES/>,
which targets to I<../DIRECTORS/olddirector/oldfile>. If
I<olddirector/oldfile>=I<newdirector/newfile>
(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
an error will be raised.
Otherwise, the following actions will be performed:

=over 4

=item * The old target will be moved to I<../DIRECTORS/newdirector/newfile>,
(or to I<../DIRECTORS/newdirector/oldfile> if I<newfile> was not given),

=item * the old symlink will be deleted,

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
(or -> I<../DIRECTORS/newdirector/oldfile> if I<newfile> was not given)
will be created, and

=item * the filename in the database will be updated if I<oldfile><>I<newfile>.

=back


=item B<videomv.pl> [B<--sort>] I<.../DIRECTORS/director/oldfile> I<.../MOVIES/newfile>

A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> is
supposed to exist.
If I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
actions will be performed:

=over 4

=item * The old target I<../DIRECTORS/director/oldfile> will be renamed to
I<../DIRECTORS/director/newfile>,

=item * the old symlink will be deleted,

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
will be created, and

=item * the filename in the database will be updated.

=back


=item B<videomv.pl> I<.../DIRECTORS/olddirector/oldfile> I<.../DIRECTOR/newdirector/>[I<newfile>]

A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/olddirector/oldfile> is
supposed to exist.  
If I<olddirector/oldfile>=I<newdirector/newfile>
(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
an error will be raised.
Otherwise, the following actions will be performed:

=over 4

=item * The old target I<../DIRECTORS/olddirector/oldfile> will be moved to
I<../DIRECTORS/newdirector/newfile>,

=item * the old symlink will be deleted,

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
will be created, and

=item * the filename in the database will be updated if I<oldfile><>I<newfile>.

=back


=item B<videomv.pl> B<--sort> I<path/to/oldfile> [I<.../MOVIES/newfile>]

Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>,
and I<oldfile> is a regular file.
The director will looked for in the database, and and error will be
raised if no entry is found.
Otherwise, the following actions will be performed:

=over 4

=item * The old file will be moved to I<../DIRECTORS/director/newfile>
(or to I<../DIRECTORS/director/oldfile> if the second argument was not
given),

=item * a symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
(or I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second
argument was not given) will be created, and

=item * the filename in the database will be updated if I<oldfile><>I<newfile>.

=back

Note that the B<--sort> has to be set for this to work; if not, an error
will be raised.


=item B<videomv.pl> I<path/to/oldfile> I<.../DIRECTOR/director/>[I<newfile>]

Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>,
and I<oldfile> is a regular file.
The following actions will be performed:

=over 4

=item * The old file will be moved to I<../DIRECTORS/director/newfile>
(or to I<../DIRECTORS/director/oldfile> if I<newfile> was not given),

=item * a symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
(or I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second
argument was not given) will be created,

=item * the filename in the database will be updated if I<oldfile><>I<newfile>.


=back

=back


=head1 OPTIONS

=over 8

=item B<--sort>

TODO

=item B<--fail>

TODO

=back

=head1 EXIT STATUS

TODO

=head1 REQUIREMENTS

TODO

=head1 AUTHOR

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

=cut

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

my $sort;

# Get options
GetOptions( "sort"    => \$sort,
            "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 or $#ARGV > 1);
*LOG = *STDERR  unless  defined (fileno LOG);

my ($old_path,$new_path) = @ARGV;
$new_path = $symlinks unless defined $new_path;

die "Error: `" .$old_path. "' does not exist\n"
    unless (-l $old_path or -f $old_path);

$new_path = catfile ($new_path, basename($old_path))
    if -d realpath($new_path);
die "Error: `" .$new_path. "' exists\n"
    if (-l $new_path or -f $new_path);

my $old_filename = basename($old_path);
my $new_filename = basename($new_path);

# Get the real paths, {..,symlink}-collapse and so on
my $real_old_path = catfile (realpath (dirname($old_path)), $old_filename);
my $real_new_path = catfile (realpath (dirname($new_path)), $new_filename);

my $real_symlinks  = realpath($symlinks);
my @real_symlinks = splitdir($real_symlinks);
my $real_directors = realpath($directors);
my @real_directors = splitdir($real_directors);


# Connect to database
my $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port";
my $dbh = DBI->connect($dsn, $user, $password)
              or die "Can't connect do database";
$dbh->do( "set names utf8" ) or die;


# Lookup for the file in the videodb database
my $RES =
    $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata
                               WHERE filename = ?",
                              'id', undef, $old_filename
    )
        or die "Can't select: " .$dbh->errstr. "\n";
my $nRES = scalar (keys %$RES);

# The ID of the first movie found in the database, if any
my $id = each %$RES;

my $r;
my ($old_director, $new_director);
my ($old_symlink, $new_symlink, $new_target, $old_target);

if (&is_symlink($real_new_path)) {

    # The destination is under $symlinks

    if (defined $sort) {
        # Find the new director on the database

        # Ensure there is exactly one entry in the db
        die "Error: No entry found in the database while the flag `--sort' was set.\n"
            if $nRES == 0;
        die "Error: Multiples entries found in the database while the flag `--sort' was set.\n"
            if $nRES > 1;

        $new_director = $RES->{$id}->{director};
        $new_director =~ s/ ?: ?/ -/;
        $new_director =~ tr@/@_@;
        $new_director =~ s/[[:cntrl:]]//;
        
        # Create directory if it doesn't exist
        my $new_dirname = catfile ($directors, $new_director);
        unless (-d $new_dirname) {
            print STDERR "Directory `$new_dirname' does not exist. ";
            until (-d $new_dirname) {
                print STDERR "Should I create it? (Y/n) ";
                my $a = lc <STDIN>;
                chomp $a;
                if ($a eq 'y' or $a eq '') {
                    mkdir $new_dirname
                        or die "Error: Cannot mkdir `$new_dirname': $!\n";
                }
                elsif ($a eq 'n') {
                    exit 0;
                }
            }
        }
    }

    $new_symlink = $new_path;

    if (&is_symlink($real_old_path)) {

        $old_symlink = $old_path;

        # Source is presumably a symlink: ensure it is
        die "Error: `" .$old_path. "' is expected to be a symlink.\n"
            unless -l $real_old_path;

        $old_target = realpath ($old_path);
        die "Error: `" .$old_path. "' is expected to target to `"
                       .catfile(updir(),'DIRECTORS','*',$old_filename). "'.\n"
            unless (defined $new_director
                    || &is_director(\$new_director, $old_target));
        $new_target = catfile ($directors, $new_director, $new_filename);
    }

    elsif (&is_director(\$old_director, $real_old_path)) {

        $old_symlink = catfile ($symlinks, $old_filename);
        die "Error: `" .$old_symlink. "' is expected to be a symlink.\n"
            unless -l $old_symlink;
        die "Error: `" .$old_symlink. "' is expected to target to `"
                       .catfile(updir(),'DIRECTORS',$old_director,$old_filename)
                       ."'.\n"
            unless realpath($old_symlink) eq realpath($old_path);

        $old_target = $old_path;

        $new_director = $old_director unless defined $new_director;
        $new_target = catfile ($directors, $new_director, $new_filename);
    }

    else {
        $old_target = $old_path;
        die "Error: `" .$old_path. "' is expected to be a regular file.\n"
            unless -f $old_path;
        die "Error: Dunno where to put this file. Try the `--sort' flag.\n"
            unless defined $new_director;

        $new_target = catfile ($directors, $new_director, $new_filename);
    }
}

elsif (&is_director(\$new_director, $real_new_path)) {

    # The destination is under $directors/*

    $new_target = $new_path;
    $new_symlink = catfile ($symlinks, $new_filename);

    if (&is_symlink($real_old_path)) {

        # Source is presumably a symlink: ensure it is
        die "Error: `" .$old_path. "' is expected to be a symlink.\n"
            unless -l $real_old_path;

        $old_symlink = $old_path;
        $old_target = realpath ($old_path);
    }

    elsif (&is_director(\$old_director, $real_old_path)) {

        $old_symlink = catfile ($symlinks, $old_filename);
        die "Error: `" .$old_symlink. "' is expected to be a symlink.\n"
            unless -l $old_symlink;
        die "Error: `" .$old_symlink. "' is expected to target to `"
                       .catfile(updir(),'DIRECTORS',$old_director,$old_filename)
                       ."'.\n"
            unless realpath($old_symlink) eq realpath($old_path);

        $old_target = $old_path;
    }

    else {
        $old_target = $old_path;
        die "Error: `" .$old_path. "' is expected to be a regular file.\n"
            unless -f $old_path;
    }
}
else {
    die "Error: destination has to be in `"
                  .$symlinks. "' or in `" .catfile($directors,'*'). "'.\n"
       ."See `" .$0. " --man' for details\n";
}



if (dirname (realpath $old_target) eq dirname (realpath $new_target)) {
    unless ($old_filename eq $new_filename) {
        print LOG "Renaming target...      ";
        &ack (\$r, rename $old_target, $new_target);
    }
}
else {
    print LOG "Moving target...        ";
    &ack (\$r, move $old_target, $new_target);
}
if (defined $old_symlink) {
    print LOG "Deleting old symlink... ";
    &ack (\$r, unlink $old_symlink);
}

print LOG "Creating new symlink... ";
&ack (\$r, symlink catfile(updir(),'DIRECTORS',$new_director,$new_filename),
                   $new_symlink);

unless ($old_filename eq $new_filename) {
    print LOG "Updating database...    ";
    if ($nRES == 0) {
        print LOG "failed!: no entry found.\n";
    }
    elsif ($nRES > 1) {
        print LOG "failed!: multiple entries found.\n";
    }
    else {
        my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
                            undef, $new_filename, $id
                 );
        &ack (\$r, $rv);
    }
}

# Disconnect
$dbh->disconnect();



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



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


# Check wether a path starts with $movies
sub is_symlink {
    my @path = splitdir ($_[0]);
    my @real_symlinks = @real_symlinks; #local copy

    while ($#real_symlinks>=0 && $#path>=0 && $real_symlinks[0] eq $path[0]) {
        shift @real_symlinks;
        shift @path;
    };
     
    if ($#real_symlinks<0 && $#path==0) {
        return 1; # That's a "symlink"
    } else {
        return 0; # That's not a "symlink"
    }
}

# Check wether a path starts with $director/dir, and put `dir' in the
# first argument if that's the case
sub is_director {
    my @path = splitdir ($_[1]);
    my @real_directors = @real_directors; #local copy

    while ($#real_directors>=0 && $#path>=0 && $real_directors[0] eq $path[0]) {
        shift @real_directors;
        shift @path;
    };
    
    if ($#real_directors<0 && $#path>=0) {
        ${$_[0]} = $path[0] if defined $_[0];
        return 1; # That's a "director"
    } else {
        return 0; # That's not a "director"
    }
}