create-v4, report, update: Keep track of which box each disc is in.
[dvddb] / report
CommitLineData
14acb11f
MW
1#! /usr/bin/perl -w
2
3use open ":utf8";
4use strict;
5
6use DBI;
7use Encode qw{encode_utf8 decode_utf8};
8use File::Find;
9
10BEGIN { binmode STDOUT, ":utf8"; }
11
12my $ROOT = "/mnt/dvd/archive";
13my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "",
14 { AutoCommit => 0,
15 RaiseError => 1,
16 ReadOnly => 1 });
17
18my %iso = ();
19find(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
27my %set_path;
28my %set_id;
b2e7e49c 29my %box;
b2a25885
MW
30my $st_set = $DB->prepare("SELECT id, name, n_disc FROM dvd_set");
31my $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 35while (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
50for my $name (keys %set_path) {
51 my $allp = 1;
52 for my $path (@{$set_path{$name}}) {
53 if (defined $path && exists $iso{$path}) { delete $iso{$path}; }
54 else { $allp = 0; }
55 }
56 ##if ($allp) { delete $set_path{$name}; }
57}
58
59my @iso = sort keys %iso;
b2e7e49c
MW
60my $lastbox = "#nil";
61sub set_box ($) {
62 my ($box) = @_;
63 $box //= "#nil";
64 if ($box ne $lastbox) { print "!box $box\n"; $lastbox = $box; }
65}
66
14acb11f
MW
67for my $name (sort { $set_path{$a}[0] cmp $set_path{$b}[0] }
68 keys %set_path) {
69 my $paths = $set_path{$name};
70 my @unk;
b2e7e49c 71 set_box $box{$paths->[0]};
14acb11f
MW
72 while (@iso && $iso[0] lt $paths->[0]) { push @unk, shift @iso; }
73 if (@unk) {
74 print "[#UNK: *]\n";
75 for my $path (@unk) { print "\t", $path, "\n"; }
76 }
77 printf "[#%d: %d] %s\n", $set_id{$name}, scalar @$paths, $name;
78 my $i = 0;
79 for my $path (@$paths) {
80 $i++;
81 if (!defined $path) {
82 printf "\t!! (disc %d)\n", $i;
83 } else {
84 my $fn = "$ROOT/$path";
b2e7e49c 85 set_box $box{$path};
14acb11f
MW
86 if (-f $fn && ! -l $fn) { print "\t" . $path . "\n"; }
87 else { print "\t!! ". $path . "\n"; }
88 }
89 }
90}
91
92if (@iso) {
93 print "[#UNK: *]\n";
94 for my $path (@iso) { print "\t", $path, "\n"; }
95}
96
97$DB->disconnect;