path: root/videoadd.pl

#!/usr/bin/perl -CADS

# 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.3, 01 March 2012";

use warnings;
use strict;
use utf8;
use feature "unicode_strings";

use Getopt::Long qw/:config noauto_abbrev no_ignore_case
                            gnu_compat bundling permute nogetopt_compat
                            auto_version auto_help/;
use Pod::Usage;
use Locale::Language qw /code2language LOCALE_LANG_ALPHA_2
                                       LOCALE_LANG_ALPHA_3/;
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 Encode;

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

# 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 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/update movies to your collection

=head1 SYNOPSIS

B<videoadd.pl> [B<-s>] [B<-u>] [B<--ignore-db>] [B<--dont-move>] [B<--force>] [B<-i> I<crit>]
[B<-o> I<key=value>...] [B<--only=>I<field,field,>...] [B<--exclude=>I<field,field,>...]
[B<-q>] (I<filename>|I<title>|I<id>|I<IMDbID>)

=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

C<videoadd.pl arg> starts by trying to match I<arg> against the
IDs or IMDb IDs (if I<arg> contains only digits),
filenames (if I<arg> has a known video extension), or
titles (with wildcards; succeeds if I<args> is contained in a title)
of the database.

If matching entries are found, then the user is prompted to choose for
an entry to update, or to ignore these entries. In the former case, the
above file hierarchy remains unchanged and the database is merely updated
with the new retrieved data. In the later case, B<videoadd.pl> acts as
below.

If no matching entry is found, I<arg> should be an existing file, and
the correspoding movie is added to the collection.
Various data such as the movie length, the A/V codecs, etc. are read
from the metadata of I<arg> via B<mplayer>.
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 file hierarchy (unless B<--dont-move> 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<-u>, B<--unseen>

Mark the movie as unseen for the I<userid> of the configuration file.
(This flag is ignored unless the action is to update an existing movie
in the database)

=item B<--ignore-db>

Do not connect to the database, hence do not update it with the new
movie, but only move it to the right place in the file hierarchy. Note
that it may break the sanity of your collection.

=item B<--dont-move>

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

=item B<--force>

Do not ask the user before updating existing entries in the database. If
more that one matching entry is found while B<--force> is set,
B<videoadd.pl> exits with a non-zero status.

=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>, B<--option=>I<key=value>

Override data from IMDb 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<--only=>I<field,field,>...

Update only the given fields of the database. Known fields are
I<title>, I<subtitle>, I<language>, I<imdbid>, I<year>, I<imgurl>,
I<director>, I<actors>, I<country>, I<plot>, I<genres>, I<rating>, I<istv>,
I<filename>, I<filesize>, I<filedate>, I<video_codec>, I<audio_codec>,
I<video_width>, I<video_height>, I<runtime>, I<custom1>, I<custom2>,
I<custom3>, I<custom4>.

Two meta-fields are also available:

=over 4

=item *

I<imdb>, which stands for
I<title>, I<subtitle>, I<language>, I<imdbid>, I<year>, I<imgurl>,
I<director>, I<actors>, I<country>, I<plot>, I<genres>, I<rating>,
I<istv>, and

=item *

I<file>, which stands for
I<filename>, I<filesize>, I<filedate>, I<video_codec>, I<audio_codec>,
I<video_width>, I<video_height>, I<runtime>, I<language>.

=back

=item B<--exclude=>I<field,field,>...

Do not update the given fields of the database. See B<--only> above for
details.

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

Do not print the final URL for the freshly added/updated 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  => 'example.org',
  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 $force_update_flag;
my $unseen_flag;
my $move_flag = 1;
my %options;
my @only;
my @exclude;
GetOptions( "s|seen"    => \$seen_flag
          , "u|unseen"  => \$unseen_flag
          , "ignore-db" => \$ignoredb_flag
          , "dont-move" => sub { undef $move_flag }
          , "force"     => \$force_update_flag
          , "i|imdb=s"  => sub { $imdb{crit} = $_[1] }
          , "o|option=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 ) {
    require DBI;
    import  DBI;

    # 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";
        }
    }
    $dbh = DBI->connect($dsn, $config{user}, $config{password})
             or die "Error: Can't connect do database.\n";
}

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


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

if ( defined ($imdb{crit}) and &runIMDb() ) {
    # Look up the title/ID on IMDb

    require IMDB::Film;
    import  IMDB::Film;

    my $single;
    my $movie;

    do {
        $movie = new IMDB::Film(%imdb);
        die "IMDb 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};
    
            print "Found " .(1+$#matches). " matching entries:\n"
                or die "Can't print: $!";
            my @options;
            foreach ( @matches ) {
                print &iconv($_->{id}. ' - ' .$_->{title}. "\n")
                    or die "Can't print: $!";
                push @options, $_->{id};
            }
            for (my $i=0; $i<72; $i++) {print '=' or die "Can't print: $!"};
            print "\n" or die "Can't print: $!";
    
            $imdb{crit} = &question ( \@options,
                                      "Choose an IMDb ID above, to retrieve data for:",
                                      $options[0] );
        }
        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}   = 'imdb:' .$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/;
}
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.

if ( defined $file ) {
    $new{filename} = basename ($file);
    $new{filesize} = (stat $file)[7];
    $new{filedate} = (stat $file)[9]; # Last modify time in seconds since epoch
}    
if ( defined($file) and &runMplayer() ) {