From 9089113ed14d3a01ebe805ee15bd08705a59f172 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 5 Nov 2009 16:13:52 +0000 Subject: [PATCH] Rework of commodity classes and ordering * Commodity classes in source-info.txt have _'s in not -'s, in case in the future we have classes which actually have _'s. * Table dumping functionality used by referential integrity check error reporter broken out into new functions dumptab_* * Complete rework of the commodclass and ordering schema * Multiple -D options on db-idempotent-populate increase trace level * Table recreation overhauled and improved: - temporary table now contains all columns of intended table (but with NOT NULL, PRIMARY KEY and UNIQUE constraints removed) - copy-back deferred until we have finished updating info; general info update works on the temporary table; this is so we can add a column which is NOT NULL - db-idempotent-update's index creation and first referential integrity check are deferred until after all new data has been incorporated - id compaction temporary table has a different name to the table recreation temporary table just in case of future accidents - table recreation copy-back dumps the entire data for the temporary table if the copy-back insert fails - all table creation in schema setup is done with table() - index creation is deferred until * Fix bugs in commodity class system --- yarrg/Commods.pm | 7 +- yarrg/CommodsDatabase.pm | 56 ++++-- yarrg/db-idempotent-populate | 330 ++++++++++++++++++++++------------- yarrg/source-info.txt | 32 ++-- 4 files changed, 266 insertions(+), 159 deletions(-) diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index b7b18a6..9178112 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -102,7 +102,7 @@ my %colours; # eg $colours{'c'}{'black'}= $sources my (@rawcm, @nocm); # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth' my %colour_ordvals; # $colour_ordvals{'c'}{'green'}= '30'; -my %commodclasses; # $commodclasses{'dye'}= '3'; +our %commodclasses; # $commodclasses{'dye'}= '3'; # IMPORTANT # when extending the format of source-info in a non-backward @@ -137,7 +137,7 @@ sub parse_info1 ($$$) { @ctx= (sub { push @nocm, lc $_; }); } elsif (m/^commodclasses$/) { @ctx= (sub { - die unless m/^\*([-a-z]+)$/; + die unless m/^\*([_a-z]+)$/; $commodclasses{$1}= scalar keys %commodclasses; }); } elsif (m/^ocean (\w+)$/) { @@ -213,7 +213,7 @@ sub parse_info1 ($$$) { $c->{Mass}= $1 * ($2 ? 1000 : 1); } elsif ($prop =~ m/^([1-9]\d*)l$/) { $c->{Volume}= $1 * 1000; - } elsif ($prop =~ m/^\*([-a-z]+)$/) { + } elsif ($prop =~ m/^\*([_a-z]+)$/) { $c->{Class}= $1; die "$1" unless exists $commodclasses{$1}; $ordclassval= 1e7 + $commodclasses{$1} * 1e7; @@ -224,6 +224,7 @@ sub parse_info1 ($$$) { die "unknown property $prop for $ucname"; } } + $c->{ClassOrdval}= $ordclassval; if (defined $ordbase && defined $ordval && defined $ordclassval) { my $ordvalout= $ordbase + $ordval + $ordclassval; $c->{Ordval}= $ordvalout; diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm index d978358..e14c0eb 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; @@ -205,20 +218,35 @@ END 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 } diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index aa80262..691f77b 100755 --- a/yarrg/db-idempotent-populate +++ b/yarrg/db-idempotent-populate @@ -36,9 +36,9 @@ 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; } @@ -61,6 +61,9 @@ $dbh->trace(1) if $trace; #---------- schema update code ---------- our @need_compact; +our @need_transfer_back; + +our %table; sub table ($$) { my ($table, $fields) = @_; @@ -126,44 +129,66 @@ END $check->finish(); my @have_fields; + my @aside_fields; my @have_field_specs; + my @aside_field_specs; foreach my $f (@want_fields) { if ($have_fields{$f}) { push @have_fields, $f; push @have_field_specs, $want_field_specs{$f}; } else { + 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"; } } #----- Do we need to recreate ? ----- - return unless @need_recreate; - # yes: + 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(< $table, + Sql => < 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(<prepare(<<'END'); - UPDATE commods - SET commodclass = ? - WHERE commodname = ? + my $addclass= $dbh->prepare(<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); - - if (defined $c->{Ordval} and defined $cl) { - $incl{$cl}++; - $setinclass->execute($incl{$cl}, $commod); - } elsif (defined $cl) { - $incl{$cl} += 0; - } - } - db_doall(<prepare(<<'END'); - INSERT INTO commodclasses - (commodclass, size) - VALUES (?,?) -END - foreach my $cl (sort keys %incl) { - $addclass->execute($cl, $incl{$cl}); + my $clid= $commodclasses{$cl}+1; + + my @valuevalues= ( + $c->{Mass}, + $c->{Volume}, + $clid, + commodsortkey($commod), + $posincl{$commod} + ); + $insert->execute($commod, @valuevalues); + $update->execute(@valuevalues, $commod); } - my $search= $dbh->prepare(<<'END'); - SELECT commodname,commodid FROM commods; + my $search= $dbh->prepare(<prepare(<prepare(<<'END'); - DELETE FROM commods WHERE commodid = ? + my $delete= $dbh->prepare(<execute(); my $any=0; @@ -379,15 +420,14 @@ END $delete->execute($row->{'commodid'}); } print ".\n" if $any; - db_check_referential_integrity(); } - #---------- vessel types ---------- { - my $idempotent= $dbh->prepare(<<'END') - INSERT OR REPLACE INTO vessels (name, shot, mass, volume) - VALUES (?,?,?,?) + my $idempotent= $dbh->prepare(<{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(<{Id}, getminmax($tab,'min',$id), $oldmax, - getminmax("aside_$tab",'max',"new_$id")); + getminmax("idlookup_$tab",'max',"new_$id")); my @updates= @{ $cp->{Updates} }; while (@updates) { my $utabs= shift @updates; @@ -448,8 +526,8 @@ END db_doall(<