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

diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate
index 9d7bab0..2cce5c7 100755
--- a/yarrg/db-idempotent-populate
+++ b/yarrg/db-idempotent-populate
@@ -1,25 +1,28 @@
 #!/usr/bin/perl -w
 #
+# Normally run from
+#  update-master-info
+#
 # usage: ./db-idempotent-populate <Oceanname>
 #  creates or updates OCEAN-Oceanname.db
-#  from master-master.txt
+#  from source-info.txt
 
-# This is part of ypp-sc-tools, a set of third-party tools for assisting
-# players of Yohoho Puzzle Pirates.
+# This is part of the YARRG website.  YARRG is a tool and website
+# for assisting players of Yohoho Puzzle Pirates.
 #
 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
 #
 # This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
+# it under the terms of the GNU Affero General Public License as
+# published by the Free Software Foundation, either version 3 of the
+# License, or (at your option) any later version.
 #
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# GNU Affero General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License
+# You should have received a copy of the GNU Affero General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #
 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
@@ -33,19 +36,132 @@ use DBI;
 use Commods;
 use CommodsDatabase;
 
+my $trace;
+if (@ARGV and $ARGV[0] eq '-D') {
+	$trace=1;
+	shift @ARGV;
+}
+
 @ARGV==1 or die;
 my ($oceanname) = @ARGV;
 
 #---------- setup ----------
 
 parse_info_serverside();
-parse_info_serverside_ocean($oceanname);
-our $ocean= $oceans{$oceanname};
 
 db_setocean($oceanname);
 db_writer();
 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;
+}
+
+sub check_referential_integrity () {
+    foreach my $bs (qw(buy sell)) {
+	nooutput(<<END);
+
+ # 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;
+
+ # Every buy/sell must be part of an upload:
+ SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
+
+ # 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;
+
+END
+    }
+    foreach my $end (qw(aiid biid)) {
+	foreach my $tab (qw(dists routes)) {
+	    nooutput(<<END);
+
+ # 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;
+
+END
+	}
+    }
+    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;
+
+ # 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;
+
+END
+}
+
+sub chkcommit () {
+    check_referential_integrity();
+    $dbh->commit();
+}
+
 #---------- schema ----------
 
 foreach my $bs (qw(buy sell)) {
@@ -64,20 +180,75 @@ END
     ;
 }
 
-db_doall(<<END)
- CREATE TABLE IF NOT EXISTS commods (
-	commodid	INTEGER	PRIMARY KEY AUTOINCREMENT NOT NULL,
+sub table ($$) {
+    my ($table,$fields) = @_;
+    db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");
+
+    my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
+    $check->execute();
+    my %have_fields;
+    $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
+    $check->finish();
+
+    my (@have_fields, @missing_fields);
+    my $have_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);
+	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";
+	} else {
+	    push @missing_fields, $f;
+	}
+    }
+
+    return unless @missing_fields;
+    print "    Adding missing fields to $table: @missing_fields ...\n";
+
+    my $have_fields= join ',', @have_fields;
+
+    db_doall(<<END);
+ CREATE TEMPORARY TABLE aside_$table (
+$have_field_specs );
+ INSERT INTO aside_$table SELECT $have_fields FROM $table;
+
+ DROP TABLE $table;
+ CREATE TABLE $table (
+$fields );
+
+ INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
+
+ DROP TABLE aside_$table;
+END
+}
+
+table('commods', <<END);
+	commodid	INTEGER	PRIMARY KEY	NOT NULL,
 	commodname	TEXT	UNIQUE		NOT NULL,
 	unitmass	INTEGER,
