9 binmode STDIN
, ":utf8";
10 binmode STDOUT
, ":utf8";
11 binmode STDERR
, ":utf8";
14 my $ROOT = "/mnt/dvd/archive";
15 my $DB = DBI
->connect("dbi:Pg:host=roadstar", "", "",
19 my $st_get_set = $DB->prepare
20 ("SELECT name, n_disc FROM dvd_set WHERE id = ?");
21 my $st_add_set = $DB->prepare
22 ("INSERT INTO dvd_set (name, n_disc) VALUES (?, ?) RETURNING id");
23 my $st_update_set = $DB->prepare
24 ("UPDATE dvd_set SET name = ?, n_disc = ? WHERE id = ?");
25 my $st_delete_set = $DB->prepare("DELETE FROM dvd_set WHERE id = ?");
27 my $st_get_discs = $DB->prepare
28 ("SELECT disc, path FROM dvd_disc
29 WHERE set_id = ? AND ? <= disc AND disc < ?
31 my $st_add_disc = $DB->prepare
32 ("INSERT INTO dvd_disc (set_id, disc, path) VALUES (?, ?, ?)");
33 my $st_update_disc = $DB->prepare
34 ("UPDATE dvd_disc SET path = ?, disc_id = NULL
35 WHERE set_id = ? AND disc = ?");
36 my $st_delete_disc_range = $DB->prepare
37 ("DELETE FROM dvd_disc WHERE set_id = ? AND ? <= disc AND disc < ?");
38 my $st_delete_discs = $DB->prepare
39 ("DELETE FROM dvd_disc WHERE set_id = ?");
41 my ($id, $name, $ndisc) = (undef, undef, -1);
45 defined $id or return;
47 ##print ";; flush set: #$id: $ndisc\n";
48 ##for my $p (@path) { print ";;\t$p\n"; }
50 if ($ndisc eq "*") { $ndisc = @path; }
51 elsif (@path != $ndisc)
52 { die sprintf "wrong number of discs %d /= %d", scalar @path, $ndisc; }
56 $id = undef; @path = ();
58 } elsif ($id eq "NEW") {
59 $st_add_set->execute($name, $ndisc);
60 ($id) = $st_add_set->fetchrow_array; $st_add_set->finish;
63 $st_get_set->execute($id);
64 my ($old_name, $old_ndisc) = $st_get_set->fetchrow_array;
66 $name ne $old_name || $ndisc ne $old_ndisc and
67 $st_update_set->execute($name, $ndisc, $id);
69 $min_ndisc = $ndisc < $old_ndisc ?
$ndisc : $old_ndisc;
70 $st_get_discs->execute($id, 0, $min_ndisc);
73 my @r = $st_get_discs->fetchrow_array; last DISC
unless @r;
74 my ($disc, $old_path) = @r;
75 $disc == $i or die "unexpected disc number";
76 my $path = $path[$i++];
77 if (defined $path && (!defined $old_path || $path ne $old_path))
78 { $st_update_disc->execute($path, $id, $disc); }
80 $i == $min_ndisc or die "missing disc records";
82 $min_ndisc < $old_ndisc and
83 $st_delete_disc_range->execute($id, $min_ndisc, $old_ndisc);
86 for (my $i = $min_ndisc; $i < $ndisc; $i++)
87 { $st_add_disc->execute($id, $i, $path[$i]); }
89 $id = undef; @path = ();
95 if (/^ \
[ \#
(\d
+ | NEW
| UNK
) \s
* : \s
* (\d
+ | \
* | DEL
) ]
99 ($id, $ndisc, $name) = ($1, $2, $3);
100 if ($ndisc eq "DEL") {
101 $id eq "NEW" || $id eq "UNK" and die "can't delete virtual records";
102 defined $name and die "name `$name' supplied with deletion request";
103 $st_delete_discs->execute($id);
104 $st_delete_set->execute($id);
106 } elsif ($id eq "UNK") {
107 defined $name and die "can't name unknown records";
109 defined $name or die "missing name";
111 } elsif (/^ \s+ (?: !! \s*)? (\S .*) $/x) {
113 defined $id or die "no active set";
115 } elsif (/^ .* \S .* $/) {
116 die "unrecognized line `$_'";
120 $DB->commit; $DB->disconnect;