#! /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, n_disc FROM dvd_set WHERE id = ?"); my $st_add_set = $DB->prepare ("INSERT INTO dvd_set (name, n_disc) VALUES (?, ?) RETURNING id"); my $st_update_set = $DB->prepare ("UPDATE dvd_set SET name = ?, n_disc = ? 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 = ?, disc_id = NULL 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, $path; } elsif (/^ .* \S .* $/) { die "unrecognized line `$_'"; } } $DB->commit; $DB->disconnect;