f8d0326319fc93b00c73b2dfd32716fa1038ddf7
[dvddb] / report
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 while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
89 if (@unk) {
90 print "[#UNK: *]\n";
91 for my $path (@unk) { print "\t", $path, "\n"; }
92 }
93 printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
94 my $i = 0;
95 for my $path (@$paths) {
96 $i++;
97 if (!defined $path) {
98 printf "\t!! (disc %d)\n", $i;
99 } else {
100 my $fn = "$ROOT/$path";
101 set_box $box{$path};
102 if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
103 else { print "\t!! ". $path . "\n"; }
104 }
105 }
106 }
107
108 if (@iso) {
109 print "[#UNK: *]\n";
110 for my $path (@iso) { print "\t", $path, "\n"; }
111 }
112
113 $DB->disconnect;