X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2FCommodsDatabase.pm;h=3cb543dc43b3866971cff2cb28e39de7f6061631;hp=6ed0b742f6d3d3f2d9d00c78515de2cb6bc327b6;hb=7f235a4d62c9e1c0d042a65542ff49fb121429cc;hpb=84acb589eaec42201d8488eb909e5a6e262ff149

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 6ed0b74..3cb543d 100644
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -46,6 +46,7 @@ BEGIN {
     @EXPORT      = qw(&db_setocean &db_writer &db_connect $dbh
 		      &db_filename &db_doall &db_onconflict
 		      &dbr_filename &dbr_connect &db_connect_core
+		      &dumptab_head &dumptab_row_hashref
 		      &db_chkcommit &db_check_referential_integrity);
     %EXPORT_TAGS = ( );
 
@@ -120,6 +121,22 @@ sub db_doall ($) {
     }
 }
 
+#---------- table dump helper ----------
+
+sub dumptab_head ($$$) {
+    my ($fh,$w,$cols) = @_;
+    printf $fh "|%-${w}s", $_ foreach @$cols;  print $fh "|\n";
+    print $fh "+",('-'x$w)  foreach @$cols;    print $fh "+\n";
+}
+
+sub dumptab_row_hashref ($$$$) {
+    my ($fh,$w,$cols,$row) = @_;
+    printf $fh "|%-$w.${w}s",
+	   (defined $row->{$_} ? $row->{$_} : 'NULL')
+	foreach @$cols;
+    print $fh "\n";
+}
+
 #---------- referential integrity constraints ----------
 
 # SQLite doesn't support foreign key constraints so we do it by steam:
@@ -147,14 +164,10 @@ sub nooutput ($) {
 	    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";
+		dumptab_head(\*STDERR,$w,\@cols);
 	    }
 	    if ($ecount>5) { print STDERR "...\n"; last; }
-	    printf STDERR "|%-$w.${w}s",
-	        (defined $row->{$_} ? $row->{$_} : 'NULL')
-		    foreach @cols;
-	    print STDERR "\n";
+	    dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
 	}
 	next unless $ecount;
 	
@@ -165,7 +178,12 @@ sub nooutput ($) {
 	if $ekindcount;
 }
 
-sub db_check_referential_integrity () {
+sub db_check_referential_integrity ($) {
+    my ($full) = @_;
+    # non-full is done only for market data updates; it avoids
+    # detecting errors which are essentially missing metadata and
+    # old schemas, etc.
+
     foreach my $bs (qw(buy sell)) {
 	nooutput(<<END);
 
@@ -183,47 +201,69 @@ sub db_check_referential_integrity () {
 
 END
     }
-    foreach my $end (qw(aiid biid)) {
-	foreach my $tab (qw(dists routes)) {
-	    nooutput(<<END);
+
+    nooutput(<<END);
+
+ # 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;
+
+END
+    if ($full) {
+	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)
+ SELECT * FROM $tab d LEFT JOIN islands ON d.$end=islandid
 	WHERE islandname IS NULL;
 
 END
+	    }
 	}
-    }
-    nooutput(<<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)
+	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:
+ # Every commod must refers to a commodclass and vice versa:
+ SELECT * FROM commods NATURAL LEFT JOIN commodclasses
+	WHERE commodclass IS NULL;
  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
+ # Ordvals which are not commodclass ordvals are unique:
+ SELECT ordval,count(*),commodname,commodid,posinclass
+	FROM commods
+	WHERE posinclass > 0
 	GROUP BY ordval
 	HAVING count(*) > 1;
 
+ # For every class, posinclass is dense from 1 to maxposinclass,
+ # apart from the commods for which it is zero.
+ SELECT commodclass,commodclassid,posinclass,count(*)
+	FROM commods NATURAL JOIN commodclasses
+	WHERE posinclass > 0
+	GROUP BY commodclassid,posinclass
+	HAVING count(*) > 1;
+ SELECT commodclass,commodclassid,count(*)
+	FROM commods NATURAL JOIN commodclasses
+	WHERE posinclass > 0
+	GROUP BY commodclassid
+	HAVING count(*) != maxposinclass;
+ SELECT *
+	FROM commods NATURAL JOIN commodclasses
+	WHERE posinclass < 0 OR posinclass > maxposinclass;
+
 END
+    }
 }
 
-sub db_chkcommit () {
-    db_check_referential_integrity();
+sub db_chkcommit ($) {
+    my ($full) = @_;
+    db_check_referential_integrity($full);
     $dbh->commit();
 }