pldb (list): Add `-w' option to show a window around the group position(s).

[dvddb] / update

#! /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;