cycle: Print a diff of the changes, if there are any.
[dvddb] / report
diff --git a/report b/report
index c7baf00..9f2bc11 100755 (executable)
--- a/report
+++ b/report
@@ -26,22 +26,21 @@ find(sub {
 
 my %set_path;
 my %set_id;
 
 my %set_path;
 my %set_id;
-my $st_set = $DB->prepare("SELECT id, name, ndisc FROM dvd_set");
-my $st_disc = $DB->prepare("SELECT disc, path FROM dvd_disc
-                           WHERE set_id = ?
-                           ORDER BY disc");
+my %box;
+my $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set");
+my $st_disc = $DB->prepare
+  ("SELECT disc, path, box FROM dvd_disc WHERE set_id = ? ORDER BY disc");
 $st_set->execute;
 
 $st_set->execute;
 
-SET: for (;;) {
-  my @r = $st_set->fetchrow_array; last SET unless @r;
+while (my @r = $st_set->fetchrow_array) {
   my ($id, $name, $ndisc) = @r;
   my @path;
 
   $st_disc->execute($id);
   my ($id, $name, $ndisc) = @r;
   my @path;
 
   $st_disc->execute($id);
-  DISC: for (;;) {
-    my @r = $st_disc->fetchrow_array; last DISC unless @r;
-    my ($disc, $path) = @r;
+  while (my @r = $st_disc->fetchrow_array) {
+    my ($disc, $path, $box) = @r;
     $disc == @path or die "bad disc sequence for `$name'";
     $disc == @path or die "bad disc sequence for `$name'";
+    $box{$path} = $box if defined $box;
     push @path, $path;
   }
   @path == $ndisc or die "wrong number of discs for `$name'";
     push @path, $path;
   }
   @path == $ndisc or die "wrong number of discs for `$name'";
@@ -49,24 +48,43 @@ SET: for (;;) {
 }
 
 for my $name (keys %set_path) {
 }
 
 for my $name (keys %set_path) {
-  my $allp = 1;
   for my $path (@{$set_path{$name}}) {
     if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
   for my $path (@{$set_path{$name}}) {
     if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
-    else { $allp = 0; }
   }
   }
-  ##if ($allp) { delete $set_path{$name}; }
 }
 
 my @iso = sort keys %iso;
 }
 
 my @iso = sort keys %iso;
-for my $name (sort { $set_path{$a}[0] cmp $set_path{$b}[0] }
+my $lastbox = "#nil";
+sub set_box ($) {
+  my ($box) = @_;
+  $box //= "#nil";
+  if ($box ne $lastbox) { print "!box $box\n"; $lastbox = $box; }
+}
+
+sub path_key ($) {
+  my ($p) = @_;
+  if ($p =~ m{^ ([a-z]) / ([^/]+) ((?: / .*)?) $}ix) {
+    my $init = $1;
+    my $focus = $2;
+    my $tail = $3;
+    my $head = undef;
+    if ($focus =~ /^ (the | a ) \s+ (\S .*) $/x)
+      { $head = $1; $focus = $2; }
+    if (lc $init ne lc substr($focus, 0, 1) &&
+       $focus =~ /^ (.*) \s+ ($init .*) $/x)
+      { $head .= (defined $head && " ") . $1; $focus = $2; }
+    if (defined $head) { return "$init/$focus, $head$tail"; }
+  }
+  return $p;
+}
+
+for my $name (sort { my $pa = $set_path{$a}[0]; my $ba = $box{$pa} // "~~~";
+                    my $pb = $set_path{$b}[0]; my $bb = $box{$pb} // "~~~";
+                    $ba cmp $bb || path_key $pa cmp path_key $pb }
                keys %set_path) {
   my $paths = $set_path{$name};
   my @unk;
                keys %set_path) {
   my $paths = $set_path{$name};
   my @unk;
-  while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
-  if (@unk) {
-    print "[#UNK: *]\n";
-    for my $path (@unk) { print "\t", $path, "\n"; }
-  }
+  set_box $box{$paths->[0]};
   printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
   my $i = 0;
   for my $path (@$paths) {
   printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
   my $i = 0;
   for my $path (@$paths) {
@@ -75,6 +93,7 @@ for my $name (sort { $set_path{$a}[0] cmp $set_path{$b}[0] }
       printf "\t!! (disc %d)\n", $i;
     } else {
       my $fn = "$ROOT/$path";
       printf "\t!! (disc %d)\n", $i;
     } else {
       my $fn = "$ROOT/$path";
+      set_box $box{$path};
       if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
       else { print "\t!! ". $path . "\n"; }
     }
       if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
       else { print "\t!! ". $path . "\n"; }
     }