-	unitvolume	INTEGER
- );
+	unitvolume	INTEGER,
+	ordval		INTEGER,
+	commodclass	TEXT,
+	inclass		INTEGER
+END
+
+table('commodclasses', <<END);
+	commodclass	TEXT	PRIMARY KEY	NOT NULL,
+	size		INTEGER
+END
+
+db_doall(<<END)
  CREATE TABLE IF NOT EXISTS islands (
-	islandid	INTEGER	PRIMARY KEY AUTOINCREMENT NOT NULL,
+	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 AUTOINCREMENT NOT NULL,
+	stallid		INTEGER	PRIMARY KEY	NOT NULL,
 	islandid	INTEGER			NOT NULL,
 	stallname	TEXT			NOT NULL,
 	UNIQUE (islandid, stallname)
@@ -95,13 +266,33 @@ db_doall(<<END)
 	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
     ;
 
-$dbh->commit;
+chkcommit();
 
 #---------- commodity list ----------
 
+sub commodsortkey ($) {
+    my ($commod) = @_;
+    my $ordval= $commods{$commod}{Ordval};
+    return sprintf "B %20d", $ordval if defined $ordval;
+    return sprintf "A %s", $commod;
+}
+
 {
     my $insert= $dbh->prepare(<<'END')
  INSERT OR IGNORE INTO commods
@@ -111,120 +302,80 @@ $dbh->commit;
      VALUES (?,?,?);
 END
     ;
-    my $update= $dbh->prepare(<<'END')
+    my $setsizes= $dbh->prepare(<<'END')
  UPDATE commods
      SET unitmass = ?,
          unitvolume = ?
      WHERE commodname = ?
 END
     ;
-    foreach my $commod (sort keys %commods) {
+    my $setordval= $dbh->prepare(<<'END')
+ UPDATE commods
+     SET ordval = ?
+     WHERE commodname = ?
+END
+    ;
+    my $setclass= $dbh->prepare(<<'END')
+ UPDATE commods
+     SET commodclass = ?
+     WHERE commodname = ?
+END
+    ;
+    my $setinclass= $dbh->prepare(<<'END')
+ UPDATE commods
+     SET inclass = ?
+     WHERE commodname = ?
+END
+    ;
+    my %incl;
+    foreach my $commod (sort {
+	        commodsortkey($a) cmp commodsortkey($b)
+	    } keys %commods) {
 	my $c= $commods{$commod};
         die "no mass for $commod" unless defined $c->{Mass};
-        die "no colume for $commod" unless defined $c->{Volume};
+        die "no volume for $commod" unless defined $c->{Volume};
+	
 	my @qa= ($c->{Mass}, $c->{Volume}, $commod);
 	$insert->execute(@qa);
-	$update->execute(@qa);
-    }
-    $dbh->commit;
-}
-
-#---------- island list ----------
+	$setsizes->execute(@qa);
+	$setordval->execute($c->{Ordval} || 0, $commod);
+	my $cl= $c->{Class};
+	$setclass->execute($cl, $commod);
 
-{
-    my $sth= $dbh->prepare(<<'END')
- INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
+	if (defined $c->{Ordval} and defined $cl) {
+	    $incl{$cl}++;
+	    $setinclass->execute($incl{$cl}, $commod);
+	}
+    }
+    db_doall(<<END);
+ DELETE FROM commodclasses;
+END
+    my $addclass= $dbh->prepare(<<'END')
+ INSERT INTO commodclasses
+     (commodclass, size)
+     VALUES (?,?)
 END
     ;
-    foreach my $archname (sort keys %$ocean) {
-	my $arch= $ocean->{$archname};
-	foreach my $islandname (sort keys %$arch) {
-	    $sth->execute($islandname, $archname);
-	}
+    foreach my $cl (sort keys %incl) {
+	$addclass->execute($cl, $incl{$cl});	
     }
-    $dbh->commit;
+    chkcommit();
 }
 
-#---------- routes ----------
-
+#---------- vessel types ----------
 {
-    foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
-	warn "$route_mysteries{$oceanname}{$islandname} routes".
-	    " for unknown island $islandname\n";
-    }
-
-    my $allroutes= $routes{$oceanname};
-
-    my @propqueue= ();
-
-    sub distance_set_propagate ($$$$) {
-	my ($lev, $start, $upto, $start2upto) = @_;
-	$allroutes->{$start}{$upto}= $start2upto;
-	push @propqueue, [ $lev, $start, $upto ];
-    }
-
-    sub distance_propagate_now {
-	my ($lev, $start, $upto) = @_;
-	my $startref= $allroutes->{$start};
-	my $start2upto= $startref->{$upto};
-	my $uptoref=  $allroutes->{$upto};
-
-	for my $next (keys %$uptoref) {
-	    next if $next eq $upto;
-	    my $unext= $uptoref->{$next};
-	    next unless defined $unext;
-	    distance_update("${lev}p", $start, $next, $start2upto + $unext);
-	}
-    }
-
-    sub distance_update ($$$$) {
-	my ($lev, $x, $y, $newdist) = @_;
-	distance_update_one("${lev}x",$x,$y,$newdist);
-	distance_update_one("${lev}y",$y,$x,$newdist);
-    }
-
-    sub distance_update_one ($$$$) {
-	my ($lev, $x, $y, $newdist) = @_;
-	my $xref= $allroutes->{$x};
-	my $currently= $xref->{$y};
-	return if defined($currently) and $currently <= $newdist;
-	distance_set_propagate("${lev}o",$x,$y,$newdist);
-    }
-
-    foreach my $xn (keys %$allroutes) {
-	my $routes= $allroutes->{$xn};
-	distance_set_propagate('0', $xn, $xn, 0);
-	foreach my $yn (keys %$routes) {
-	    distance_set_propagate('0', $yn, $yn, 0);
-	    distance_set_propagate('X', $xn, $yn, $routes->{$yn});
-	    distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
-	}
-    }
-    my $ref;
-    while ($ref= shift @propqueue) {
-	distance_propagate_now(@$ref);
-    }
-
-    db_doall(<<END)
- DELETE FROM dists;
+    my $idempotent= $dbh->prepare(<<'END')
+ INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
+                         VALUES (?,?,?,?)
 END
     ;
-    my $sth= $dbh->prepare(<<'END')
- INSERT INTO dists VALUES
-	((SELECT islandid FROM islands WHERE islandname == ?),
-	 (SELECT islandid FROM islands WHERE islandname == ?),
-	 ?);
-END
-    ;
-    foreach my $xn (keys %$allroutes) {
-	my $routes= $allroutes->{$xn};
-	foreach my $yn (keys %$routes) {
-	    $sth->execute($xn, $yn, $routes->{$yn});
-	}
+    foreach my $name (sort keys %vessels) {
+	my $v= $vessels{$name};
+	my $shotdamage= $shotname2damage{$v->{Shot}};
+	die "no shot damage for shot $v->{Shot} for vessel $name"
+	    unless defined $shotdamage;
+	my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
+	$idempotent->execute(@qa);
     }
-    $dbh->commit();
-
-    # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname;
+    chkcommit();
 }
-
-__DATA__