diff options
| -rwxr-xr-x | videoadd.pl | 256 | ||||
| -rw-r--r-- | videodb.rc | 13 |
2 files changed, 269 insertions, 0 deletions
diff --git a/videoadd.pl b/videoadd.pl new file mode 100755 index 0000000..d6293f1 --- /dev/null +++ b/videoadd.pl @@ -0,0 +1,256 @@ +#!/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; +use Env qw /HOME/; +use strict; + +################################################################################ + +# Configuration +my $confile = catfile ($HOME, '.videodb.rc'); +die "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/; + +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 => 'akas.imdb.com', debug => 0 ); + +################################################################################ + +# videoadd [--seen] [--dont-sort] [--search=(title|imdbid)] +# [-o title=...] [ -o year=...] +# file + +################################################################################ + +my $seen; +my $search; +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) } + ) + or pod2usage(2); +pod2usage(2) if $#ARGV != 0; +*LOG = *STDERR unless defined (fileno LOG); + +my $file = $ARGV[0]; +my %new; + +################################################################################ + +if (defined $search) { + # Look up the title/ID on IMDB + + my $single; + my $movie; + $imdb{crit} = $search; + + do { + $movie = new IMDB::Film(%imdb); + 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"; + } + for (my $i=0; $i<72; $i++) {print '='}; print "\n"; + + print "Choose an ID above: [$matches[0]->{id}] "; + 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... + $new{title} = basename ($file); + $new{title} =~ s/.(avi|ogm|ogg|bin|mpe?g|ra?m|mov|asf|wmv)$//; +} + + +# Override imdDB's information with the ones provided +foreach (keys %options) { + $new{$_} = $options{$_}; +} + + +################################################################################ + +$new{filename} = basename ($file); +$new{filedate} = (stat $file)[9]; #last modify time in seconds since the epoch +$new{filesize} = (stat $file)[7]; + + + +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); + + + +################################################################################ + +while (my ($k,$v) = each %new) { + print $k, ": ", $v, "\n"; +} + + + +################################################################################ + +exit 0; +# Useless, but Perl doesn't see that this filehandle is used more than +# one time +close NULL; # automatically closed by `open3' + +################################################################################ + +sub video_codec { + my $codec = $_[0]; + return $codec; +} + +sub audio_codec { + my $codec = $_[0]; + return $codec; +} + +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; + $lang = code2language ($code, LOCALE_LANG_ALPHA_3); + 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 new file mode 100644 index 0000000..198b60a --- /dev/null +++ b/videodb.rc @@ -0,0 +1,13 @@ +######################################################################## +# This is a sample configuration file for video*. Extend it and rename # +# it to `~/.videodb.rc' # +######################################################################## + +videodir => catdir($HOME,'video'), +driver => 'mysql', +database => 'videodb', +hostname => '127.0.0.1', +user => 'username', +port => 3306, +password => '******', +videodata => "videodb_videodata", |