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 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) 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 = ?");
  40
  41 my ($id, $name, $ndisc) = (undef, undef, -1);
  42 my @path;
  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) = @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); }
  79     }
  80     $i == $min_ndisc or die "missing disc records";
  81
  82     $min_ndisc < $old_ndisc and
  83       $st_delete_disc_range->execute($id, $min_ndisc, $old_ndisc);
  84   }
  85
  86   for (my $i = $min_ndisc; $i < $ndisc; $i++) {
  87     my $box = $box{$path[$i]};
  88     $st_add_disc->execute($id, $i, $path[$i],
  89                           $box eq "#nil" ? undef : $box);
  90   }
  91
  92   $id = undef; @path = (); %box = ();
  93 }
  94
  95 LINE: while (<>) {
  96   chomp;
  97
  98   if (/^ \s* (\; .*)? $/x) {
  99     next LINE;
 100   } elsif (/^ \[ \# (\d+ | NEW | UNK) \s* : \s* (\d+ | \* | DEL) ]
 101               \s* (\S .*)? $/x) {
 102     flush_set;
 103
 104     ($id, $ndisc, $name) = ($1, $2, $3);
 105     if ($ndisc eq "DEL") {
 106       $id eq "NEW" || $id eq "UNK" and die "can't delete virtual records";
 107       defined $name and die "name `$name' supplied with deletion request";
 108       $st_delete_discs->execute($id);
 109       $st_delete_set->execute($id);
 110       $id = undef;
 111     } elsif ($id eq "UNK") {
 112       defined $name and die "can't name unknown records";
 113     } else {
 114       defined $name or die "missing name";
 115     }
 116   } elsif (/^ \s+ (?: !! \s*)? (\S .*) $/x) {
 117     my $path = $1;
 118     defined $id or die "no active set";
 119     push @path, $path; $box{$path} = $curbox;
 120   } else {
 121     die "unrecognized line `$_'";
 122   }
 123 }
 124
 125 $DB->commit; $DB->disconnect;