6 # usage: ./db-idempotent-populate <Oceanname>
7 # creates or updates OCEAN-Oceanname.db
10 # This is part of the YARRG website. YARRG is a tool and website
11 # for assisting players of Yohoho Puzzle Pirates.
13 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
15 # This program is free software: you can redistribute it and/or modify
16 # it under the terms of the GNU Affero General Public License as
17 # published by the Free Software Foundation, either version 3 of the
18 # License, or (at your option) any later version.
20 # This program is distributed in the hope that it will be useful,
21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 # GNU Affero General Public License for more details.
25 # You should have received a copy of the GNU Affero General Public License
26 # along with this program. If not, see <http://www.gnu.org/licenses/>.
28 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
29 # are used without permission. This program is not endorsed or
30 # sponsored by Three Rings.
32 use strict (qw(vars));
40 while (@ARGV and $ARGV[0] eq '-D') {
46 my ($oceanname) = @ARGV;
50 #---------- setup ----------
52 parse_info_serverside();
54 db_setocean($oceanname);
58 $dbh->trace(1) if $trace;
61 #---------- schema update code ----------
64 our @need_transfer_back;
69 my ($table, $fields) = @_;
70 table_maycompact($table,undef,undef,$fields);
73 sub table_maycompact ($$$$) {
74 my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
76 #----- parse $fields -----
82 foreach my $fspec (split /\n/, $fields) {
83 next unless $fspec =~ m/\S/;
84 if ($fspec =~ m/^\s*\+/) {
85 push @want_field_specs, "\t".$';
87 } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
88 my ($f,$spaces,$rhs) = ($1,$2,$3);
89 my $spec= "\t".$f.$spaces.$rhs;
90 push @want_fields, $f;
91 push @want_field_specs, $spec;
92 $want_field_specs{$f}= $spec;
94 die "$table $fspec ?";
98 my $want_field_specs= join ",\n", @want_field_specs;
100 #----- ensure table exists -----
103 CREATE TABLE IF NOT EXISTS $table (
109 #----- check whether we need to remove autoinc -----
111 if ($fields !~ /\bautoinc/i) {
112 my $autoinc= $dbh->prepare(<<END);
113 SELECT sql FROM sqlite_master
114 WHERE type='table' and name=? and tbl_name=?
116 $autoinc->execute($table,$table);
117 my ($sql)= $autoinc->fetchrow_array();
118 die unless defined $sql;
119 push @need_recreate, 'remove autoinc'
120 if $sql =~ m/\bautoinc/i;
123 #----- check whether we need to add fields -----
125 my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
128 $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
133 my @have_field_specs;
134 my @aside_field_specs;
136 foreach my $f (@want_fields) {
137 if ($have_fields{$f}) {
138 push @have_fields, $f;
139 push @have_field_specs, $want_field_specs{$f};
141 my $aside= $want_field_specs{$f};
142 $aside =~ s/\bUNIQUE\b//i;
143 $aside =~ s/\bNOT\s*NULL\b//i;
144 $aside =~ s/\bPRIMARY\s*KEY\b//i;
146 push @aside_fields, $f;
147 push @aside_field_specs, $aside;
148 push @need_recreate, "field $f";
152 #----- Do we need to recreate ? -----
153 if (!@need_recreate) {
154 $table{$table}= $table;
157 #----- Yes, recreate: -----
159 print " Recreating $table: ", join('; ',@need_recreate);
160 $table{$table}= "aside_$table";
162 my $have_fields= join ',', @have_fields;
163 my $aside_fields= join ',', @have_fields, @aside_fields;
164 my $have_field_specs= join ",\n", @have_field_specs;
165 my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;
168 CREATE TEMPORARY TABLE aside_$table (
171 INSERT INTO aside_$table ($have_fields)
172 SELECT $have_fields FROM $table;
177 push @need_transfer_back, {
180 CREATE TABLE $table (
184 INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
186 DROP TABLE aside_$table;
190 #----- Do we need to compact ids ? -----
191 (print(".\n"), return) unless
192 defined $cpact_idfield
193 and grep { m/^remove autoinc/ } @need_recreate;
196 print "; will compact.\n";
197 unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
199 push @need_compact, {
201 Id => $cpact_idfield,
202 Updates => $cpact_needupdates,
203 Fields => [ @want_fields ],
204 FieldSpecs => $want_field_specs
209 #---------- actual schema ----------
211 foreach my $bs (qw(buy sell)) {
213 commodid INTEGER NOT NULL
214 islandid INTEGER NOT NULL
215 stallid INTEGER NOT NULL
216 price INTEGER NOT NULL
218 + PRIMARY KEY (commodid, islandid, stallid)
222 table_maycompact('commods', 'commodid',
223 [ [ qw(buy sell) ], [ qw(commodid) ],
225 commodid INTEGER PRIMARY KEY NOT NULL
226 commodname TEXT UNIQUE NOT NULL
229 commodclassid INTEGER NOT NULL
230 ordval INTEGER NOT NULL
231 posinclass INTEGER NOT NULL
235 table_maycompact('islands', 'islandid',
236 [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
237 [ qw(dists routes) ], [ qw(aiid biid) ],
239 islandid INTEGER PRIMARY KEY NOT NULL
240 islandname TEXT UNIQUE NOT NULL
241 archipelago TEXT NOT NULL
244 table('stalls', <<END);
245 stallid INTEGER PRIMARY KEY NOT NULL
246 islandid INTEGER NOT NULL
247 stallname TEXT NOT NULL
248 + UNIQUE (islandid, stallname)
251 table('commodclasses', <<END);
252 commodclassid INTEGER PRIMARY KEY NOT NULL
253 commodclass TEXT UNIQUE NOT NULL
254 maxposinclass INTEGER NOT NULL
257 table('uploads', <<END);
258 islandid INTEGER PRIMARY KEY NOT NULL
259 timestamp INTEGER NOT NULL
260 message TEXT NOT NULL
261 clientspec TEXT NOT NULL
262 serverspec TEXT NOT NULL
265 table('dists', <<END);
266 aiid INTEGER NOT NULL
267 biid INTEGER NOT NULL
268 dist INTEGER NOT NULL
269 + PRIMARY KEY (aiid, biid)
272 table('routes', <<END);
273 aiid INTEGER NOT NULL
274 biid INTEGER NOT NULL
275 dist INTEGER NOT NULL
276 + PRIMARY KEY (aiid, biid)
279 table('vessels', <<END);
281 mass INTEGER NOT NULL
282 volume INTEGER NOT NULL
283 shot INTEGER NOT NULL
288 #---------- commodity list ----------
290 sub commodsortkey ($) {
292 return $commods{$commod}{Ordval} ||
293 $commods{$commod}{ClassOrdval};
295 sub commods_ordered () {
297 commodsortkey($a) <=> commodsortkey($b);
304 my %classorderedcount;
306 foreach my $cl (keys %commodclasses) {
307 $classorderedcount{$cl}= 0;
309 foreach my $commod (commods_ordered()) {
310 my $cl= $commods{$commod}{Class};
311 die "no class for commodity $commod" unless defined $cl;
313 my $clid= $commodclasses{$cl};
314 die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
316 if (defined $commods{$commod}{Ordval}) {
317 $posincl{$commod}= ++$classorderedcount{$cl};
319 $posincl{$commod}= 0;
324 DELETE FROM $table{commodclasses};
326 my $addclass= $dbh->prepare(<<END);
327 INSERT INTO $table{commodclasses}
328 (commodclassid, commodclass, maxposinclass)
331 foreach my $cl (sort keys %commodclasses) {
334 $addclass->execute($commodclasses{$cl}+1,
336 $classorderedcount{$cl});
349 my $insert= $dbh->prepare("
350 INSERT OR IGNORE INTO $table{commods}
354 VALUES (?,".join(',', map {'?'} @valuefields).")
356 my $update= $dbh->prepare("
357 UPDATE $table{commods}
359 ", map { "$_ = ?" } @valuefields)."
362 foreach my $commod (commods_ordered()) {
363 my $c= $commods{$commod};
364 die "no mass for $commod" unless defined $c->{Mass};
365 die "no volume for $commod" unless defined $c->{Volume};
368 my $clid= $commodclasses{$cl}+1;
374 commodsortkey($commod),
378 $insert->execute($commod, @valuevalues);
379 $update->execute(@valuevalues, $commod);
382 my $search= $dbh->prepare(<<END);
383 SELECT commodname,commodid FROM $table{commods};
386 foreach my $bs (qw(buy sell)) {
387 $check{$bs}= $dbh->prepare(<<END);
388 SELECT islandname,stallname,price,qty
390 JOIN $table{stalls} USING (stallid)
391 JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
392 WHERE commodid = ? LIMIT 1
395 my $delete= $dbh->prepare(<<END);
396 DELETE FROM $table{commods} WHERE commodid = ?
400 while (my $row= $search->fetchrow_hashref()) {
401 next if defined $commods{$row->{'commodname'}};
402 print $any++ ? '; ' : " Dropping old commodities: ",
403 $row->{'commodname'};
404 foreach my $bs (qw(buy sell)) {
405 $check{$bs}->execute($row->{'commodid'});
406 my $problem= $check{$bs}->fetchrow_hashref();
417 $problem->{'islandname'}
418 $problem->{'stallname'}
419 $problem->{'qty'} at $problem->{'price'}
423 $delete->execute($row->{'commodid'});
428 #---------- vessel types ----------
430 my $idempotent= $dbh->prepare(<<END)
431 INSERT OR REPLACE INTO $table{vessels}
432 (name, shot, mass, volume)
436 foreach my $name (sort keys %vessels) {
437 my $v= $vessels{$name};
438 my $shotdamage= $shotname2damage{$v->{Shot}};
439 die "no shot damage for shot $v->{Shot} for vessel $name"
440 unless defined $shotdamage;
441 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
442 $idempotent->execute(@qa);
446 #---------- transfer data back from any recreated tables ----------
448 foreach my $tb (@need_transfer_back) {
449 my $tab= $tb->{Table};
450 print " Retransferring $tab...";
453 db_doall($tb->{Sql});
458 print STDERR "\n=== $tab retransfer failed, dumping:\n";
459 my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
461 my @cols= @{ $dumph->{NAME_lc} };
462 dumptab_head(\*STDERR,$w,\@cols);
464 while ($row= $dumph->fetchrow_hashref()) {
465 dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
473 #---------- create indices ----------
475 foreach my $bs (qw(buy sell)) {
477 CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
478 CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
483 db_check_referential_integrity(1);
485 #---------- compact IDs ----------
487 sub getminmax ($$$) {
488 my ($tab,$minmax,$f) = @_;
489 my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
491 my ($val)= $sth->fetchrow_array();
492 return defined($val) ? $val : '?';
495 foreach my $cp (@need_compact) {
496 print " Compacting $cp->{Table}";
497 my $tab= $cp->{Table};
499 my $tmp_field_specs= $cp->{FieldSpecs};
500 my $fields= join ',', @{$cp->{Fields}};
501 $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
502 die "$tab $tmp_field_specs ?";
504 CREATE TEMPORARY TABLE idlookup_$tab (
505 new_$id INTEGER PRIMARY KEY NOT NULL,
508 INSERT INTO idlookup_$tab ($fields)
512 my $oldmax= getminmax($tab,'max',$id);
513 my $offset= $oldmax+1;
515 printf(" %s %s..%d=>1..%d:",
517 getminmax($tab,'min',$id),
519 getminmax("idlookup_$tab",'max',"new_$id"));
520 my @updates= @{ $cp->{Updates} };
522 my $utabs= shift @updates;
523 my $ufields= shift @updates;
524 foreach my $utab (@$utabs) {
527 foreach my $ufield (@$ufields) {
528 printf("%s%s",$fh,$ufield); $fh=',';
531 SET $ufield = $offset +
532 (SELECT new_$id FROM idlookup_$tab
533 WHERE idlookup_$tab.$id = $utab.$ufield);
535 SET $ufield = $ufield - $offset;
543 #---------- put it all into effect ----------
548 local $dbh->{AutoCommit} = 1;