#!/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, 17 February 2012";

use Getopt::Long qw/:config noauto_abbrev nogetopt_compat no_ignore_case
                            permute bundling auto_version auto_help/;
use Pod::Usage;
use IMDB::Film;
use Locale::Language qw /code2language LOCALE_LANG_ALPHA_2
                                       LOCALE_LANG_ALPHA_3/;
use DBI;

use IPC::Open3;
use File::Basename qw /basename/;
use File::Spec::Functions;
use File::Copy qw /move/;
use Env qw /HOME/;
use Switch qw /Perl6/;
use utf8;
use strict;

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

# Configuration
my $confile = catfile ($HOME, '.videodb.rc');
die "Error: 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 userid imdb url/;
$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;

my %imdb = ( host => $config{imdb}, debug => 0 );
$config{url} =~ s/\/*$//;

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

=head1 NAME

videoadd.pl - add movies to your collection

=head1 SYNOPSIS

B<videoadd.pl> [B<-s>] [B<--ignore-db>] [B<--dont-sort>] [B<-i> I<crit>]
[B<-o> I<key=value>...] [B<-q>] I<filename>

=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<videoadd.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<videoadd.pl> add the given movie to your collection. Various data such
as the movie length, the A/V codecs, etc. are read from the metadata of
the movie. One can fetch other data (e.g., year, director, cast, etc.)
from IMDB (option B<-i>). If there is a clash (e.g., language) the metadata
take precedence.
The database is then updated with the new movie (unless B<--ignore-db>
is set), which in turn is put in the right place of the above hierarchy
(unless B<--dont-sort> is set).

=head1 OPTIONS

=over 8

=item B<-s>, B<--seen>

Mark the movie as seen for the I<userid> of the configuration file.

=item B<--ignore-db>

Do not connect to the database, hence do not update it with the new
movie. Note that it may break the sanity of your collection.

=item B<--dont-sort>

Do not put the new movie in I<DIRECTORS/director/movie>, with a
symlink I<MOVIES/movie> -> I<DIRECTORS/director/movie>.
Note that it may break the sanity of your collection.

=item B<-i> I<crit>, B<--imdb=>I<crit>

Search for the given criterion (e.g., a movie title or an IMDB ID) on
IMDB. The retrieved data (such as year, director, cast, etc.) will be
added to the database (unless overriden by B<-o> I<key=value>).

=item B<-o> I<key=value>

Override data with the I<value> provided.
Valid I<key>s are I<title>, I<language >, I<imdbid>, I<year>, I<imgurl>,
I<director>, I<genres>, I<country>, I<plot>, I<rating>, I<istv>.

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

Do not print the final URL for the freshly added movie.

=back

=head1 CONFIGURATION

B<videoadd> 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_",
  userid    => 1,
  imdb      => 'akas.imdb.com',
  url       => 'https://videodb.example.org',

=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


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

my $ignoredb_flag;
my $seen_flag;
my $unseen_flag;
my $sort_flag = 1;
my %options;
my @only;
my @exclude;
GetOptions( "s|seen"    => \$seen_flag
          , "u|unseen"  => \$unseen_flag
          , "ignore-db" => \$ignoredb_flag
          , "dont-sort" => sub { undef $sort_flag }
          , "i|imdb=s"  => sub { $imdb{crit} = $_[1] }
          , "o=s"       => sub { my ($k,$v) = split /=/, $_[1], 2;
                                 $options{lc $k} = $v; }
          , "only=s"    => sub { @only = &keywords (split /,/, $_[1]) }
          , "exclude=s" => sub { @exclude = &keywords (split /,/, $_[1]) }
          , "q|quiet=s" => 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);

################################################################################
# Connection to the database

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

my $id;
my $file = &getfile ($ARGV[0]);
my %new = ( owner_id => $config{userid}
          , customs  => {});


################################################################################
# Look on-line for information on the movie

# TODO: don't look on-line if it's a db update with eg, only=video_codec
if (defined $imdb{crit}) {
    # Look up the title/ID on IMDB

    my $single;
    my $movie;

    do {
        $movie = new IMDB::Film(%imdb);
        die "Error: " .$movie->error. "\n"
            unless $movie->status;
        
        my @matches = @{$movie->matched};
        if (@matches) {
            # Got several results; Print them, and ask the user to pick up an ID
            die "No result found.\n" unless defined $matches[0]->{id};
    
            $imdb{crit} = $matches[0]->{id};
    
            foreach ( @matches ) {
                print $_->{id}. ' - ' .$_->{title}. "\n"
                    or die "Can't print: $!";
            }
            for (my $i=0; $i<72; $i++) {print '=' or die "Can't print: $!"};
            print "\n" or die "Can't print: $!";
    
            print "Choose an ID above: [$matches[0]->{id}] "
                or die "Can't print: $!";
            if ( <STDIN> =~ /(.+)/ ) { $imdb{crit} = $1 };
        }
        else {
            $single = 1;
        }
    } until defined $single;

    # Got a single result; Process the movie
    $new{title}    = $movie->title();
    $new{language} = lc join (', ', @{$movie->language()});
    $new{imdbid}   = $movie->id();
    $new{year}     = $movie->year();
    $new{imgurl}   = $movie->cover();
    $new{director} = join ', ', map {$_->{name}} @{$movie->directors()};
    $new{actors}   = join "\n", map {&mkcast($_)} @{$movie->full_cast()};
    $new{country}  = join ', ', @{$movie->country()};
    $new{plot}     = $movie->storyline(); # TODO; plot vs. full_plot vs. storyline?
    $new{genres}   = $movie->genres();
    $new{rating}   = $movie->rating(); # Ignoring #votes and awards
    $new{istv}     = 1 if $movie->kind() =~ /tv/;

    # Convert the retrieved data to UTF-8
    map { utf8::encode($new{$_})
          if exists ($new{$_}) and defined ($new{$_}) and $new{$_} ne ""
             and not utf8::is_utf8($new{$_}) }
        qw/title subtitle language diskid comment disklabel imgurl director
           actors country filename plot/;
    map { utf8::encode($_) unless utf8::is_utf8($_) } @{$new{genres}};
}
elsif (defined $file) {
    # Fill in at least the title, based on the file name...
    $new{title} = basename ($file);
    $new{title} =~ s/.(avi|ogm|ogg|bin|mpe?g|ra?m|mov|asf|wmv|mkv)$//i;
}


# Override imdDB's information with the ones provided
foreach my $k (keys %options) {
    die "Error: Unknown key `" .$k. "'.\n"
        unless grep { $_ eq $k }
                    qw/title language imdbid year imgurl genres
                       director country plot rating istv/;
    $new{$k} = $options{$k};
    $new{$k} = [ split /,\s*/, $new{$k} ] if $k eq 'genres';
}


