print details during update

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;
 }