diff options
| -rwxr-xr-x | videoadd.pl | 311 | ||||
| -rw-r--r-- | videodb.rc | 6 |
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; +} @@ -11,3 +11,9 @@ user => 'username', port => 3306, password => '******', videodata => "videodb_videodata", +<<<<<<< HEAD +======= +imdb => 'akas.imdb.com', +url => 'https://videodb.example.org' + +>>>>>>> origin/videoadd |