################################################################################
# Run mplayer on the given file to get A/V codecs, etc.

# TODO: don't run mplayer if it's a db update with eg, only=title
if ( defined($file) ) {
    $new{filename} = basename ($file);
    $new{filesize} = (stat $file)[7];
    $new{filedate} = (stat $file)[9]; # Last modify time in seconds since epoch
    
    
    my @cmd = ('mplayer', '-identify',
                          '-ao', 'null', '-vo', 'null', '-frames', '0',
                          $file);
    open NULL, '+<', '/dev/null' or die "Can't open `/dev/null': $!";
    open3 '<&NULL', my $OUT, ">&NULL", @cmd or die "Can't run mplayer";
    
    
    my (@alang, @slang);
    foreach my $line (<$OUT>) {
        next unless $line =~ m/^ID_/;
        chomp $line;
    
        if ( $line =~ m/^ID_VIDEO_FORMAT=(.*)/ ) {
            $new{video_codec} = &video_codec($1);
        }
        elsif ( $line =~ m/^ID_AUDIO_FORMAT=(.*)/ ) {
            $new{audio_codec} = &audio_codec($1);
        }
        elsif ( $line =~ m/^ID_VIDEO_WIDTH=(.*)/ ) {
            $new{video_width} = $1;
        }
        elsif ( $line =~ m/^ID_VIDEO_HEIGHT=(.*)/ ) {
            $new{video_height} = $1;
        }
        elsif ( $line =~ m/^ID_LENGTH=(.*)/ ) {
            $new{runtime} = $1;
            die "I won't mess up the db with your crappy empty movie.\n"
                if $new{runtime} =~ /^0*\.?0*$/;
            $new{runtime} = sprintf "%d", $new{runtime}/60;
        }
        elsif ( $line =~ m/^ID_AID_\d+_LANG=(.*)/ ) {
            push @alang, &code2lang ($1);
        }
        elsif ( $line =~ m/^ID_SID_\d+_LANG=(.*)/ ) {
            push @slang, &code2lang ($1);
        }
    };
    $new{language} = lc join (', ', @alang)
        unless $#alang < 0 and defined $imdb{crit};
    # The "Subtitles" field is not hard-coded: insert it in the "custom" field instead
    $new{customs}->{subtitles} = lc join (', ', @slang);
}
 

