+#! /usr/bin/perl -w
+
+use open ":utf8";
+use strict;
+
+use DBI;
+
+BEGIN {
+ binmode STDIN, ":utf8";
+ binmode STDOUT, ":utf8";
+ binmode STDERR, ":utf8";
+}
+
+my $ROOT = "/mnt/dvd/archive";
+my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "",
+ { AutoCommit => 0,
+ RaiseError => 1 });
+
+my $st_get_set = $DB->prepare("SELECT name, ndisc FROM dvd_set
+ WHERE id = ?");
+my $st_add_set = $DB->prepare("INSERT INTO dvd_set (name, ndisc)
+ VALUES (?, ?)
+ RETURNING id");
+my $st_update_set = $DB->prepare("UPDATE dvd_set
+ SET name = ?, ndisc = ?
+ WHERE id = ?");
+my $st_delete_set = $DB->prepare("DELETE FROM dvd_set WHERE id = ?");
+
+my $st_get_discs = $DB->prepare("SELECT disc, path FROM dvd_disc
+ WHERE set_id = ? AND ? <= disc AND disc < ?
+ ORDER BY disc");
+my $st_add_disc = $DB->prepare("INSERT INTO dvd_disc (set_id, disc, path)
+ VALUES (?, ?, ?)");
+my $st_update_disc = $DB->prepare("UPDATE dvd_disc SET path = ?
+ WHERE set_id = ? AND disc = ?");
+my $st_delete_disc_range = $DB->prepare("DELETE FROM dvd_disc
+ WHERE set_id = ? AND
+ ? <= disc AND disc < ?");
+my $st_delete_discs = $DB->prepare("DELETE FROM dvd_disc WHERE set_id = ?");
+
+my ($id, $name, $ndisc) = (undef, undef, -1);
+my @path;
+
+sub flush_set () {
+ defined $id or return;
+
+ ##print ";; flush set: #$id: $ndisc\n";
+ ##for my $p (@path) { print ";;\t$p\n"; }
+
+ if ($ndisc eq "*") { $ndisc = @path; }
+ elsif (@path != $ndisc)
+ { die sprintf "wrong number of discs %d /= %d", scalar @path, $ndisc; }
+
+ my $min_ndisc;
+ if ($id eq "UNK") {
+ $id = undef; @path = ();
+ return;
+ } elsif ($id eq "NEW") {
+ $st_add_set->execute($name, $ndisc);
+ ($id) = $st_add_set->fetchrow_array; $st_add_set->finish;
+ $min_ndisc = 0;
+ } else {
+ $st_get_set->execute($id);
+ my ($old_name, $old_ndisc) = $st_get_set->fetchrow_array;
+ $st_get_set->finish;
+ $name ne $old_name || $ndisc ne $old_ndisc and
+ $st_update_set->execute($name, $ndisc, $id);
+
+ $min_ndisc = $ndisc < $old_ndisc ? $ndisc : $old_ndisc;
+ $st_get_discs->execute($id, 0, $min_ndisc);
+ my $i = 0;
+ DISC: for (;;) {
+ my @r = $st_get_discs->fetchrow_array; last DISC unless @r;
+ my ($disc, $old_path) = @r;
+ $disc == $i or die "unexpected disc number";
+ my $path = $path[$i++];
+ if (defined $path && (!defined $old_path || $path ne $old_path))
+ { $st_update_disc->execute($path, $id, $disc); }
+ }
+ $i == $min_ndisc or die "missing disc records";
+
+ $min_ndisc < $old_ndisc and
+ $st_delete_disc_range->execute($id, $min_ndisc, $old_ndisc);
+ }
+
+ for (my $i = $min_ndisc; $i < $ndisc; $i++)
+ { $st_add_disc->execute($id, $i, $path[$i]); }
+
+ $id = undef; @path = ();
+}
+
+LINE: while (<>) {
+ chomp;
+
+ if (/^ \[ \# (\d+ | NEW | UNK) \s* : \s* (\d+ | \* | DEL) ]
+ \s* (\S .*)? $/x) {
+ flush_set;
+
+ ($id, $ndisc, $name) = ($1, $2, $3);
+ if ($ndisc eq "DEL") {
+ $id eq "NEW" || $id eq "UNK" and die "can't delete virtual records";
+ defined $name and die "name `$name' supplied with deletion request";
+ $st_delete_discs->execute($id);
+ $st_delete_set->execute($id);
+ $id = undef;
+ } elsif ($id eq "UNK") {
+ defined $name and die "can't name unknown records";
+ } else {
+ defined $name or die "missing name";
+ }
+ } elsif (/^ \s+ !! \s* (\S .*) $/x) {
+ my $path = $1;
+ defined $id or die "no active set";
+ push @path, undef;
+ } elsif (/^ \s+ (\S .*) $/x) {
+ my $path = $1;
+ defined $id or die "no active set";
+ -f "$ROOT/$path" && ! -l "$ROOT/$path" or die "file `$path' not found";
+ push @path, $path;
+ } elsif (/^ .* \S .* $/) {
+ die "unrecognized line `$_'";
+ }
+}
+
+$DB->commit; $DB->disconnect;