| 1 | #! /usr/bin/perl -w |
| 2 | |
| 3 | use open ":utf8"; |
| 4 | use strict; |
| 5 | |
| 6 | use DBI; |
| 7 | use Encode qw{encode_utf8 decode_utf8}; |
| 8 | use File::Find; |
| 9 | |
| 10 | BEGIN { binmode STDOUT, ":utf8"; } |
| 11 | |
| 12 | my $ROOT = "/mnt/dvd/archive"; |
| 13 | my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "", |
| 14 | { AutoCommit => 0, |
| 15 | RaiseError => 1, |
| 16 | ReadOnly => 1 }); |
| 17 | |
| 18 | my %iso = (); |
| 19 | find(sub { |
| 20 | if (/\.iso$/ && ! -l && -f) { |
| 21 | my $fn = decode_utf8 $File::Find::name; |
| 22 | $fn =~ s:^$ROOT/::; |
| 23 | $iso{$fn} = 1; |
| 24 | } |
| 25 | }, $ROOT); |
| 26 | |
| 27 | my %set_path; |
| 28 | my %set_id; |
| 29 | my %box; |
| 30 | my $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set"); |
| 31 | my $st_disc = $DB->prepare |
| 32 | ("SELECT disc, path, box FROM dvd_disc WHERE set_id = ? ORDER BY disc"); |
| 33 | $st_set->execute; |
| 34 | |
| 35 | while (my @r = $st_set->fetchrow_array) { |
| 36 | my ($id, $name, $ndisc) = @r; |
| 37 | my @path; |
| 38 | |
| 39 | $st_disc->execute($id); |
| 40 | while (my @r = $st_disc->fetchrow_array) { |
| 41 | my ($disc, $path, $box) = @r; |
| 42 | $disc == @path or die "bad disc sequence for `$name'"; |
| 43 | $box{$path} = $box if defined $box; |
| 44 | push @path, $path; |
| 45 | } |
| 46 | @path == $ndisc or die "wrong number of discs for `$name'"; |
| 47 | $set_path{$name} = \@path; $set_id{$name} = $id; |
| 48 | } |
| 49 | |
| 50 | for my $name (keys %set_path) { |
| 51 | for my $path (@{$set_path{$name}}) { |
| 52 | if (defined $path && exists $iso{$path}) { delete $iso{$path}; } |
| 53 | } |
| 54 | } |
| 55 | |
| 56 | my @iso = sort keys %iso; |
| 57 | my $lastbox = "#nil"; |
| 58 | sub set_box ($) { |
| 59 | my ($box) = @_; |
| 60 | $box //= "#nil"; |
| 61 | if ($box ne $lastbox) { print "!box $box\n"; $lastbox = $box; } |
| 62 | } |
| 63 | |
| 64 | sub path_key ($) { |
| 65 | my ($p) = @_; |
| 66 | if ($p =~ m{^ ([a-z]) / ([^/]+) ((?: / .*)?) $}ix) { |
| 67 | my $init = $1; |
| 68 | my $focus = $2; |
| 69 | my $tail = $3; |
| 70 | my $head = undef; |
| 71 | if ($focus =~ /^ (the | a ) \s+ (\S .*) $/x) |
| 72 | { $head = $1; $focus = $2; } |
| 73 | if (lc $init ne lc substr($focus, 0, 1) && |
| 74 | $focus =~ /^ (.*) \s+ ($init .*) $/x) |
| 75 | { $head .= (defined $head && " ") . $1; $focus = $2; } |
| 76 | if (defined $head) { return "$init/$focus, $head$tail"; } |
| 77 | } |
| 78 | return $p; |
| 79 | } |
| 80 | |
| 81 | for my $name (sort { my $pa = $set_path{$a}[0]; my $ba = $box{$pa} // "~~~"; |
| 82 | my $pb = $set_path{$b}[0]; my $bb = $box{$pb} // "~~~"; |
| 83 | $ba cmp $bb || path_key $pa cmp path_key $pb } |
| 84 | keys %set_path) { |
| 85 | my $paths = $set_path{$name}; |
| 86 | my @unk; |
| 87 | set_box $box{$paths->[0]}; |
| 88 | printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name; |
| 89 | my $i = 0; |
| 90 | for my $path (@$paths) { |
| 91 | $i++; |
| 92 | if (!defined $path) { |
| 93 | printf "\t!! (disc %d)\n", $i; |
| 94 | } else { |
| 95 | my $fn = "$ROOT/$path"; |
| 96 | set_box $box{$path}; |
| 97 | if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; } |
| 98 | else { print "\t!! ". $path . "\n"; } |
| 99 | } |
| 100 | } |
| 101 | } |
| 102 | |
| 103 | if (@iso) { |
| 104 | print "[#UNK: *]\n"; |
| 105 | for my $path (@iso) { print "\t", $path, "\n"; } |
| 106 | } |
| 107 | |
| 108 | $DB->disconnect; |