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
234 table_maycompact('islands', 'islandid',
235 [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
236 [ qw(dists routes) ], [ qw(aiid biid) ],
238 islandid INTEGER PRIMARY KEY NOT NULL
239 islandname TEXT UNIQUE NOT NULL
240 archipelago TEXT NOT NULL
243 table('stalls', <<END);
244 stallid INTEGER PRIMARY KEY NOT NULL
245 islandid INTEGER NOT NULL
246 stallname TEXT NOT NULL
247 + UNIQUE (islandid, stallname)
250 table('commodclasses', <<END);
251 commodclassid INTEGER PRIMARY KEY NOT NULL
252 commodclass TEXT UNIQUE NOT NULL
253 maxposinclass INTEGER NOT NULL
256 table('uploads', <<END);
257 islandid INTEGER PRIMARY KEY NOT NULL
258 timestamp INTEGER NOT NULL
259 message TEXT NOT NULL
260 clientspec TEXT NOT NULL
261 serverspec TEXT NOT NULL
264 table('dists', <<END);
265 aiid INTEGER NOT NULL
266 biid INTEGER NOT NULL
267 dist INTEGER NOT NULL
268 + PRIMARY KEY (aiid, biid)
271 table('routes', <<END);
272 aiid INTEGER NOT NULL
273 biid INTEGER NOT NULL
274 dist INTEGER NOT NULL
275 + PRIMARY KEY (aiid, biid)
278 table('vessels', <<END);
280 mass INTEGER NOT NULL
281 volume INTEGER NOT NULL
282 shot INTEGER NOT NULL
287 #---------- commodity list ----------
289 sub commodsortkey ($) {
291 return $commods{$commod}{Ordval} ||
292 $commods{$commod}{ClassOrdval};
294 sub commods_ordered () {
296 commodsortkey($a) <=> commodsortkey($b);
303 my %classorderedcount;
305 foreach my $cl (keys %commodclasses) {
306 $classorderedcount{$cl}= 0;
308 foreach my $commod (commods_ordered()) {
309 my $cl= $commods{$commod}{Class};
310 die "no class for commodity $commod" unless defined $cl;
312 my $clid= $commodclasses{$cl};
313 die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
315 if (defined $commods{$commod}{Ordval}) {
316 $posincl{$commod}= ++$classorderedcount{$cl};
318 $posincl{$commod}= 0;
323 DELETE FROM $table{commodclasses};
325 my $addclass= $dbh->prepare(<<END);
326 INSERT INTO $table{commodclasses}
327 (commodclassid, commodclass, maxposinclass)
330 foreach my $cl (sort keys %commodclasses) {
333 $addclass->execute($commodclasses{$cl}+1,
335 $classorderedcount{$cl});
347 my $insert= $dbh->prepare("
348 INSERT OR IGNORE INTO $table{commods}
352 VALUES (?,".join(',', map {'?'} @valuefields).")
354 my $update= $dbh->prepare("
355 UPDATE $table{commods}
357 ", map { "$_ = ?" } @valuefields)."
360 foreach my $commod (commods_ordered()) {
361 my $c= $commods{$commod};
362 die "no mass for $commod" unless defined $c->{Mass};
363 die "no volume for $commod" unless defined $c->{Volume};
366 my $clid= $commodclasses{$cl}+1;
372 commodsortkey($commod),
375 $insert->execute($commod, @valuevalues);
376 $update->execute(@valuevalues, $commod);
379 my $search= $dbh->prepare(<<END);
380 SELECT commodname,commodid FROM $table{commods};
383 foreach my $bs (qw(buy sell)) {
384 $check{$bs}= $dbh->prepare(<<END);
385 SELECT islandname,stallname,price,qty
387 JOIN $table{stalls} USING (stallid)
388 JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
389 WHERE commodid = ? LIMIT 1
392 my $delete= $dbh->prepare(<<END);
393 DELETE FROM $table{commods} WHERE commodid = ?
397 while (my $row= $search->fetchrow_hashref()) {
398 next if defined $commods{$row->{'commodname'}};
399 print $any++ ? '; ' : " Dropping old commodities: ",
400 $row->{'commodname'};
401 foreach my $bs (qw(buy sell)) {
402 $check{$bs}->execute($row->{'commodid'});
403 my $problem= $check{$bs}->fetchrow_hashref();
414 $problem->{'islandname'}
415 $problem->{'stallname'}
416 $problem->{'qty'} at $problem->{'price'}
420 $delete->execute($row->{'commodid'});
425 #---------- vessel types ----------
427 my $idempotent= $dbh->prepare(<<END)
428 INSERT OR REPLACE INTO $table{vessels}
429 (name, shot, mass, volume)
433 foreach my $name (sort keys %vessels) {
434 my $v= $vessels{$name};
435 my $shotdamage= $shotname2damage{$v->{Shot}};
436 die "no shot damage for shot $v->{Shot} for vessel $name"
437 unless defined $shotdamage;
438 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
439 $idempotent->execute(@qa);
443 #---------- transfer data back from any recreated tables ----------
445 foreach my $tb (@need_transfer_back) {
446 my $tab= $tb->{Table};
447 print " Retransferring $tab...";
450 db_doall($tb->{Sql});
455 print STDERR "\n=== $tab retransfer failed, dumping:\n";
456 my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
458 my @cols= @{ $dumph->{NAME_lc} };
459 dumptab_head(\*STDERR,$w,\@cols);
461 while ($row= $dumph->fetchrow_hashref()) {
462 dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
470 #---------- create indices ----------
472 foreach my $bs (qw(buy sell)) {
474 CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
475 CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
480 db_check_referential_integrity(1);
482 #---------- compact IDs ----------
484 sub getminmax ($$$) {
485 my ($tab,$minmax,$f) = @_;
486 my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
488 my ($val)= $sth->fetchrow_array();
489 return defined($val) ? $val : '?';
492 foreach my $cp (@need_compact) {
493 print " Compacting $cp->{Table}";
494 my $tab= $cp->{Table};
496 my $tmp_field_specs= $cp->{FieldSpecs};
497 my $fields= join ',', @{$cp->{Fields}};
498 $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
499 die "$tab $tmp_field_specs ?";
501 CREATE TEMPORARY TABLE idlookup_$tab (
502 new_$id INTEGER PRIMARY KEY NOT NULL,
505 INSERT INTO idlookup_$tab ($fields)
509 my $oldmax= getminmax($tab,'max',$id);
510 my $offset= $oldmax+1;
512 printf(" %s %s..%d=>1..%d:",
514 getminmax($tab,'min',$id),
516 getminmax("idlookup_$tab",'max',"new_$id"));
517 my @updates= @{ $cp->{Updates} };
519 my $utabs= shift @updates;
520 my $ufields= shift @updates;
521 foreach my $utab (@$utabs) {
524 foreach my $ufield (@$ufields) {
525 printf("%s%s",$fh,$ufield); $fh=',';
528 SET $ufield = $offset +
529 (SELECT new_$id FROM idlookup_$tab
530 WHERE idlookup_$tab.$id = $utab.$ufield);
532 SET $ufield = $ufield - $offset;
540 #---------- put it all into effect ----------
545 local $dbh->{AutoCommit} = 1;