Commit | Line | Data |
---|---|---|
14acb11f MW |
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; | |
b2e7e49c | 29 | my %box; |
b2a25885 MW |
30 | my $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set"); |
31 | my $st_disc = $DB->prepare | |
b2e7e49c | 32 | ("SELECT disc, path, box FROM dvd_disc WHERE set_id = ? ORDER BY disc"); |
14acb11f MW |
33 | $st_set->execute; |
34 | ||
b2a25885 | 35 | while (my @r = $st_set->fetchrow_array) { |
14acb11f MW |
36 | my ($id, $name, $ndisc) = @r; |
37 | my @path; | |
38 | ||
39 | $st_disc->execute($id); | |
b2a25885 | 40 | while (my @r = $st_disc->fetchrow_array) { |
b2e7e49c | 41 | my ($disc, $path, $box) = @r; |
14acb11f | 42 | $disc == @path or die "bad disc sequence for `$name'"; |
b2e7e49c | 43 | $box{$path} = $box if defined $box; |
14acb11f MW |
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) { | |
14acb11f MW |
51 | for my $path (@{$set_path{$name}}) { |
52 | if (defined $path && exists $iso{$path}) { delete $iso{$path}; } | |
14acb11f | 53 | } |
14acb11f MW |
54 | } |
55 | ||
56 | my @iso = sort keys %iso; | |
b2e7e49c MW |
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 | ||
562fc845 MW |
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 | ||
396896e5 MW |
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} // "~~~"; | |
562fc845 | 83 | $ba cmp $bb || path_key $pa cmp path_key $pb } |
14acb11f MW |
84 | keys %set_path) { |
85 | my $paths = $set_path{$name}; | |
86 | my @unk; | |
b2e7e49c | 87 | set_box $box{$paths->[0]}; |
14acb11f MW |
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"; | |
b2e7e49c | 96 | set_box $box{$path}; |
14acb11f MW |
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; |