################################################################################
# Insertion into the database

unless ( defined $ignoredb_flag ) {
    # Handle custom fields
    my $customs = $dbh->selectall_arrayref ( "SELECT opt,value FROM $config{prefix}config
                                             WHERE opt REGEXP '^custom[1-9]+\$'" )
                      or die "Can't select: $!\n";
    foreach my $c (@$customs) {
        if (grep {lc $_ eq lc $c->[1]} (keys %{$new{customs}})) {
            $new{$c->[0]} = $new{customs}->{lc $c->[1]};
        }
    }
    delete $new{customs};

    # Get the (first found) mediatype for files on the hard disk
    my $mediatype = $dbh->selectrow_arrayref( "SELECT id FROM $config{prefix}mediatypes
                                               WHERE name = ?", undef, 'HDD' )
                        or die "Can't select. (Unknown mediatype `HDD'?)\n";

    # Get the genre IDs
    my @genres;
    if (@{$new{genres}}) {
        my $sth_selgenre = $dbh->prepare( "SELECT id FROM $config{prefix}genres WHERE name = ?" )
                               or die "Error: " .$dbh->errstr;
        my $sth_insgenre = $dbh->prepare( "INSERT INTO $config{prefix}genres SET name = ?" )
                               or die "Error: " .$dbh->errstr;
        foreach my $g (@{$new{genres}}) {
            $sth_selgenre->execute ($g);
            my @gids = $sth_selgenre->fetchrow_array;
            die $sth_selgenre->errstr if $sth_selgenre->err;
            unless (@gids) {
                # Insert non existing genres
                $sth_insgenre->execute ($g);
                die $sth_insgenre->errstr if $sth_insgenre->err;
                $sth_selgenre->execute ($g);
                @gids = $sth_selgenre->fetchrow_array;
                die $sth_selgenre->errstr if $sth_selgenre->err;
            }
            push @genres, @gids;
        }
        $sth_selgenre->finish;
        $sth_insgenre->finish;
    }
    delete $new{genres};

    my @SET;
    if (&include('filedate') && defined $new{filedate}) {
        push @SET, "filedate = FROM_UNIXTIME($new{filedate})";
        delete $new{filedate};
    }
    push @SET, "mediatype = $mediatype->[0]"
        if defined ($mediatype) and defined ($mediatype->[0]);

    while (my ($k,$v) = each %new) {
        next unless &include ($k);
        push @SET, $k. " = " .$dbh->quote ($v) if defined $v;
    }

    my $ok = 1;
    if (defined $id) {
        # We got an already existing movie
        push @SET, "lastupdate = NOW()";
        $dbh->do( "UPDATE $config{prefix}videodata
                   SET " .join (', ', @SET). "
                   WHERE id = $id" )
            or die "Can't update: $!\n";

        if (&include ('genres')) {
            $dbh->do( "DELETE FROM $config{prefix}videogenre
                       WHERE video_id = $id" )
                or die "Can't delete: $!\n";
        }
        if (defined $unseen_flag) {
            $dbh->do( "DELETE FROM $config{prefix}userseen
                       WHERE video_id = $id
                         AND user_id = $config{userid}" )
                or die "Can't delete: $!\n";
        }
    }
    else {
        # We got a fresh movie to insert
        push @SET, "created = NOW()";
        $dbh->do( "INSERT INTO $config{prefix}videodata
                   SET " .join (', ', @SET) )
            or die "Can't insert: $!\n";

        my $ids = $dbh->selectall_arrayref ( "SELECT id FROM $config{prefix}videodata
                                              WHERE filename = ? ",
                                             undef, $new{filename} )
                      or die "Can't select: $!\n";
    
        if ($#$ids == 0) {
            $id = $ids->[0]->[0];
        }
        else {
            $ok = 0;
            warn "Warning: Something weird happened during the INSERT. You should probably check the sanity of your collection.\n";
        }
    }
    
    if ($ok) {
        # Update the userseen & videogenre tables
        if (defined $seen_flag) {
            $dbh->do( "INSERT INTO $config{prefix}userseen
                       SET video_id = $id,
                           user_id = $config{userid}" )
                or die "Can't insert: $!\n";
        }
        if (&include ('genres')) {
            my $sth_insgenre = $dbh->prepare( "INSERT INTO $config{prefix}videogenre
                                               SET video_id = $id,
                                                   genre_id = ?" )
                                   or die "Error: " .$dbh->errstr;
            foreach (@genres) {
                $sth_insgenre->execute ($_);
                die $sth_insgenre->errstr if $sth_insgenre->err;
            }
            $sth_insgenre->finish;
        }

        print LOG "Check it out! ", $config{url}. "/show.php?id=" .$id, "\n"
            or die "Can't print: $!";
    }

    $dbh->disconnect;
}



################################################################################
# Sort the file

if ( defined ($file) and defined ($sort_flag) ) {
    if (defined $new{director}) {
        my $dir = catdir ( $directors, $new{director} );
        unless (-d $dir) {
            print STDERR "Directory `$dir' does not exist. ";
            until (-d $dir) {
                print STDERR "Should I create it? (Y/n) ";
                my $a = lc <STDIN>;
                chomp $a;
                if ($a eq 'y' or $a eq '') {
                    mkdir $dir
                        or die "Error: Cannot mkdir `$dir': $!\n";
                }
                elsif ($a eq 'n') {
                    exit 0;
                }
            }
        }
        move ( $file, catfile ( $dir, $new{filename} ) )
            or warn "Warning: Cannot move file: $!.\n";

        symlink catfile( updir(), 'DIRECTORS', $new{director}, $new{filename} ),
                catfile( $symlinks, $new{filename} )
            or warn "Warning: Cannot create symlink: $!.\n";
    }
    else {
        warn "Warning: Cannot move file (no director found).\n"
    }
}


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


exit 0;
# Useless, but Perl doesn't see that this filehandle is used more than once
close NULL; # Automatically closed by `open3'


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


# Transform codec codes into proper names
# TODO: Find more codes
sub video_codec {
    given ($_[0]) {
        when /^0x10000001$/i  { return 'MPEG-1'; }
        when /^0x10000002$/i  { return 'MPEG-2'; }
        when /^(MPG4|MP4V)$/i { return 'MPEG-4'; }
        when /^MP42$/i        { return 'MS MPEG-4 v2'; }
        when /^MP43$/i        { return 'MS MPEG-4 v3'; }
        when /^div3$/i        { return 'DivX3'; }
        when /^DIV(4|X)$/i    { return 'DivX4'; }
        when /^DX50$/i        { return 'DivX5'; }
        when /^XVID$/i        { return 'XviD'; }
        when /^(avc1|H264)$/i { return 'H.264'; }
        when /^VP62$/i        { return 'VP6'; }
        when /^RV40$/i        { return 'rv40'; }
        default               { return $_[0]; }
    }
}

sub audio_codec {
    given ($_[0]) {
        when /^1$/i     { return 'PCM'; }
        when /^2$/i     { return 'MS ADPCM'; }
        when /^85$/i    { return 'MP3'; }
        when /^8192$/i  { return 'AC-3'; }
        when /^353$/i   { return 'WMA v2'; }
        when /^MP4A$/i  { return 'AAC'; }
        when /^22127$/i { return 'Vorbis'; }
        default         { return $_[0]; }
    }
}


# Convert ISO 639 language codes into full names
sub code2lang {
    my $code = $_[0];
    my $lang;
    $lang = code2language ($code, LOCALE_LANG_ALPHA_2);
    return $lang if defined $lang;
    $lang = code2language ($code, LOCALE_LANG_ALPHA_3);
    return $lang if defined $lang;
    return $code;
}

sub mkcast {
    no warnings 'uninitialized'; 
    return $_->{name}. '::' .$_->{role}. '::imdb:' .$_->{id};
}

# Try to find a matching entry in the database.
sub getfile {
    my $crit = $_[0];
    return $crit if defined $ignoredb_flag;
    
    my $SELECT = "SELECT id, imdbid, filename FROM $config{prefix}videodata
                  WHERE ";
    if ($crit =~ /^[0-9]+$/) {
        $SELECT .= "id = $crit OR imdbid = 'imdb:$crit'"; 
    }
    elsif ($crit =~ /.(avi|ogm|ogg|bin|mpe?g|ra?m|mov|asf|wmv|mkv)$/i) {
        $SELECT .= "filename = " .$dbh->quote (basename ($crit));
    }
    else {
        $SELECT .= "title LIKE " .$dbh->quote ('%'.$crit.'%');
    }

    my $res = $dbh->selectall_arrayref( $SELECT ) or die "Can't select: $!\n";

    # TODO: print the list and ask the user to choose instead?
    die "Error: Multiple entries found in the database. Try to refine your search.\n"
        if $#$res > 0;

    if ($#$res == 0) {
        $id = $res->[0]->[0];
        my $imdbid = $res->[0]->[1];
        print STDERR "Updating ID $id...\n";

        unless (defined $imdb{crit}) {
            warn "Warning: No imdbID found for ID $id. Try `--imdb'.\n"
                unless defined $imdbid;
            $imdb{crit} = $imdbid;
        }

        return catfile($config{videodir}, 'MOVIES', $res->[0]->[2]);
    }

    # We have a new file to add to the database
    die "Error: No such file `" .$crit. "' (and I can't find a matching entry in the database).\n"
        unless -f $crit;
    return $crit;
}

sub keywords {
    my @ret;
    foreach my $k (@_) {
        if (lc $k eq 'imdb') {
            push @ret, qw/title subtitle language imdbid year imgurl
                          director actors country plot genres rating/;
        }
        elsif (lc $k eq 'file') {
            push @ret, qw/filename filesize filedate
                          video_codec audio_codec video_width video_height
                          runtime language/;
        }
        else {
            die "Error: Unknown key `" .$k. "'.\n"
                unless grep { $_ eq $k }
                            qw/title subtitle language imdbid year imgurl
                               director actors country plot genres rating
                               filename filesize filedate video_codec
                               audio_codec video_width video_height runtime
                               custom1 custom2 custom3 custom4/;
            push @ret, lc $k;
        }
    }
    return @ret;
}

sub include {
    # Returns 1 if the key should be included, 0 otherwise
    my $k = $_[0];
    return 0 if grep {$_ eq $k} @exclude;
    return 0 if @only and not (grep {$_ eq $k} @only);
    return 1;
}