$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)) {
END
;
-chkcommit();
+db_chkcommit();
#---------- commodity list ----------
if (defined $c->{Ordval} and defined $cl) {
$incl{$cl}++;
$setinclass->execute($incl{$cl}, $commod);
+ } elsif (defined $cl) {
+ $incl{$cl} += 0;
}
}
db_doall(<<END);
foreach my $cl (sort keys %incl) {
$addclass->execute($cl, $incl{$cl});
}
- chkcommit();
+ db_chkcommit();
}
#---------- vessel types ----------
my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
$idempotent->execute(@qa);
}
- chkcommit();
+ db_chkcommit();
}