pldb (list): Allow multiple ranges.
[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 $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set");
30 my $st_disc = $DB->prepare
31 ("SELECT disc, path FROM dvd_disc WHERE set_id = ? ORDER BY disc");
32 $st_set->execute;
33
34 while (my @r = $st_set->fetchrow_array) {
35 my ($id, $name, $ndisc) = @r;
36 my @path;
37
38 $st_disc->execute($id);
39 while (my @r = $st_disc->fetchrow_array) {
40 my ($disc, $path) = @r;
41 $disc == @path or die "bad disc sequence for `$name'";
42 push @path, $path;
43 }
44 @path == $ndisc or die "wrong number of discs for `$name'";
45 $set_path{$name} = \@path; $set_id{$name} = $id;
46 }
47
48 for my $name (keys %set_path) {
49 my $allp = 1;
50 for my $path (@{$set_path{$name}}) {
51 if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
52 else { $allp = 0; }
53 }
54 ##if ($allp) { delete $set_path{$name}; }
55 }
56
57 my @iso = sort keys %iso;
58 for my $name (sort { $set_path{$a}[0] cmp $set_path{$b}[0] }
59 keys %set_path) {
60 my $paths = $set_path{$name};
61 my @unk;
62 while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
63 if (@unk) {
64 print "[#UNK: *]\n";
65 for my $path (@unk) { print "\t", $path, "\n"; }
66 }
67 printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
68 my $i = 0;
69 for my $path (@$paths) {
70 $i++;
71 if (!defined $path) {
72 printf "\t!! (disc %d)\n", $i;
73 } else {
74 my $fn = "$ROOT/$path";
75 if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
76 else { print "\t!! ". $path . "\n"; }
77 }
78 }
79 }
80
81 if (@iso) {
82 print "[#UNK: *]\n";
83 for my $path (@iso) { print "\t", $path, "\n"; }
84 }
85
86 $DB->disconnect;