X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=yarrg%2Fdb-idempotent-populate;h=bb0448ce478389c1c030220514c1cdabe648f588;hp=2cce5c73ccfa571a84e597a6a1406d2067774d72;hb=f62749dec2d8b67a9b4b4a910e1159907654d426;hpb=735a20880b0e6c0b5ad2d62f77f2c3afd0d77ad4

diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate
index 2cce5c7..bb0448c 100755
--- a/yarrg/db-idempotent-populate
+++ b/yarrg/db-idempotent-populate
@@ -36,15 +36,17 @@ use DBI;
 use Commods;
 use CommodsDatabase;
 
-my $trace;
-if (@ARGV and $ARGV[0] eq '-D') {
-	$trace=1;
+my $trace=0;
+while (@ARGV and $ARGV[0] eq '-D') {
+	$trace++;
 	shift @ARGV;
 }
 
 @ARGV==1 or die;
 my ($oceanname) = @ARGV;
 
+$|=1;
+
 #---------- setup ----------
 
 parse_info_serverside();
@@ -55,134 +57,70 @@ db_connect();
 
 $dbh->trace(1) if $trace;
 
-#---------- referential integrity constraints ----------
-
-# SQLite doesn't support foreign key constraints so we do it by steam:
 
-sub nooutput ($) {
-    my ($stmts) = @_;
-    my $ekindcount= 0;
-    my $letxt= '';
-    foreach my $stmt (split /\;/, $stmts) {
-	next unless $stmt =~ /\S/;
-
-	my $etxt= '';
-	$stmt =~ s/^([ \t]*\#.*)$/ $etxt .= $1."\n"; ''; /mge;
-	$etxt= $letxt unless length $etxt;
-	$letxt= $etxt;
-	
-	$stmt =~ s/^\s+//; $stmt =~ s/\s+$//;
-	my $sth= $dbh->prepare($stmt);
-	$sth->execute();
-	my $row;
-	my $ecount= 0;
-	my @cols= @{ $sth->{NAME_lc} };
-	my $w= 11;
-	while ($row= $sth->fetchrow_hashref) {
-	    if (!$ecount++) {
-		print STDERR "REFERENTIAL INTEGRITY ERROR\n";
-		print STDERR "\n$etxt\n $stmt\n\n";
-		printf STDERR "|%-${w}s", $_ foreach @cols; print STDERR "|\n";
-		print STDERR "+",('-'x$w)  foreach @cols; print STDERR "+\n";
-	    }
-	    if ($ecount>5) { print STDERR "...\n"; last; }
-	    printf STDERR "|%-$w.${w}s",
-	        (defined $row->{$_} ? $row->{$_} : 'NULL')
-		    foreach @cols;
-	    print STDERR "\n";
-	}
-	next unless $ecount;
-	
-	$ekindcount++;
-	print STDERR "\n\n";
-    }
-    die "REFERENTIAL INTEGRITY ERRORS $ekindcount\n"
-	if $ekindcount;
-}
+#---------- schema update code ----------
 
-sub check_referential_integrity () {
-    foreach my $bs (qw(buy sell)) {
-	nooutput(<<END);
+our @need_compact;
+our @need_transfer_back;
 
- # Every buy/sell must refer to an entry in commods, islands, and stalls:
- SELECT * FROM $bs NATURAL LEFT JOIN commods WHERE commodname IS NULL;
- SELECT * FROM $bs NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM $bs LEFT JOIN STALLS USING (stallid) WHERE stallname IS NULL;
+our %table;
 
- # Every buy/sell must be part of an upload:
- SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
+sub table ($$) {
+    my ($table, $fields) = @_;
+    table_maycompact($table,undef,undef,$fields);
+}
 
- # The islandid in stalls must be the same as the islandid in buy/sell:
- SELECT * FROM $bs JOIN stalls USING (stallid)
-	WHERE $bs.islandid != stalls.islandid;
+sub table_maycompact ($$$$) {
+    my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
 
-END
-    }
-    foreach my $end (qw(aiid biid)) {
-	foreach my $tab (qw(dists routes)) {
-	    nooutput(<<END);
+    #----- parse $fields -----
 
- # Every row in dists and routes must refer to two existing rows in islands:
- SELECT * FROM $tab d LEFT JOIN islands ON (d.$end=islandid)
-	WHERE islandname IS NULL;
+    my @want_fields;
+    my @want_field_specs;
+    my %want_field_specs;
 
-END
+    foreach my $fspec (split /\n/, $fields) {
+	next unless $fspec =~ m/\S/;
+	if ($fspec =~ m/^\s*\+/) {
+	    push @want_field_specs, "\t".$';
+	    next;
+	} elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
+	    my ($f,$spaces,$rhs) = ($1,$2,$3);
+	    my $spec= "\t".$f.$spaces.$rhs;
+	    push @want_fields, $f;
+	    push @want_field_specs, $spec;
+	    $want_field_specs{$f}= $spec;
+	} else {
+	    die "$table $fspec ?";
 	}
     }
-    nooutput(<<END);
-
- # Every pair of islands must have an entry in dists:
- SELECT * FROM islands ia JOIN islands ib LEFT JOIN dists
-	ON (ia.islandid=aiid and ib.islandid=biid)
-	WHERE dist IS NULL;
-
- # Every stall and upload must refer to an island:
- SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
- SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
-
- # Every commod which refers to a commodclass refers to an existing one:
- SELECT * FROM commods WHERE commodclass NOT IN
-	(SELECT commodclass FROM commodclasses);
 
- # There are no empty commodclasses:
- SELECT * FROM commodclasses NATURAL LEFT JOIN commods
-	WHERE commodname IS NULL;
+    my $want_field_specs= join ",\n", @want_field_specs;
 
- # Ordvals which are not zero are unique:
- SELECT ordval,count(*) FROM COMMODS
-	WHERE ordval IS NOT NULL AND ordval != 0
-	GROUP BY ordval
-	HAVING count(*) > 1;
+    #----- ensure table exists -----
 
+    db_doall(<<END);
+ CREATE TABLE IF NOT EXISTS $table (
+$want_field_specs
+	);
 END
-}
-
-sub chkcommit () {
-    check_referential_integrity();
-    $dbh->commit();
-}
+    my @need_recreate;
 
-#---------- schema ----------
+    #----- check whether we need to remove autoinc -----
 
-foreach my $bs (qw(buy sell)) {
-    db_doall(<<END)
- CREATE TABLE IF NOT EXISTS $bs (
-	commodid	INTEGER			NOT NULL,
-	islandid	INTEGER			NOT NULL,
-	stallid		INTEGER			NOT NULL,
-	price		INTEGER			NOT NULL,
-	qty		INTEGER			NOT NULL,
-	PRIMARY KEY (commodid, islandid, stallid)
- );
- CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
- CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
+    if ($fields !~ /\bautoinc/i) {
+	my $autoinc= $dbh->prepare(<<END);
+ SELECT sql FROM sqlite_master
+	WHERE type='table' and name=? and tbl_name=?
 END
-    ;
-}
+        $autoinc->execute($table,$table);
+	my ($sql)= $autoinc->fetchrow_array();
+	die unless defined $sql;
+	push @need_recreate, 'remove autoinc'
+	    if $sql =~ m/\bautoinc/i;
+    }
 
-sub table ($$) {
-    my ($table,$fields) = @_;
-    db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");
+    #----- check whether we need to add fields -----
 
     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
     $check->execute();
@@ -190,183 +128,306 @@ sub table ($$) {
     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
     $check->finish();
 
-    my (@have_fields, @missing_fields);
-    my $have_field_specs='';
+    my @have_fields;
+    my @aside_fields;
+    my @have_field_specs;
+    my @aside_field_specs;
 
-    foreach my $fspec (split /,/, $fields) {
-	next unless $fspec =~ m/\S/;
-	$fspec =~ m/^\s*(\w+)\s+(\w.*\S)\s*$/ or die "$table $fspec ?";
-	my ($f,$spec) = ($1,$2);
+    foreach my $f (@want_fields) {
 	if ($have_fields{$f}) {
 	    push @have_fields, $f;
-	    $have_field_specs .= ",\n" if length $have_field_specs;
-	    $have_field_specs .= "\t$f\t\t$spec\n";
+	    push @have_field_specs, $want_field_specs{$f};
 	} else {
-	    push @missing_fields, $f;
+	    my $aside= $want_field_specs{$f};
+	    $aside =~ s/\bUNIQUE\b//i;
+	    $aside =~ s/\bNOT\s*NULL\b//i;
+	    $aside =~ s/\bPRIMARY\s*KEY\b//i;
+	    $aside =~ s/\s+$//;
+	    push @aside_fields, $f;
+	    push @aside_field_specs, $aside;
+	    push @need_recreate, "field $f";
 	}
     }
 
-    return unless @missing_fields;
-    print "    Adding missing fields to $table: @missing_fields ...\n";
+    #----- Do we need to recreate ? -----
+    if (!@need_recreate) {
+	$table{$table}= $table;
+	return;
+    }
+    #----- Yes, recreate: -----
+
+    print "    Recreating $table: ", join('; ',@need_recreate);
+    $table{$table}= "aside_$table";
 
     my $have_fields= join ',', @have_fields;
+    my $aside_fields= join ',', @have_fields, @aside_fields;
+    my $have_field_specs= join ",\n", @have_field_specs;
+    my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;
 
     db_doall(<<END);
  CREATE TEMPORARY TABLE aside_$table (
-$have_field_specs );
- INSERT INTO aside_$table SELECT $have_fields FROM $table;
+$aside_field_specs
+	);
+ INSERT INTO aside_$table ($have_fields) 
+	SELECT $have_fields FROM $table;
 
  DROP TABLE $table;
+END
+
+    push @need_transfer_back, {
+	Table => $table,
+	Sql => <<END
  CREATE TABLE $table (
-$fields );
+$want_field_specs
+	);
 
- INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
+ INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
 
  DROP TABLE aside_$table;
 END
+    };
+    
+    #----- Do we need to compact ids ? -----
+    (print(".\n"), return) unless
+        defined $cpact_idfield
+	and grep { m/^remove autoinc/ } @need_recreate;
+    # yes:
+
+    print "; will compact.\n";
+    unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
+
+    push @need_compact, {
+	Table => $table,
+	Id => $cpact_idfield,
+	Updates => $cpact_needupdates,
+	Fields => [ @want_fields ],
+	FieldSpecs => $want_field_specs
+	};
 }
 
-table('commods', <<END);
-	commodid	INTEGER	PRIMARY KEY	NOT NULL,
-	commodname	TEXT	UNIQUE		NOT NULL,
-	unitmass	INTEGER,
-	unitvolume	INTEGER,
-	ordval		INTEGER,
-	commodclass	TEXT,
-	inclass		INTEGER
+
+#---------- actual schema ----------
+
+foreach my $bs (qw(buy sell)) {
+    table($bs,<<END);
+	commodid	INTEGER			NOT NULL
+	islandid	INTEGER			NOT NULL
+	stallid		INTEGER			NOT NULL
+	price		INTEGER			NOT NULL
+	qty		INTEGER			NOT NULL
+	+ PRIMARY KEY (commodid, islandid, stallid)
 END
+}
 
-table('commodclasses', <<END);
-	commodclass	TEXT	PRIMARY KEY	NOT NULL,
-	size		INTEGER
+table_maycompact('commods', 'commodid',
+		 [ [ qw(buy sell) ], [ qw(commodid) ],
+ ], <<END);
+	commodid	INTEGER	PRIMARY KEY	NOT NULL
+	commodname	TEXT	UNIQUE		NOT NULL
+	unitmass	INTEGER
+	unitvolume	INTEGER
+	commodclassid	INTEGER			NOT NULL
+	ordval		INTEGER			NOT NULL
+	posinclass	INTEGER			NOT NULL
 END
 
-db_doall(<<END)
- CREATE TABLE IF NOT EXISTS islands (
-	islandid	INTEGER	PRIMARY KEY	NOT NULL,
-	islandname	TEXT	UNIQUE		NOT NULL,
+table_maycompact('islands', 'islandid',
+		 [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ], 
+		   [ qw(dists routes) ], [ qw(aiid biid) ], 
+ ], <<END);
+	islandid	INTEGER	PRIMARY KEY	NOT NULL
+	islandname	TEXT	UNIQUE		NOT NULL
 	archipelago	TEXT			NOT NULL
- );
- CREATE TABLE IF NOT EXISTS stalls (
-	stallid		INTEGER	PRIMARY KEY	NOT NULL,
-	islandid	INTEGER			NOT NULL,
-	stallname	TEXT			NOT NULL,
-	UNIQUE (islandid, stallname)
- );
- CREATE TABLE IF NOT EXISTS uploads (
-	islandid	INTEGER PRIMARY KEY	NOT NULL,
-	timestamp	INTEGER			NOT NULL,
-	message		TEXT			NOT NULL,
-	clientspec	TEXT			NOT NULL,
+END
+
+table('stalls', <<END);
+	stallid		INTEGER	PRIMARY KEY	NOT NULL
+	islandid	INTEGER			NOT NULL
+	stallname	TEXT			NOT NULL
+	+ UNIQUE (islandid, stallname)
+END
+
+table('commodclasses', <<END);
+	commodclassid	INTEGER	PRIMARY KEY	NOT NULL
+	commodclass	TEXT	UNIQUE		NOT NULL
+	maxposinclass	INTEGER			NOT NULL
+END
+
+table('uploads', <<END);
+	islandid	INTEGER PRIMARY KEY	NOT NULL
+	timestamp	INTEGER			NOT NULL
+	message		TEXT			NOT NULL
+	clientspec	TEXT			NOT NULL
 	serverspec	TEXT			NOT NULL
- );
- CREATE TABLE IF NOT EXISTS dists (
-	aiid		INTEGER			NOT NULL,
-	biid		INTEGER			NOT NULL,
-	dist		INTEGER			NOT NULL,
-	PRIMARY KEY (aiid, biid)
- );
- CREATE TABLE IF NOT EXISTS routes (
-	aiid		INTEGER			NOT NULL,
-	biid		INTEGER			NOT NULL,
-	dist		INTEGER			NOT NULL,
-	PRIMARY KEY (aiid, biid)
- );
- CREATE TABLE IF NOT EXISTS vessels (
-	name		TEXT			NOT NULL,
-	mass		INTEGER			NOT NULL,
-	volume		INTEGER			NOT NULL,
-	shot		INTEGER			NOT NULL,
-	PRIMARY KEY (name)
- );
 END
-    ;
 
-chkcommit();
+table('dists', <<END);
+	aiid		INTEGER			NOT NULL
+	biid		INTEGER			NOT NULL
+	dist		INTEGER			NOT NULL
+	+ PRIMARY KEY (aiid, biid)
+END
+
+table('routes', <<END);
+	aiid		INTEGER			NOT NULL
+	biid		INTEGER			NOT NULL
+	dist		INTEGER			NOT NULL
+	+ PRIMARY KEY (aiid, biid)
+END
+
+table('vessels', <<END);
+	name		TEXT			NOT NULL
+	mass		INTEGER			NOT NULL
+	volume		INTEGER			NOT NULL
+	shot		INTEGER			NOT NULL
+	+ PRIMARY KEY (name)
+END
+
 
 #---------- commodity list ----------
 
 sub commodsortkey ($) {
     my ($commod) = @_;
-    my $ordval= $commods{$commod}{Ordval};
-    return sprintf "B %20d", $ordval if defined $ordval;
-    return sprintf "A %s", $commod;
+    return $commods{$commod}{Ordval} ||
+	   $commods{$commod}{ClassOrdval};
+}
+sub commods_ordered () {
+    sort {
+	commodsortkey($a) <=> commodsortkey($b);
+    } keys %commods;
 }
 
+our %posincl;
+
 {
-    my $insert= $dbh->prepare(<<'END')
- INSERT OR IGNORE INTO commods
-     (unitmass,
-      unitvolume,
-      commodname)
-     VALUES (?,?,?);
-END
-    ;
-    my $setsizes= $dbh->prepare(<<'END')
- UPDATE commods
-     SET unitmass = ?,
-         unitvolume = ?
-     WHERE commodname = ?
-END
-    ;
-    my $setordval= $dbh->prepare(<<'END')
- UPDATE commods
-     SET ordval = ?
-     WHERE commodname = ?
+    my %classorderedcount;
+
+    foreach my $cl (keys %commodclasses) {
+	$classorderedcount{$cl}= 0;
+    }
+    foreach my $commod (commods_ordered()) {
+	my $cl= $commods{$commod}{Class};
+	die "no class for commodity $commod" unless defined $cl;
+
+	my $clid= $commodclasses{$cl};
+	die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
+
+	if (defined $commods{$commod}{Ordval}) {
+	    $posincl{$commod}= ++$classorderedcount{$cl};
+	} else {
+	    $posincl{$commod}= 0;
+	}
+    }
+
+    db_doall(<<END);
+ DELETE FROM $table{commodclasses};
 END
-    ;
-    my $setclass= $dbh->prepare(<<'END')
- UPDATE commods
-     SET commodclass = ?
-     WHERE commodname = ?
+    my $addclass= $dbh->prepare(<<END);
+ INSERT INTO $table{commodclasses}
+     (commodclassid, commodclass, maxposinclass)
+     VALUES (?,?,?)
 END
-    ;
-    my $setinclass= $dbh->prepare(<<'END')
- UPDATE commods
-     SET inclass = ?
+    foreach my $cl (sort keys %commodclasses) {
+	my $clname= $cl;
+	$clname =~ s/_/ /g;
+	$addclass->execute($commodclasses{$cl}+1,
+			   ucfirst $clname,
+			   $classorderedcount{$cl});
+    }
+}
+
+{
+    my @valuefields= qw(
+			unitmass
+			unitvolume
+			commodclassid
+			ordval
+			posinclass
+			);
+    my $insert= $dbh->prepare("
+ INSERT OR IGNORE INTO $table{commods}
+      ( commodname,
+	".join(",
+	", @valuefields)." )
+     VALUES (?,".join(',', map {'?'} @valuefields).")
+");
+    my $update= $dbh->prepare("
+ UPDATE $table{commods}
+     SET ".join(",
+	", map { "$_ = ?" } @valuefields)."
      WHERE commodname = ?
-END
-    ;
-    my %incl;
-    foreach my $commod (sort {
-	        commodsortkey($a) cmp commodsortkey($b)
-	    } keys %commods) {
+");
+    foreach my $commod (commods_ordered()) {
 	my $c= $commods{$commod};
         die "no mass for $commod" unless defined $c->{Mass};
         die "no volume for $commod" unless defined $c->{Volume};
 	
-	my @qa= ($c->{Mass}, $c->{Volume}, $commod);
-	$insert->execute(@qa);
-	$setsizes->execute(@qa);
-	$setordval->execute($c->{Ordval} || 0, $commod);
 	my $cl= $c->{Class};
-	$setclass->execute($cl, $commod);
+	my $clid= $commodclasses{$cl}+1;
+
+	my @valuevalues= (
+			  $c->{Mass},
+			  $c->{Volume},
+			  $clid,
+			  commodsortkey($commod),
+			  $posincl{$commod}
+			  );
+	$insert->execute($commod, @valuevalues);
+	$update->execute(@valuevalues, $commod);
+    }
 
-	if (defined $c->{Ordval} and defined $cl) {
-	    $incl{$cl}++;
-	    $setinclass->execute($incl{$cl}, $commod);
-	}
+    my $search= $dbh->prepare(<<END);
+ SELECT commodname,commodid FROM $table{commods};
+END
+    my %check;
+    foreach my $bs (qw(buy sell)) {
+	$check{$bs}= $dbh->prepare(<<END);
+ SELECT islandname,stallname,price,qty
+   FROM $table{$bs}
+   JOIN $table{stalls} USING (stallid)
+   JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
+   WHERE commodid = ? LIMIT 1
+END
     }
-    db_doall(<<END);
- DELETE FROM commodclasses;
+    my $delete= $dbh->prepare(<<END);
+ DELETE FROM $table{commods} WHERE commodid = ?
 END
-    my $addclass= $dbh->prepare(<<'END')
- INSERT INTO commodclasses
-     (commodclass, size)
-     VALUES (?,?)
+    $search->execute();
+    my $any=0;
+    while (my $row= $search->fetchrow_hashref()) {
+	next if defined $commods{$row->{'commodname'}};
+	print $any++ ? '; ' : "    Dropping old commodities: ",
+	      $row->{'commodname'};
+	foreach my $bs (qw(buy sell)) {
+	    $check{$bs}->execute($row->{'commodid'});
+	    my $problem= $check{$bs}->fetchrow_hashref();
+	    if ($problem) {
+		print "\n";
+		die <<END
+
+FATAL ERROR
+    Removed commodity
+       $row->{'commodid'}
+       $row->{'commodname'}
+    but
+       $bs
+       $problem->{'islandname'}
+       $problem->{'stallname'}
+       $problem->{'qty'} at $problem->{'price'}
 END
-    ;
-    foreach my $cl (sort keys %incl) {
-	$addclass->execute($cl, $incl{$cl});	
+            }
+	}
+	$delete->execute($row->{'commodid'});
     }
-    chkcommit();
+    print ".\n" if $any;
 }
 
 #---------- vessel types ----------
 {
-    my $idempotent= $dbh->prepare(<<'END')
- INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
-                         VALUES (?,?,?,?)
+    my $idempotent= $dbh->prepare(<<END)
+ INSERT OR REPLACE INTO $table{vessels}
+	(name, shot, mass, volume)
+	VALUES (?,?,?,?)
 END
     ;
     foreach my $name (sort keys %vessels) {
@@ -377,5 +438,110 @@ END
 	my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
 	$idempotent->execute(@qa);
     }
-    chkcommit();
+}
+
+#---------- transfer data back from any recreated tables ----------
+
+foreach my $tb (@need_transfer_back) {
+    my $tab= $tb->{Table};
+    print "    Retransferring $tab...";
+
+    if (!eval {
+	db_doall($tb->{Sql});
+	1;
+    }) {
+	my $emsg= $@;
+	my $w=20;
+	print STDERR "\n=== $tab retransfer failed, dumping:\n";
+	my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
+	$dumph->execute();
+	my @cols= @{ $dumph->{NAME_lc} };
+	dumptab_head(\*STDERR,$w,\@cols);
+	my $row;
+	while ($row= $dumph->fetchrow_hashref()) {
+	    dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
+	}
+	die "\n$emsg";
+    }
+    print "\n";
+    $table{$tab}= $tab;
+}
+
+#---------- create indices ----------
+
+foreach my $bs (qw(buy sell)) {
+    db_doall(<<END)
+ CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
+ CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
+END
+    ;
+}
+
+db_check_referential_integrity(1);
+
+#---------- compact IDs ----------
+
+sub getminmax ($$$) {
+    my ($tab,$minmax,$f) = @_;
+    my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
+    $sth->execute();
+    my ($val)= $sth->fetchrow_array();
+    return defined($val) ? $val : '?';
+}
+
+foreach my $cp (@need_compact) {
+    print "    Compacting $cp->{Table}";
+    my $tab= $cp->{Table};
+    my $id= $cp->{Id};
+    my $tmp_field_specs= $cp->{FieldSpecs};
+    my $fields= join ',', @{$cp->{Fields}};
+    $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
+	die "$tab $tmp_field_specs ?";
+    db_doall(<<END);
+ CREATE TEMPORARY TABLE idlookup_$tab (
+	new_$id		INTEGER PRIMARY KEY NOT NULL,
+$tmp_field_specs
+ );
+ INSERT INTO idlookup_$tab ($fields)
+	SELECT $fields
+	FROM $tab;
+END
+    my $oldmax= getminmax($tab,'max',$id);
+    my $offset= $oldmax+1;
+    
+    printf(" %s %s..%d=>1..%d:",
+	   $cp->{Id},
+	   getminmax($tab,'min',$id),
+	   $oldmax,
+	   getminmax("idlookup_$tab",'max',"new_$id"));
+    my @updates= @{ $cp->{Updates} };
+    while (@updates) {
+	my $utabs= shift @updates;
+	my $ufields= shift @updates;
+	foreach my $utab (@$utabs) {
+	    printf(" %s",$utab);
+	    my $fh= '.';
+	    foreach my $ufield (@$ufields) {
+		printf("%s%s",$fh,$ufield); $fh=',';
+		db_doall(<<END);
+ UPDATE $utab
+    SET $ufield = $offset +
+        (SELECT new_$id FROM idlookup_$tab
+          WHERE idlookup_$tab.$id = $utab.$ufield);
+ UPDATE $utab
+    SET $ufield = $ufield - $offset;
+END
+            }
+	}
+    }
+    print "\n";
+}
+
+#---------- put it all into effect ----------
+
+db_chkcommit(1);
+
+{
+    local $dbh->{AutoCommit} = 1;
+    $dbh->do('VACUUM');
 }