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=eb1a30b43a581047e330b4f226670083366e3fb0;hp=80ded466aefeb4ab89899fae5218dd7da2537e72;hb=a1d85248991a3b50783608d8d2ae35b4be29e82a;hpb=fceed60843f6a7c037b908eb529b542ad263c500 diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index 80ded46..eb1a30b 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 # 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 # # 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 . # # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and @@ -33,196 +36,515 @@ use DBI; use Commods; use CommodsDatabase; +my $trace=0; +while (@ARGV and $ARGV[0] eq '-D') { + $trace++; + shift @ARGV; +} + @ARGV==1 or die; my ($oceanname) = @ARGV; +$|=1; + #---------- setup ---------- parse_info_serverside(); -parse_info_serverside_ocean($oceanname); -our $ocean= $oceans{$oceanname}; db_setocean($oceanname); db_writer(); db_connect(); -#---------- schema ---------- +$dbh->trace(1) if $trace; + + +#---------- schema update code ---------- + +our @need_compact; +our @need_transfer_back; + +our %table; + +sub table ($$) { + my ($table, $fields) = @_; + table_maycompact($table,undef,undef,$fields); +} + +sub table_maycompact ($$$$) { + my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_; + + #----- parse $fields ----- + + my @want_fields; + my @want_field_specs; + my %want_field_specs; + + foreach my $fspec (split /\n/, $fields) { + next unless $fspec =~ m/\S/; + if ($fspec =~ m/^\s*\+/) { + push @want_field_specs, "\t".$'; + next; + } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) { + my ($f,$spaces,$rhs) = ($1,$2,$3); + my $spec= "\t".$f.$spaces.$rhs; + push @want_fields, $f; + push @want_field_specs, $spec; + $want_field_specs{$f}= $spec; + } else { + die "$table $fspec ?"; + } + } + + my $want_field_specs= join ",\n", @want_field_specs; + + #----- ensure table exists ----- + + db_doall(<prepare(<execute($table,$table); + my ($sql)= $autoinc->fetchrow_array(); + die unless defined $sql; + push @need_recreate, 'remove autoinc' + if $sql =~ m/\bautoinc/i; + } + + #----- check whether we need to add 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; + 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 ? ----- + 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 => < $table, + Id => $cpact_idfield, + Updates => $cpact_needupdates, + Fields => [ @want_fields ], + FieldSpecs => $want_field_specs + }; +} + + +#---------- actual schema ---------- foreach my $bs (qw(buy sell)) { - db_doall(<commit; +table('stalls', <prepare(<<'END') - INSERT OR IGNORE INTO commods - (unitmass, - unitvolume, - commodname) - VALUES (?,?,?); +table('uploads', <prepare(<<'END') - UPDATE commods - SET unitmass = ?, - unitvolume = ? - WHERE commodname = ? + +table('dists', <{Mass}, $c->{Volume}, $commod); - $insert->execute(@qa); - $update->execute(@qa); - } - $dbh->commit; -} -#---------- island list ---------- +table('routes', <prepare(<<'END') - INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?); +table('vessels', <{$archname}; - foreach my $islandname (sort keys %$arch) { - $sth->execute($islandname, $archname); - } - } - $dbh->commit; + + +#---------- commodity list ---------- + +sub commodsortkey ($) { + my ($commod) = @_; + return $commods{$commod}{Ordval} || + $commods{$commod}{ClassOrdval}; +} +sub commods_ordered () { + sort { + commodsortkey($a) <=> commodsortkey($b); + } keys %commods; } -#---------- routes ---------- +our %posincl; { - foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { - warn "$route_mysteries{$oceanname}{$islandname} routes". - " for unknown island $islandname\n"; - } + my %classorderedcount; - my $allroutes= $routes{$oceanname}; + 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 @propqueue= (); + my $clid= $commodclasses{$cl}; + die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid; - sub distance_set_propagate ($$$$) { - my ($lev, $start, $upto, $start2upto) = @_; - $allroutes->{$start}{$upto}= $start2upto; - push @propqueue, [ $lev, $start, $upto ]; + if (defined $commods{$commod}{Ordval}) { + $posincl{$commod}= ++$classorderedcount{$cl}; + } else { + $posincl{$commod}= 0; + } } - 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); - } + db_doall(<prepare(<execute($commodclasses{$cl}+1, + ucfirst $clname, + $classorderedcount{$cl}); } +} + +{ + my @valuefields= qw( + unitmass + unitvolume + commodclassid + ordval + posinclass + flags + ); + 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 = ? +"); + 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 $cl= $c->{Class}; + my $clid= $commodclasses{$cl}+1; - sub distance_update ($$$$) { - my ($lev, $x, $y, $newdist) = @_; - distance_update_one("${lev}x",$x,$y,$newdist); - distance_update_one("${lev}y",$y,$x,$newdist); + my @valuevalues= ( + $c->{Mass}, + $c->{Volume}, + $clid, + commodsortkey($commod), + $posincl{$commod}, + $c->{Flags} + ); + $insert->execute($commod, @valuevalues); + $update->execute(@valuevalues, $commod); } - 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); + my $search= $dbh->prepare(<prepare(<prepare(<execute(); + my $any=0; + while (my $row= $search->fetchrow_hashref()) { + next if defined $commods{$row->{'commodname'}}; + print $any++ ? '; ' : " Dropping old commodities: ", + $row->{'commodname'}; + foreach my $bs (qw(buy sell)) { + $check{$bs}->execute($row->{'commodid'}); + my $problem= $check{$bs}->fetchrow_hashref(); + if ($problem) { + print "\n"; + die <{$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}); +FATAL ERROR + Removed commodity + $row->{'commodid'} + $row->{'commodname'} + but + $bs + $problem->{'islandname'} + $problem->{'stallname'} + $problem->{'qty'} at $problem->{'price'} +END + } } + $delete->execute($row->{'commodid'}); + } + print ".\n" if $any; +} + +#---------- vessel types ---------- +{ + my $idempotent= $dbh->prepare(<{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); } - my $ref; - while ($ref= shift @propqueue) { - distance_propagate_now(@$ref); +} + +#---------- transfer data back from any recreated tables ---------- + +foreach my $tb (@need_transfer_back) { + my $tab= $tb->{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(<prepare(<<'END') - INSERT INTO dists VALUES - ((SELECT islandid FROM islands WHERE islandname == ?), - (SELECT islandid FROM islands WHERE islandname == ?), - ?); +} + +db_check_referential_integrity(1); + +#---------- compact IDs ---------- + +sub getminmax ($$$) { + my ($tab,$minmax,$f) = @_; + my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab"); + $sth->execute(); + my ($val)= $sth->fetchrow_array(); + return defined($val) ? $val : '?'; +} + +foreach my $cp (@need_compact) { + print " Compacting $cp->{Table}"; + my $tab= $cp->{Table}; + my $id= $cp->{Id}; + my $tmp_field_specs= $cp->{FieldSpecs}; + my $fields= join ',', @{$cp->{Fields}}; + $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or + die "$tab $tmp_field_specs ?"; + db_doall(<{$xn}; - foreach my $yn (keys %$routes) { - $sth->execute($xn, $yn, $routes->{$yn}); + my $oldmax= getminmax($tab,'max',$id); + my $offset= $oldmax+1; + + printf(" %s %s..%d=>1..%d:", + $cp->{Id}, + getminmax($tab,'min',$id), + $oldmax, + getminmax("idlookup_$tab",'max',"new_$id")); + my @updates= @{ $cp->{Updates} }; + while (@updates) { + my $utabs= shift @updates; + my $ufields= shift @updates; + foreach my $utab (@$utabs) { + printf(" %s",$utab); + my $fh= '.'; + foreach my $ufield (@$ufields) { + printf("%s%s",$fh,$ufield); $fh=','; + db_doall(<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; + print "\n"; } -__DATA__ +#---------- put it all into effect ---------- + +db_chkcommit(1); + +{ + local $dbh->{AutoCommit} = 1; + $dbh->do('VACUUM'); +}