#!/usr/bin/perl -w
#
+# Normally run from
+# update-master-info
+#
# usage: ./db-idempotent-populate <Oceanname>
# 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 <ijackson@chiark.greenend.org.uk>
#
# 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 <http://www.gnu.org/licenses/>.
#
# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
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(<<END);
+ CREATE TABLE IF NOT EXISTS $table (
+$want_field_specs
+ );
+END
+ my @need_recreate;
+
+ #----- check whether we need to remove autoinc -----
+
+ if ($fields !~ /\bautoinc/i) {
+ my $autoinc= $dbh->prepare(<<END);
+ SELECT sql FROM sqlite_master
+ WHERE type='table' and name=? and tbl_name=?
+END
+ $autoinc->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(<<END);
+ CREATE TEMPORARY TABLE aside_$table (
+$aside_field_specs
+ );
+ INSERT INTO aside_$table ($have_fields)
+ SELECT $have_fields FROM $table;
+
+ DROP TABLE $table;
+END
+
+ push @need_transfer_back, {
+ Table => $table,
+ Sql => <<END
+ CREATE TABLE $table (
+$want_field_specs
+ );
+
+ INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
+
+ DROP TABLE aside_$table;
+END
+ };
+
+ #----- Do we need to compact ids ? -----
+ (print(".\n"), return) unless
+ defined $cpact_idfield
+ and grep { m/^remove autoinc/ } @need_recreate;
+ # yes:
+
+ print "; will compact.\n";
+ unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
+
+ push @need_compact, {
+ Table => $table,
+ Id => $cpact_idfield,
+ Updates => $cpact_needupdates,
+ Fields => [ @want_fields ],
+ FieldSpecs => $want_field_specs
+ };
+}
+
+
+#---------- actual schema ----------
foreach my $bs (qw(buy sell)) {
- db_doall(<<END)
- CREATE TABLE IF NOT EXISTS $bs (
- commodid INTEGER NOT NULL,
- islandid INTEGER NOT NULL,
- stallid INTEGER NOT NULL,
- price INTEGER NOT NULL,
- qty INTEGER NOT NULL,
- PRIMARY KEY (commodid, islandid, stallid)
- );
- CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
- CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
+ table($bs,<<END);
+ commodid INTEGER NOT NULL
+ islandid INTEGER NOT NULL
+ stallid INTEGER NOT NULL
+ price INTEGER NOT NULL
+ qty INTEGER NOT NULL
+ + PRIMARY KEY (commodid, islandid, stallid)
END
- ;
}
-db_doall(<<END)
- CREATE TABLE IF NOT EXISTS commods (
- commodid INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
- commodname TEXT UNIQUE NOT NULL,
- unitmass INTEGER,
+table_maycompact('commods', 'commodid',
+ [ [ qw(buy sell) ], [ qw(commodid) ],
+ ], <<END);
+ commodid INTEGER PRIMARY KEY NOT NULL
+ commodname TEXT UNIQUE NOT NULL
+ unitmass INTEGER
unitvolume INTEGER
- );
- CREATE TABLE IF NOT EXISTS islands (
- islandid INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
- islandname TEXT UNIQUE NOT NULL,
+ commodclassid INTEGER NOT NULL
+ ordval INTEGER NOT NULL
+ posinclass INTEGER NOT NULL
+ flags TEXT NOT NULL
+END
+
+table_maycompact('islands', 'islandid',
+ [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
+ [ qw(dists routes) ], [ qw(aiid biid) ],
+ ], <<END);
+ islandid INTEGER PRIMARY KEY NOT NULL
+ islandname TEXT UNIQUE NOT NULL
archipelago TEXT NOT NULL
- );
- CREATE TABLE IF NOT EXISTS stalls (
- stallid INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
- islandid INTEGER NOT NULL,
- stallname TEXT NOT NULL,
- UNIQUE (islandid, stallname)
- );
- CREATE TABLE IF NOT EXISTS uploads (
- islandid INTEGER PRIMARY KEY NOT NULL,
- timestamp INTEGER NOT NULL,
- message TEXT NOT NULL,
- clientspec TEXT NOT NULL,
+END
+
+table('stalls', <<END);
+ stallid INTEGER PRIMARY KEY NOT NULL
+ islandid INTEGER NOT NULL
+ stallname TEXT NOT NULL
+ + UNIQUE (islandid, stallname)
+END
+
+table('commodclasses', <<END);
+ commodclassid INTEGER PRIMARY KEY NOT NULL
+ commodclass TEXT UNIQUE NOT NULL
+ maxposinclass INTEGER NOT NULL
+END
+
+table('uploads', <<END);
+ islandid INTEGER PRIMARY KEY NOT NULL
+ timestamp INTEGER NOT NULL
+ message TEXT NOT NULL
+ clientspec TEXT NOT NULL
serverspec TEXT NOT NULL
- );
- CREATE TABLE IF NOT EXISTS dists (
- aiid INTEGER NOT NULL,
- biid INTEGER NOT NULL,
- dist INTEGER NOT NULL,
- PRIMARY KEY (aiid, biid)
- );
END
- ;
-$dbh->commit;
+table('dists', <<END);
+ aiid INTEGER NOT NULL
+ biid INTEGER NOT NULL
+ dist INTEGER NOT NULL
+ + PRIMARY KEY (aiid, biid)
+END
-#---------- commodity list ----------
+table('routes', <<END);
+ aiid INTEGER NOT NULL
+ biid INTEGER NOT NULL
+ dist INTEGER NOT NULL
+ + PRIMARY KEY (aiid, biid)
+END
-{
- my $sth= $dbh->prepare(<<'END')
- INSERT OR IGNORE INTO commods (commodname) VALUES (?);
+table('vessels', <<END);
+ name TEXT NOT NULL
+ mass INTEGER NOT NULL
+ volume INTEGER NOT NULL
+ shot INTEGER NOT NULL
+ + PRIMARY KEY (name)
END
- ;
- foreach my $commod (sort keys %commods) {
- $sth->execute($commod);
- }
- $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;
}
-#---------- island list ----------
+our %posincl;
{
- my $sth= $dbh->prepare(<<'END')
- INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
-END
- ;
- foreach my $archname (sort keys %$ocean) {
- my $arch= $ocean->{$archname};
- foreach my $islandname (sort keys %$arch) {
- $sth->execute($islandname, $archname);
- }
+ my %classorderedcount;
+
+ foreach my $cl (keys %commodclasses) {
+ $classorderedcount{$cl}= 0;
}
- $dbh->commit;
-}
+ foreach my $commod (commods_ordered()) {
+ my $cl= $commods{$commod}{Class};
+ die "no class for commodity $commod" unless defined $cl;
-#---------- routes ----------
+ my $clid= $commodclasses{$cl};
+ die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
-{
- foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
- warn "$route_mysteries{$oceanname}{$islandname} routes".
- " for unknown island $islandname\n";
+ if (defined $commods{$commod}{Ordval}) {
+ $posincl{$commod}= ++$classorderedcount{$cl};
+ } else {
+ $posincl{$commod}= 0;
+ }
}
- my $allroutes= $routes{$oceanname};
+ db_doall(<<END);
+ DELETE FROM $table{commodclasses};
+END
+ my $addclass= $dbh->prepare(<<END);
+ INSERT INTO $table{commodclasses}
+ (commodclassid, commodclass, maxposinclass)
+ VALUES (?,?,?)
+END
+ foreach my $cl (sort keys %commodclasses) {
+ my $clname= $cl;
+ $clname =~ s/_/ /g;
+ $addclass->execute($commodclasses{$cl}+1,
+ ucfirst $clname,
+ $classorderedcount{$cl});
+ }
+}
- my @propqueue= ();
+{
+ 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_set_propagate ($$$$) {
- my ($lev, $start, $upto, $start2upto) = @_;
- $allroutes->{$start}{$upto}= $start2upto;
- push @propqueue, [ $lev, $start, $upto ];
+ my @valuevalues= (
+ $c->{Mass},
+ $c->{Volume},
+ $clid,
+ commodsortkey($commod),
+ $posincl{$commod},
+ $c->{Flags}
+ );
+ $insert->execute($commod, @valuevalues);
+ $update->execute(@valuevalues, $commod);
}
- 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 $search= $dbh->prepare(<<END);
+ SELECT commodname,commodid FROM $table{commods};
+END
+ my %check;
+ foreach my $bs (qw(buy sell)) {
+ $check{$bs}= $dbh->prepare(<<END);
+ SELECT islandname,stallname,price,qty
+ FROM $table{$bs}
+ JOIN $table{stalls} USING (stallid)
+ JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
+ WHERE commodid = ? LIMIT 1
+END
}
+ my $delete= $dbh->prepare(<<END);
+ DELETE FROM $table{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 <<END
- sub distance_update ($$$$) {
- my ($lev, $x, $y, $newdist) = @_;
- distance_update_one("${lev}x",$x,$y,$newdist);
- distance_update_one("${lev}y",$y,$x,$newdist);
+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;
+}
- 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);
+#---------- vessel types ----------
+{
+ my $idempotent= $dbh->prepare(<<END)
+ INSERT OR REPLACE INTO $table{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);
}
+}
- 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});
+#---------- 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";
}
- my $ref;
- while ($ref= shift @propqueue) {
- distance_propagate_now(@$ref);
- }
+ print "\n";
+ $table{$tab}= $tab;
+}
+#---------- create indices ----------
+
+foreach my $bs (qw(buy sell)) {
db_doall(<<END)
- DELETE FROM dists;
+ CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
+ CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
END
;
- my $sth= $dbh->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(<<END);
+ CREATE TEMPORARY TABLE idlookup_$tab (
+ new_$id INTEGER PRIMARY KEY NOT NULL,
+$tmp_field_specs
+ );
+ INSERT INTO idlookup_$tab ($fields)
+ SELECT $fields
+ FROM $tab;
END
- ;
- foreach my $xn (keys %$allroutes) {
- my $routes= $allroutes->{$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(<<END);
+ UPDATE $utab
+ SET $ufield = $offset +
+ (SELECT new_$id FROM idlookup_$tab
+ WHERE idlookup_$tab.$id = $utab.$ufield);
+ UPDATE $utab
+ SET $ufield = $ufield - $offset;
+END
+ }
}
}
- $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(1);
+
+{
+ local $dbh->{AutoCommit} = 1;
+ $dbh->do('VACUUM');
+}
~yarrgweb / ypp-sc-tools.db-live.git / blobdiff