use Commods;
use CommodsDatabase;
+my $trace;
+if (@ARGV and $ARGV[0] eq '-D') {
+ $trace=1;
+ shift @ARGV;
+}
+
@ARGV==1 or die;
my ($oceanname) = @ARGV;
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)) {
;
}
-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)
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
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);
+ $setsizes->execute(@qa);
+ $setordval->execute($c->{Ordval} || 0, $commod);
+ my $cl= $c->{Class};
+ $setclass->execute($cl, $commod);
+
+ 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 $cl (sort keys %incl) {
+ $addclass->execute($cl, $incl{$cl});
}
- $dbh->commit;
+ chkcommit();
}
#---------- vessel types ----------
my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
$idempotent->execute(@qa);
}
- $dbh->commit;
+ chkcommit();
}
~yarrgweb / ypp-sc-tools.db-live.git / blobdiff