summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xvideoadd.pl229
-rw-r--r--videodb.rc3
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 ( <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
-}
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'
+