chiark - git - mdw - dvddb/blob - update

   1 #! /usr/bin/perl -w
   2
   3 use open ":utf8";
   4 use strict;
   5
   6 use DBI;
   7
   8 BEGIN {
   9   binmode STDIN, ":utf8";
  10   binmode STDOUT, ":utf8";
  11   binmode STDERR, ":utf8";
  12 }
  13
  14 my $ROOT = "/mnt/dvd/archive";
  15 my $DB = DBI->connect("dbi:Pg:host=roadstar", "", "",
  16                       { AutoCommit => 0,
  17                         RaiseError => 1 });
  18
  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 = ?");
  26
  27 my $st_get_discs = $DB->prepare
  28   ("SELECT disc, path, box FROM dvd_disc
  29     WHERE set_id = ? AND ? <= disc AND disc < ?
  30     ORDER BY disc");
  31 my $st_add_disc = $DB->prepare
  32   ("INSERT INTO dvd_disc (set_id, disc, path, box) VALUES (?, ?, ?, ?)");
  33 my $st_update_disc = $DB->prepare
  34   ("UPDATE dvd_disc SET path = ?, box = ? WHERE set_id = ? AND disc = ?");
  35 my $st_delete_disc_range = $DB->prepare
  36   ("DELETE FROM dvd_disc WHERE set_id = ? AND ? <= disc AND disc < ?");
  37 my $st_delete_discs = $DB->prepare
  38   ("DELETE FROM dvd_disc WHERE set_id = ?");
  39
  40 my ($id, $name, $ndisc) = (undef, undef, -1);
  41 my @path;
  42 my %box;
  43
  44 sub flush_set () {
  45   defined $id or return;
  46
  47   ##print ";; flush set: #$id: $ndisc\n";
  48   ##for my $p (@path) { print ";;\t$p\n"; }
  49
  50   if ($ndisc eq "*") { $ndisc = @path; }
  51   elsif (@path != $ndisc)
  52     { die sprintf "wrong number of discs %d /= %d", scalar @path, $ndisc; }
  53
  54   my $min_ndisc;
  55   if ($id eq "UNK") {
  56     $id = undef; @path = ();
  57     return;
  58   } elsif ($id eq "NEW") {
  59     $st_add_set->execute($name, $ndisc);
  60     ($id) = $st_add_set->fetchrow_array; $st_add_set->finish;
  61     $min_ndisc = 0;
  62   } else {
  63     $st_get_set->execute($id);
  64     my ($old_name, $old_ndisc) = $st_get_set->fetchrow_array;
  65     $st_get_set->finish;
  66     $name ne $old_name || $ndisc ne $old_ndisc and
  67       $st_update_set->execute($name, $ndisc, $id);
  68
  69     $min_ndisc = $ndisc < $old_ndisc ? $ndisc : $old_ndisc;
  70     $st_get_discs->execute($id, 0, $min_ndisc);
  71     my $i = 0;
  72     DISC: for (;;) {
  73       my @r = $st_get_discs->fetchrow_array; last DISC unless @r;
  74       my ($disc, $old_path, $old_box) = @r; $old_box //= "#nil";
  75       $disc == $i or die "unexpected disc number";
  76       my $path = $path[$i++]; my $box = $box{$path};
  77       if (defined $path &&
  78           (!defined $old_path || $path ne $old_path || $old_box ne $box)) {
  79         $st_update_disc->execute($path, $box eq "#nil" ? undef : $box,
  80                                  $id, $disc);
  81       }
  82     }
  83     $i == $min_ndisc or die "missing disc records";
  84
  85     $min_ndisc < $old_ndisc and
  86       $st_delete_disc_range->execute($id, $min_ndisc, $old_ndisc);
  87   }
  88
  89   for (my $i = $min_ndisc; $i < $ndisc; $i++) {
  90     my $box = $box{$path[$i]};
  91     $st_add_disc->execute($id, $i, $path[$i],
  92                           $box eq "#nil" ? undef : $box);
  93   }
  94
  95   $id = undef; @path = (); %box = ();
  96 }
  97
  98 my $curbox = "#nil";
  99 LINE: while (<>) {
 100   chomp;
 101
 102   if (/^ \s* (\; .*)? $/x) {
 103     next LINE;
 104   } elsif (/^ \[ \# (\d+ | NEW | UNK) \s* : \s* (\d+ | \* | DEL) ]
 105               \s* (\S .*)? $/x) {
 106     flush_set;
 107
 108     ($id, $ndisc, $name) = ($1, $2, $3);
 109     if ($ndisc eq "DEL") {
 110       $id eq "NEW" || $id eq "UNK" and die "can't delete virtual records";
 111       defined $name and die "name `$name' supplied with deletion request";
 112       $st_delete_discs->execute($id);
 113       $st_delete_set->execute($id);
 114       $id = undef;
 115     } elsif ($id eq "UNK") {
 116       defined $name and die "can't name unknown records";
 117     } else {
 118       defined $name or die "missing name";
 119     }
 120   } elsif (/^ \s* \! \s* box \s+ (\S .*) $/x) {
 121     $curbox = $1;
 122   } elsif (/^ \s+ (?: !! \s*)? (\S .*) $/x) {
 123     my $path = $1;
 124     defined $id or die "no active set";
 125     push @path, $path; $box{$path} = $curbox;
 126   } else {
 127     die "unrecognized line `$_'";
 128   }
 129 }
 130
 131 flush_set;
 132 $DB->commit; $DB->disconnect;