codecs

1 files changed, 124 insertions, 105 deletions

diff --git a/videoadd.pl b/videoadd.pl
index d6293f1..d6a0ff2 100755
--- a/videoadd.pl
+++ b/videoadd.pl
@@ -11,9 +11,10 @@ use DBI;
 use IPC::Open3;
 use File::Basename qw /basename/;
 use File::Spec::Functions;
-use File::Copy;
+use File::Copy qw /move/;
 use Env qw /HOME/;
 use strict;
+use Switch qw /Perl6/;
 
 ################################################################################
 
@@ -24,7 +25,8 @@ 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/;
+    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;
@@ -32,9 +34,8 @@ 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 => 'akas.imdb.com', debug => 0 );
+my %imdb = ( host => $config{imdb}, debug => 0 );
+$config{url} =~ s/\/*$//;
 
 ################################################################################
 
@@ -46,14 +47,17 @@ my %imdb = ( host => 'akas.imdb.com', debug => 0 );
 
 my $seen;
 my $search;
+my $sort = 1;
 my %options;
-GetOptions( "seen"      => \$seen,
-            "s|search=s"=> \$search,
-            "o=s"       => sub { my ($k,$v) = split /=/, $_[1], 2;
-                                 $options{lc $k} = $v; },
-            "q|quiet=s" => sub { open LOG, '>', '/dev/null'
-                                 or die "Cannot open `/dev/null': $!" },
-            "man"       => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
+GetOptions( "seen"      => sub { $options{seen} = 1 }
+          , "s|search=s"=> \$search
+#          , "u|update=s"=> update id/filename
+          , "o=s"       => sub { my ($k,$v) = split /=/, $_[1], 2;
+                                 $options{lc $k} = $v; }
+          , "dont-sort" => sub { undef $sort }
+          , "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;
@@ -62,7 +66,9 @@ pod2usage(2) if $#ARGV != 0;
 my $file = $ARGV[0];
 my %new;
 
+
 ################################################################################
+# Look on-line for information on the movie
 
 if (defined $search) {
     # Look up the title/ID on IMDB
@@ -72,7 +78,12 @@ if (defined $search) {
     $imdb{crit} = $search;
 
     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;
         
@@ -84,11 +95,14 @@ if (defined $search) {
             $imdb{crit} = $matches[0]->{id};
     
             foreach ( @matches ) {
-                print $_->{id}. ' - ' .$_->{title}. "\n";
+                print $_->{id}. ' - ' .$_->{title}. "\n"
+                    or die "Can't print: $!";
             }
-            for (my $i=0; $i<72; $i++) {print '='}; print "\n";
+            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}] ";
+            print "Choose an ID above: [$matches[0]->{id}] "
+                or die "Can't print: $!";
             if ( <STDIN> =~ /(.+)/ ) { $imdb{crit} = $1 };
         }
         else {
@@ -112,7 +126,7 @@ if (defined $search) {
     $new{istv}     = 1 if $movie->kind() =~ /tv/;
 }
 elsif (defined $file) {
-    # Fill in at least the title...
+    # 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)$//;
 }
@@ -125,85 +139,133 @@ foreach (keys %options) {
 
 
 ################################################################################
+# Run mplayer on the given file to get A/V drivers, etc.
 
-$new{filename} = basename ($file);
-$new{filedate} = (stat $file)[9];  #last modify time in seconds since the epoch
-$new{filesize} = (stat $file)[7];
-
-
+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 my $NULL, '+<', '/dev/null' or die "Can't open `/dev/null': $!";
+    *NULL = $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 $search;
+    $new{custom1}  = lc join (', ', @slang);
+}
 
-my @cmd = ('mplayer', '-identify', '-ao', 'null', '-vo', 'null', '-frames', '0',
-                     $file);
-open my $NULL, '+<', '/dev/null' or die "Can't open `/dev/null': $!";
-*NULL = $NULL;
-open3 '<&NULL', my $OUT, '>&NULL', @cmd or die "Can't run mplayer";
 
+################################################################################
+# Sort the file
 
-my (@alang, @slang);
-foreach my $line (<$OUT>) {
-    next unless $line =~ m/^ID_/;
-    chomp $line;
+if ( defined ($file) and defined ($sort) ) {
+    if (defined $new{director}) {
+        move ( $file, catfile ( $directors, $new{director}, $new{filename} ) )
+            or warn "Warning: Cannot move file: $!.\n";
 
-    if ( $line =~ m/^ID_VIDEO_FORMAT=(.*)/ ) {
-        $new{video_codec} = &video_codec($1);
+        symlink catfile( updir(), 'DIRECTORS', $new{director}, $new{filename} ),
+                catfile( $symlinks, $new{filename} )
+            or warn "Warning: Cannot create symlink: $!.\n";
     }
-    elsif ( $line =~ m/^ID_AUDIO_FORMAT=(.*)/ ) {
-        $new{audio_codec} = &audio_codec($1);
+    else {
+        warn "Warning: Cannot move file (no director found).\n"
     }
-    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 $search;
-$new{custom1}  = lc join (', ', @slang);
-
+}
 
 
 ################################################################################
 
 while (my ($k,$v) = each %new) {
-    print $k, ": ", $v, "\n";
+    print $k, ": ", $v, "\n" or die "Can't print: $!";
 }
 
 
 
 ################################################################################
 
+
 exit 0;
 # Useless, but Perl doesn't see that this filehandle is used more than
 # one time
 close NULL; # automatically closed by `open3'
 
+
 ################################################################################
 
+
+# Transform codec codes into proper names
+# TODO: Find more codes
 sub video_codec {
-    my $codec = $_[0];
-    return $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 {
-    my $codec = $_[0];
-    return $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];
-#    return $code if lc $code eq 'mis';
     my $lang;
     $lang = code2language ($code, LOCALE_LANG_ALPHA_2);
     return $lang if defined $lang;
@@ -211,46 +273,3 @@ sub code2lang {
     return $lang if defined $lang;
     return $code;
 }
-
-
-my $id = '0111161';
-my $movie = new IMDB::Film(host=>'akas.imdb.com', crit => $id);
-
-if($movie->status) {
-    print "Title: ", $movie->title(), "\n";
-    # subtitle
-    my $aka = $movie->also_known_as();
-    print map { "$_\n" } @$aka;
-    print "aka: ", join (', ', @$aka), "\n";
-    print "Language: ", join (', ', @{$movie->language()}), "\n";
-    print "imdbID: ", $id, "\n";
-    print "Year: ", $movie->year(), "\n";
-    print "imgurl: ", $movie->cover(), "\n";
-    print "Director: ", join (', ', map {$_->{name}} @{$movie->directors()}), "\n";
-    my @cast = @{$movie->cast()};
-    print "Actors: ";
-    if (@cast) {
-        print "$cast[0]->{name}::$cast[0]->{role}::imdb:$cast[0]->{id}\n";
-        shift @cast;
-        foreach (@cast) {
-            print "        $_->{name}::$_->{role}::imdb:$_->{id}\n";
-        }
-    } else {
-        print "\n";
-    }
-    # runtime
-    print "Country: ", join (', ', @{$movie->country()}), "\n";
-    print "Plot: " .$movie->storyline()."\n";
-    my @r = $movie->rating();
-    print "Rating: " .$r[0], " ", $r[1], " ", join (', ', @{$r[2]}), "\n";
-    # filename
-    # filesize
-    # filedate
-    # audio_codec
-    # video_codec
-    # video_width
-    # video_height
-  # istv
-    # lastupdate
-    # mediatype
-}