summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xvideoadd.pl106
1 files changed, 91 insertions, 15 deletions
diff --git a/videoadd.pl b/videoadd.pl
index 0d39eae..8f6d8cc 100755
--- a/videoadd.pl
+++ b/videoadd.pl
@@ -7,7 +7,7 @@
# See http://sam.zoy.org/wtfpl/COPYING for more details.
-$VERSION = "0.3, 01 March 2012";
+$VERSION = "0.4, 04 March 2012";
use warnings;
use strict;
@@ -26,6 +26,7 @@ use File::Spec::Functions;
use File::Copy qw /move/;
use Env qw /HOME/;
use Switch qw /Perl6/;
+use Date::Parse;
use Encode;
################################################################################
@@ -188,8 +189,14 @@ details.
=item B<-q>, B<--quiet>
+Do not print the list of updated fields with old and new values.
Do not print the final URL for the freshly added/updated movie.
+=item B<-t>, B<--test>
+
+Simulate only the insertion / update. The database and file hierarchy
+are kept unchanged.
+
=back
=head1 CONFIGURATION
@@ -225,8 +232,9 @@ Copyright 2012 Guilhem Moulin. See the source for copying conditions.
my $ignoredb_flag;
my $seen_flag;
-my $force_update_flag;
my $unseen_flag;
+my $force_update_flag;
+my $test_flag;
my $move_flag = 1;
my %options;
my @only;
@@ -236,6 +244,7 @@ GetOptions( "s|seen" => \$seen_flag
, "ignore-db" => \$ignoredb_flag
, "dont-move" => sub { undef $move_flag }
, "force" => \$force_update_flag
+ , "t|test" => \$test_flag
, "i|imdb=s" => sub { $imdb{crit} = $_[1] }
, "o|option=s"=> sub { my ($k,$v) = split /=/, $_[1], 2;
$options{lc $k} = $v; }
@@ -270,10 +279,10 @@ unless ( defined $ignoredb_flag ) {
$dbh->do( "SET NAMES UTF8" ) or die "Error: Can't set names to UTF-8.\n";
}
-my $id;
-my $file = &getfile ($ARGV[0]);
my %new = ( owner_id => $config{userid}
, customs => {});
+my %old;
+my $file = &getfile ($ARGV[0]);
################################################################################
@@ -423,6 +432,44 @@ unless ( defined $ignoredb_flag ) {
WHERE name = ?", undef, 'HDD' )
or die "Can't select. (Unknown mediatype `HDD'?)\n";
+ # Compare old and new entries
+ foreach my $k (qw/Title Language IMDbID Year ImgURL Director Actors
+ Country Plot Rating IsTV
+ FileName FileSize FileDate MD5 Video_Codec Audio_Codec
+ Video_Width Video_Height Runtime
+ Custom1 Custom2 Custom3 Custom4
+ Genres Seen/) {
+ next unless lc $k eq 'seen' or &include (lc $k);
+ next unless (defined $old{lc $k}) and (defined $new{lc $k});
+ my $new = $new{lc $k};
+ my $old = $old{lc $k};
+ if (lc $k eq 'genres') {
+ $new = join (', ', sort @{$new{lc $k}});
+ $old = join (', ', sort @{$old{lc $k}});
+ }
+ if ($old ne $new) {
+ print LOG " * " .$k. ":\n" or die "Can't print: $!";
+
+ my @olds = split /\n/, $old;
+ $old = $olds[0];
+ if (length $old > 75 or $#olds > 0) {
+ $old = substr $old, 0, 75 if length $old > 75;
+ $old .= " [...]";
+ }
+ print LOG " - Old value: " .$old. "\n" or die "Can't print: $!";
+
+ my @news = split /\n/, $new;
+ $new = $news[0];
+ if (length $new > 75 or $#news > 0) {
+ $new = substr $new, 0, 75 if length $new > 75;
+ $new .= " [...]";
+ }
+ print LOG " - New value: " .$new. "\n" or die "Can't print: $!";
+ }
+ }
+ delete $new{seen};
+ exit 0 if defined $test_flag;
+
# Get the genre IDs
my @genres;
if (&include('genres') and defined ($new{genres}) and @{$new{genres}}) {
@@ -468,25 +515,27 @@ unless ( defined $ignoredb_flag ) {
}
my $ok = 1;
- if (defined $id) {
+ my $id;
+ if (defined $old{id}) {
# We got an already existing movie
push @SET, "lastupdate = NOW()";
$dbh->do( "UPDATE $config{prefix}videodata
SET " .join (', ', @SET). "
- WHERE id = $id" )
+ WHERE id = $old{id}" )
or die "Can't update: $!\n";
if (&include ('genres')) {
$dbh->do( "DELETE FROM $config{prefix}videogenre
- WHERE video_id = $id" )
+ WHERE video_id = $old{id}" )
or die "Can't delete: $!\n";
}
if (defined $unseen_flag) {
$dbh->do( "DELETE FROM $config{prefix}userseen
- WHERE video_id = $id
+ WHERE video_id = $old{id}
AND user_id = $config{userid}" )
or die "Can't delete: $!\n";
}
+ $id = $old{id};
}
else {
# We got a fresh movie to insert
@@ -645,7 +694,7 @@ sub getfile {
my $crit = &iconv($_[0]);
return $crit if defined $ignoredb_flag;
- my $SELECT = "SELECT id, imdbid, filename, title, year FROM $config{prefix}videodata
+ my $SELECT = "SELECT id, title, year FROM $config{prefix}videodata
WHERE ";
if ($crit =~ /^[0-9]+$/) {
$SELECT .= "id = $crit OR imdbid = 'imdb:$crit'";
@@ -686,7 +735,7 @@ sub getfile {
or die "Can't print: $!";
push @options, sprintf ("%04d", $res->{$id}->{id});
}
- print "a - Ignore the matching entries, and add the new movie.\n"
+ print "a - Ignore the above matching entries, and add the new movie.\n"
or die "Can't print: $!";
push @options, 'a';
for (my $i=0; $i<72; $i++) {print '=' or die "Can't print: $!"};
@@ -697,16 +746,43 @@ sub getfile {
$answer =~ s/^0+//;
unless ($answer eq 'a') {
- $id = $res->{$answer}->{id};
- my $imdbid = $res->{$answer}->{imdbid};
+ %old = %{ $dbh->selectrow_hashref( "SELECT * FROM $config{prefix}videodata WHERE id = ?",
+ undef, $answer ) }
+ or die "Can't select: $!\n";
+ foreach (keys %old) {
+ Encode::_utf8_on($old{$_});
+ }
+ $old{imdbid} = $old{imdbID};
+ delete $old{imdbID};
+ my $genres = $dbh->selectall_arrayref( "SELECT name FROM
+ $config{prefix}genres JOIN $config{prefix}videogenre
+ ON genre_id = id
+ WHERE video_id = ?",
+ undef, $answer )
+ or die "Can't select: $!\n";
+ $old{genres} = [ map {$_->[0]} @$genres ];
+ foreach (@{$old{genres}}) {
+ Encode::_utf8_on($_);
+ }
+ my $seen = $dbh->selectall_arrayref( "SELECT * FROM $config{prefix}userseen
+ WHERE video_id = $old{id}
+ AND user_id = $config{userid}" )
+ or die "Can't select: $!\n";
+ $new{seen} = 'Yes' if defined $seen_flag;
+ $new{seen} = 'No' if defined $unseen_flag;
+ $old{seen} = 'Yes' if @$seen;
+ $old{seen} = 'No' unless defined @$seen;
+
+ $old{filedate} = str2time($old{filedate});
+ my $imdbid = $old{imdbid};
unless (defined $imdb{crit}) {
- warn "Warning: No imdbID found for ID $id. Try `--imdb'.\n"
+ warn "Warning: No IMDb ID found for ID $old{id}. Try `--imdb'.\n"
unless defined $imdbid;
$imdbid =~ s/^imdb:// if defined $imdbid;
$imdb{crit} = $imdbid;
}
undef $move_flag;
- return catfile( $config{videodir}, 'MOVIES', $res->{$answer}->{filename} );
+ return catfile( $config{videodir}, 'MOVIES', $old{filename} );
}
}
@@ -818,7 +894,7 @@ sub iconv {
}
# The UTF-8 flag should be on now
- warn "Warning: Not a valid Unicode string: \"$string\"\n"
+ warn "Warning: Not a valid Unicode string: \"$string\".\n"
unless utf8::valid($string);
return $string;
}