X-Git-Url: https://git.distorted.org.uk/~mdw/dvddb/blobdiff_plain/14acb11fbceab6626284efa4a1b250f988a31076..HEAD:/report diff --git a/report b/report index c7baf00..9f2bc11 100755 --- a/report +++ b/report @@ -26,22 +26,21 @@ find(sub { 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; -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); - 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'"; + $box{$path} = $box if defined $box; 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) { - my $allp = 1; 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; -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; - 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) { @@ -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"; + set_box $box{$path}; if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; } else { print "\t!! ". $path . "\n"; } }