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 BEGIN { unshift @INC, qw(.) }
34 use strict (qw(vars));
42 while (@ARGV and $ARGV[0] eq '-D') {
48 my ($oceanname) = @ARGV;
52 #---------- setup ----------
54 parse_info_serverside();
56 db_setocean($oceanname);
60 $dbh->trace(1) if $trace;
63 #---------- schema update code ----------
66 our @need_transfer_back;
71 my ($table, $fields) = @_;
72 table_maycompact($table,undef,undef,$fields);
75 sub table_maycompact ($$$$) {
76 my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
78 #----- parse $fields -----
84 foreach my $fspec (split /\n/, $fields) {
85 next unless $fspec =~ m/\S/;
86 if ($fspec =~ m/^\s*\+/) {
87 push @want_field_specs, "\t".$';
89 } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
90 my ($f,$spaces,$rhs) = ($1,$2,$3);
91 my $spec= "\t".$f.$spaces.$rhs;
92 push @want_fields, $f;
93 push @want_field_specs, $spec;
94 $want_field_specs{$f}= $spec;
96 die "$table $fspec ?";
100 my $want_field_specs= join ",\n", @want_field_specs;
102 #----- ensure table exists -----
105 CREATE TABLE IF NOT EXISTS $table (
111 #----- check whether we need to remove autoinc -----
113 if ($fields !~ /\bautoinc/i) {
114 my $autoinc= $dbh->prepare(<<END);
115 SELECT sql FROM sqlite_master
116 WHERE type='table' and name=? and tbl_name=?
118 $autoinc->execute($table,$table);
119 my ($sql)= $autoinc->fetchrow_array();
120 die unless defined $sql;
121 push @need_recreate, 'remove autoinc'
122 if $sql =~ m/\bautoinc/i;
125 #----- check whether we need to add fields -----
127 my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
130 $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
135 my @have_field_specs;
136 my @aside_field_specs;
138 foreach my $f (@want_fields) {
139 if ($have_fields{$f}) {
140 push @have_fields, $f;
141 push @have_field_specs, $want_field_specs{$f};
143 my $aside= $want_field_specs{$f};
144 $aside =~ s/\bUNIQUE\b//i;
145 $aside =~ s/\bNOT\s*NULL\b//i;
146 $aside =~ s/\bPRIMARY\s*KEY\b//i;
148 push @aside_fields, $f;
149 push @aside_field_specs, $aside;
150 push @need_recreate, "field $f";
154 #----- Do we need to recreate ? -----
155 if (!@need_recreate) {
156 $table{$table}= $table;
159 #----- Yes, recreate: -----
161 print " Recreating $table: ", join('; ',@need_recreate);
162 $table{$table}= "aside_$table";
164 my $have_fields= join ',', @have_fields;
165 my $aside_fields= join ',', @have_fields, @aside_fields;
166 my $have_field_specs= join ",\n", @have_field_specs;
167 my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs;
170 CREATE TEMPORARY TABLE aside_$table (
173 INSERT INTO aside_$table ($have_fields)
174 SELECT $have_fields FROM $table;
179 push @need_transfer_back, {
182 CREATE TABLE $table (
186 INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
188 DROP TABLE aside_$table;
192 #----- Do we need to compact ids ? -----
193 (print(".\n"), return) unless
194 defined $cpact_idfield
195 and grep { m/^remove autoinc/ } @need_recreate;
198 print "; will compact.\n";
199 unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
201 push @need_compact, {
203 Id => $cpact_idfield,
204 Updates => $cpact_needupdates,
205 Fields => [ @want_fields ],
206 FieldSpecs => $want_field_specs
211 #---------- actual schema ----------
213 foreach my $bs (qw(buy sell)) {
215 commodid INTEGER NOT NULL
216 islandid INTEGER NOT NULL
217 stallid INTEGER NOT NULL
218 price INTEGER NOT NULL
220 + PRIMARY KEY (commodid, islandid, stallid)
224 table_maycompact('commods', 'commodid',
225 [ [ qw(buy sell) ], [ qw(commodid) ],
227 commodid INTEGER PRIMARY KEY NOT NULL
228 commodname TEXT UNIQUE NOT NULL
231 commodclassid INTEGER NOT NULL
232 ordval INTEGER NOT NULL
233 posinclass INTEGER NOT NULL
237 table_maycompact('islands', 'islandid',
238 [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
239 [ qw(dists routes) ], [ qw(aiid biid) ],
241 islandid INTEGER PRIMARY KEY NOT NULL
242 islandname TEXT UNIQUE NOT NULL
243 archipelago TEXT NOT NULL
246 table('stalls', <<END);
247 stallid INTEGER PRIMARY KEY NOT NULL
248 islandid INTEGER NOT NULL
249 stallname TEXT NOT NULL
250 + UNIQUE (islandid, stallname)
253 table('commodclasses', <<END);
254 commodclassid INTEGER PRIMARY KEY NOT NULL
255 commodclass TEXT UNIQUE NOT NULL
256 maxposinclass INTEGER NOT NULL
259 table('uploads', <<END);
260 islandid INTEGER PRIMARY KEY NOT NULL
261 timestamp INTEGER NOT NULL
262 message TEXT NOT NULL
263 clientspec TEXT NOT NULL
264 serverspec TEXT NOT NULL
267 table('dists', <<END);
268 aiid INTEGER NOT NULL
269 biid INTEGER NOT NULL
270 dist INTEGER NOT NULL
271 + PRIMARY KEY (aiid, biid)
274 table('routes', <<END);
275 aiid INTEGER NOT NULL
276 biid INTEGER NOT NULL
277 dist INTEGER NOT NULL
278 + PRIMARY KEY (aiid, biid)
281 table('vessels', <<END);
283 mass INTEGER NOT NULL
284 volume INTEGER NOT NULL
285 shot INTEGER NOT NULL
290 #---------- commodity list ----------
292 sub commodsortkey ($) {
294 return $commods{$commod}{Ordval} ||
295 $commods{$commod}{ClassOrdval};
297 sub commods_ordered () {
299 commodsortkey($a) <=> commodsortkey($b);
306 my %classorderedcount;
308 foreach my $cl (keys %commodclasses) {
309 $classorderedcount{$cl}= 0;
311 foreach my $commod (commods_ordered()) {
312 my $cl= $commods{$commod}{Class};
313 die "no class for commodity $commod" unless defined $cl;
315 my $clid= $commodclasses{$cl};
316 die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
318 if (defined $commods{$commod}{Ordval}) {
319 $posincl{$commod}= ++$classorderedcount{$cl};
321 $posincl{$commod}= 0;
326 DELETE FROM $table{commodclasses};
328 my $addclass= $dbh->prepare(<<END);
329 INSERT INTO $table{commodclasses}
330 (commodclassid, commodclass, maxposinclass)
333 foreach my $cl (sort keys %commodclasses) {
336 $addclass->execute($commodclasses{$cl}+1,
338 $classorderedcount{$cl});
351 my $insert= $dbh->prepare("
352 INSERT OR IGNORE INTO $table{commods}
356 VALUES (?,".join(',', map {'?'} @valuefields).")
358 my $update= $dbh->prepare("
359 UPDATE $table{commods}
361 ", map { "$_ = ?" } @valuefields)."
364 foreach my $commod (commods_ordered()) {
365 my $c= $commods{$commod};
366 die "no mass for $commod" unless defined $c->{Mass};
367 die "no volume for $commod" unless defined $c->{Volume};
370 my $clid= $commodclasses{$cl}+1;
376 commodsortkey($commod),
380 $insert->execute($commod, @valuevalues);
381 $update->execute(@valuevalues, $commod);
384 my $search= $dbh->prepare(<<END);
385 SELECT commodname,commodid FROM $table{commods};
388 foreach my $bs (qw(buy sell)) {
389 $check{$bs}= $dbh->prepare(<<END);
390 SELECT islandname,stallname,price,qty
392 JOIN $table{stalls} USING (stallid)
393 JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
394 WHERE commodid = ? LIMIT 1
397 my $delete= $dbh->prepare(<<END);
398 DELETE FROM $table{commods} WHERE commodid = ?
402 while (my $row= $search->fetchrow_hashref()) {
403 next if defined $commods{$row->{'commodname'}};
404 print $any++ ? '; ' : " Dropping old commodities: ",
405 $row->{'commodname'};
406 foreach my $bs (qw(buy sell)) {
407 $check{$bs}->execute($row->{'commodid'});
408 my $problem= $check{$bs}->fetchrow_hashref();
419 $problem->{'islandname'}
420 $problem->{'stallname'}
421 $problem->{'qty'} at $problem->{'price'}
425 $delete->execute($row->{'commodid'});
430 #---------- vessel types ----------
432 my $idempotent= $dbh->prepare(<<END)
433 INSERT OR REPLACE INTO $table{vessels}
434 (name, shot, mass, volume)
438 foreach my $name (sort keys %vessels) {
439 my $v= $vessels{$name};
440 my $shotdamage= $shotname2damage{$v->{Shot}};
441 die "no shot damage for shot $v->{Shot} for vessel $name"
442 unless defined $shotdamage;
443 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
444 $idempotent->execute(@qa);
448 #---------- transfer data back from any recreated tables ----------
450 foreach my $tb (@need_transfer_back) {
451 my $tab= $tb->{Table};
452 print " Retransferring $tab...";
455 db_doall($tb->{Sql});
460 print STDERR "\n=== $tab retransfer failed, dumping:\n";
461 my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
463 my @cols= @{ $dumph->{NAME_lc} };
464 dumptab_head(\*STDERR,$w,\@cols);
466 while ($row= $dumph->fetchrow_hashref()) {
467 dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
475 #---------- create indices ----------
477 foreach my $bs (qw(buy sell)) {
479 CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
480 CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
485 db_check_referential_integrity(1);
487 #---------- compact IDs ----------
489 sub getminmax ($$$) {
490 my ($tab,$minmax,$f) = @_;
491 my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
493 my ($val)= $sth->fetchrow_array();
494 return defined($val) ? $val : '?';
497 foreach my $cp (@need_compact) {
498 print " Compacting $cp->{Table}";
499 my $tab= $cp->{Table};
501 my $tmp_field_specs= $cp->{FieldSpecs};
502 my $fields= join ',', @{$cp->{Fields}};
503 $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
504 die "$tab $tmp_field_specs ?";
506 CREATE TEMPORARY TABLE idlookup_$tab (
507 new_$id INTEGER PRIMARY KEY NOT NULL,
510 INSERT INTO idlookup_$tab ($fields)
514 my $oldmax= getminmax($tab,'max',$id);
515 my $offset= $oldmax+1;
517 printf(" %s %s..%d=>1..%d:",
519 getminmax($tab,'min',$id),
521 getminmax("idlookup_$tab",'max',"new_$id"));
522 my @updates= @{ $cp->{Updates} };
524 my $utabs= shift @updates;
525 my $ufields= shift @updates;
526 foreach my $utab (@$utabs) {
529 foreach my $ufield (@$ufields) {
530 printf("%s%s",$fh,$ufield); $fh=',';
533 SET $ufield = $offset +
534 (SELECT new_$id FROM idlookup_$tab
535 WHERE idlookup_$tab.$id = $utab.$ufield);
537 SET $ufield = $ufield - $offset;
545 #---------- put it all into effect ----------
550 local $dbh->{AutoCommit} = 1;