Merge branch 'videoadd' of ssh://guilhem.org/home/git/public/videodb-tools into videodb-check

Conflicts:
	videodb.rc

2 files changed, 317 insertions, 0 deletions

diff --git a/videoadd.pl b/videoadd.pl
new file mode 100755
index 0000000..add8f2a
--- /dev/null
+++ b/videoadd.pl
@@ -0,0 +1,311 @@
+#!/usr/bin/perl -w
+
+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 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 videodata
+        imdb url/;
+
+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/\/*$//;
+
+################################################################################
+
+# videoadd [--seen] [--dont-sort] [--search=(title|imdbid)]
+#   [-o title=...] [ -o year=...]
+#   file
+
+################################################################################
+
+my $ignoredb_flag;
+my $sort_flag = 1;
+my %options;
+GetOptions( "seen"      => sub { $options{seen} = 1 }
+          , "s|search=s"=> sub { $imdb{crit} = $_[1] }
+#          , "u|update=s"=> update id/filename
+          , "o=s"       => sub { my ($k,$v) = split /=/, $_[1], 2;
+                                 $options{lc $k} = $v; }
+          , "dont-sort" => sub { undef $sort_flag }
+          , "ignore-db" => \$ignoredb_flag
+          , "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);
+
+my $file = $ARGV[0];
+my %new;
+
+
+################################################################################
+# 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}";
+    $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";
+}
+
+
+################################################################################
+# Look on-line for information on the movie
+
+if (defined $imdb{crit}) {
+    # Look up the title/ID on IMDB
+
+    my $single;
+    my $movie;
+
+    do {
+        # Bug, see https://rt.cpan.org/Public/Bug/Display.html?id=71429
+        open my $STDOUT, '>&', \*STDOUT or die "Can't dup: $!";
+        open STDOUT, '>', '/dev/null' or die "Cannot open `/dev/null': $!";
+        $movie = new IMDB::Film(%imdb);
+        close STDOUT or die "Can't close";
+        open STDOUT, '>>&', $STDOUT or die "Cannot open: $!";
+        die "Something wrong happened: " .$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 {$_->{name}. '::' .$_->{role}. '::imdb:' .$_->{id}}
+                                    @{$movie->cast()};
+    $new{country}  = join ', ', @{$movie->country()};
+    $new{plot}     = $movie->storyline();
+    $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 (keys %options) {
+    $new{$_} = $options{$_};
+}
+
+
+################################################################################
+# 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
+    
+    
+    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};
+    $new{custom1}  = lc join (', ', @slang);
+}
+
+
+################################################################################
+# Insertion into the database
+
+unless ( defined $ignoredb_flag ) {
+    my $INSERT = "INSERT INTO $config{videodata}
+                  SET mediatype = 14";
+    if (defined $new{filedate}) {
+        $INSERT .= ", filedate = FROM_UNIXTIME($new{filedate})";
+        delete $new{filedate};
+    }
+
+    while (my ($k,$v) = each %new) {
+        $INSERT .= ", " .$k. " = " .$dbh->quote ($v);
+    }
+    $dbh->do($INSERT) or die "Can't insert: $!\n";
+#     print $INSERT, "\n";
+    
+    my $ids = $dbh->selectall_arrayref ( "SELECT id FROM $config{videodata}
+                                          WHERE filename = ? ",
+                                         undef, $new{filename} );
+    if ($#$ids == 0) {
+        print LOG "Check it out! ",
+                  $config{url}, "/show.php?id=", $ids->[0]->[0], "\n"
+            or die "Can't print: $!";
+    }
+    else {
+        warn "Warning: Something weird happened during the INSERT.\n";
+    }
+
+    $dbh->disconnect;
+}
+
+
+
+################################################################################
+# Sort the file
+
+if ( defined ($file) and defined ($sort_flag) ) {
+    if (defined $new{director}) {
+        move ( $file, catfile ( $directors, $new{director}, $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;
+}
diff --git a/videodb.rc b/videodb.rc
index 198b60a..7babf8f 100644
--- a/videodb.rc
+++ b/videodb.rc
@@ -11,3 +11,9 @@ user      => 'username',
 port      => 3306,
 password  => '******',
 videodata => "videodb_videodata",
+<<<<<<< HEAD
+=======
+imdb      => 'akas.imdb.com',
+url       => 'https://videodb.example.org'
+
+>>>>>>> origin/videoadd