X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fdb-idempotent-populate;h=aa8026272f3727f77ccd7c740eb7da43040fe110;hp=b44d45dd25cc7d63c435059c521bfc0b84a36800;hb=ee1e57fa0fab5d840206d73a3968fd59d7fa7127;hpb=38888dbd9221f97b1886ee545d0113c88432556a diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index b44d45d..aa80262 100755 --- a/yarrg/db-idempotent-populate +++ b/yarrg/db-idempotent-populate @@ -5,24 +5,24 @@ # # 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 @@ -36,20 +36,152 @@ use DBI; use Commods; use CommodsDatabase; +my $trace; +if (@ARGV and $ARGV[0] eq '-D') { + $trace=1; + 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; + +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 @have_field_specs; + + foreach my $f (@want_fields) { + if ($have_fields{$f}) { + push @have_fields, $f; + push @have_field_specs, $want_field_specs{$f}; + } else { + push @need_recreate, "field $f"; + } + } + + #----- Do we need to recreate ? ----- + return unless @need_recreate; + # yes: + + print " Recreating $table: ", join('; ',@need_recreate); + + my $have_fields= join ',', @have_fields; + my $have_field_specs= join ",\n", @have_field_specs; + + db_doall(< $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; #---------- 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') + my $insert= $dbh->prepare(<<'END'); INSERT OR IGNORE INTO commods (unitmass, unitvolume, commodname) 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); + } 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}); } - $dbh->commit; -} -#---------- island list ---------- + my $search= $dbh->prepare(<<'END'); + SELECT commodname,commodid FROM commods; +END + my %check; + foreach my $bs (qw(buy sell)) { + $check{$bs}= $dbh->prepare(<prepare(<<'END'); + DELETE FROM commods WHERE commodid = ? +END + $search->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 <prepare(<<'END') - INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?); +FATAL ERROR + Removed commodity + $row->{'commodid'} + $row->{'commodname'} + but + $bs + $problem->{'islandname'} + $problem->{'stallname'} + $problem->{'qty'} at $problem->{'price'} END - ; - foreach my $archname (sort keys %$ocean) { - my $arch= $ocean->{$archname}; - foreach my $islandname (sort keys %$arch) { - $sth->execute($islandname, $archname); + } } + $delete->execute($row->{'commodid'}); } - $dbh->commit; + print ".\n" if $any; + db_check_referential_integrity(); } -#---------- routes ---------- +#---------- vessel types ---------- { - foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) { - warn "$route_mysteries{$oceanname}{$islandname} routes". - " for unknown island $islandname\n"; - } - - my $allroutes= $routes{$oceanname}; - - my @propqueue= (); - - sub distance_set_propagate ($$$$) { - my ($lev, $start, $upto, $start2upto) = @_; - $allroutes->{$start}{$upto}= $start2upto; - push @propqueue, [ $lev, $start, $upto ]; - } - - 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); - } + my $idempotent= $dbh->prepare(<<'END') + INSERT OR REPLACE INTO vessels (name, shot, mass, volume) + VALUES (?,?,?,?) +END + ; + foreach my $name (sort keys %vessels) { + my $v= $vessels{$name}; + my $shotdamage= $shotname2damage{$v->{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); } +} - sub distance_update ($$$$) { - my ($lev, $x, $y, $newdist) = @_; - distance_update_one("${lev}x",$x,$y,$newdist); - distance_update_one("${lev}y",$y,$x,$newdist); - } - 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); - } +#---------- compact IDs ---------- - foreach my $xn (keys %$allroutes) { - my $routes= $allroutes->{$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}); - } - } - my $ref; - while ($ref= shift @propqueue) { - distance_propagate_now(@$ref); - } +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 : '?'; +} - db_doall(<{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(<prepare(<<'END') - INSERT INTO dists VALUES - ((SELECT islandid FROM islands WHERE islandname == ?), - (SELECT islandid FROM islands WHERE islandname == ?), - ?); + my $oldmax= getminmax($tab,'max',$id); + my $offset= $oldmax+1; + + printf(" %s %s..%d=>1..%d:", + $cp->{Id}, + getminmax($tab,'min',$id), + $oldmax, + getminmax("aside_$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(<{$xn}; - foreach my $yn (keys %$routes) { - $sth->execute($xn, $yn, $routes->{$yn}); + } } } - $dbh->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(); + +{ + local $dbh->{AutoCommit} = 1; + $dbh->do('VACUUM'); +}