From 1efbaead3ddd09c4e96d27bbf9ecedc657125c50 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 14 Jan 2012 02:56:51 +0100 Subject: codecs --- videoadd.pl | 229 ++++++++++++++++++++++++++++++++---------------------------- videodb.rc | 3 + 2 files changed, 127 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 ( =~ /(.+)/ ) { $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 -} diff --git a/videodb.rc b/videodb.rc index 198b60a..6928736 100644 --- a/videodb.rc +++ b/videodb.rc @@ -11,3 +11,6 @@ user => 'username', port => 3306, password => '******', videodata => "videodb_videodata", +imdb => 'akas.imdb.com', +url => 'https://videodb.example.org' + -- cgit v1.2.3