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 if (@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 ----------
66 my ($table, $fields) = @_;
67 table_maycompact($table,undef,undef,$fields);
70 sub table_maycompact ($$$$) {
71 my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
73 #----- parse $fields -----
79 foreach my $fspec (split /\n/, $fields) {
80 next unless $fspec =~ m/\S/;
81 if ($fspec =~ m/^\s*\+/) {
82 push @want_field_specs, "\t".$';
84 } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
85 my ($f,$spaces,$rhs) = ($1,$2,$3);
86 my $spec= "\t".$f.$spaces.$rhs;
87 push @want_fields, $f;
88 push @want_field_specs, $spec;
89 $want_field_specs{$f}= $spec;
91 die "$table $fspec ?";
95 my $want_field_specs= join ",\n", @want_field_specs;
97 #----- ensure table exists -----
100 CREATE TABLE IF NOT EXISTS $table (
106 #----- check whether we need to remove autoinc -----
108 if ($fields !~ /\bautoinc/i) {
109 my $autoinc= $dbh->prepare(<<END);
110 SELECT sql FROM sqlite_master
111 WHERE type='table' and name=? and tbl_name=?
113 $autoinc->execute($table,$table);
114 my ($sql)= $autoinc->fetchrow_array();
115 die unless defined $sql;
116 push @need_recreate, 'remove autoinc'
117 if $sql =~ m/\bautoinc/i;
120 #----- check whether we need to add fields -----
122 my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
125 $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
129 my @have_field_specs;
131 foreach my $f (@want_fields) {
132 if ($have_fields{$f}) {
133 push @have_fields, $f;
134 push @have_field_specs, $want_field_specs{$f};
136 push @need_recreate, "field $f";
140 #----- Do we need to recreate ? -----
141 return unless @need_recreate;
144 print " Recreating $table: ", join('; ',@need_recreate);
146 my $have_fields= join ',', @have_fields;
147 my $have_field_specs= join ",\n", @have_field_specs;
150 CREATE TEMPORARY TABLE aside_$table (
153 INSERT INTO aside_$table SELECT $have_fields FROM $table;
156 CREATE TABLE $table (
160 INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
162 DROP TABLE aside_$table;
165 #----- Do we need to compact ids ? -----
166 (print("\n"), return) unless
167 defined $cpact_idfield
168 and grep { m/^remove autoinc/ } @need_recreate;
171 print "; will compact.\n";
172 unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
174 push @need_compact, {
176 Id => $cpact_idfield,
177 Updates => $cpact_needupdates,
178 Fields => [ @want_fields ],
179 FieldSpecs => $want_field_specs
184 #---------- actual schema ----------
186 foreach my $bs (qw(buy sell)) {
188 CREATE TABLE IF NOT EXISTS $bs (
189 commodid INTEGER NOT NULL,
190 islandid INTEGER NOT NULL,
191 stallid INTEGER NOT NULL,
192 price INTEGER NOT NULL,
193 qty INTEGER NOT NULL,
194 PRIMARY KEY (commodid, islandid, stallid)
196 CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
197 CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
202 table_maycompact('commods', 'commodid',
203 [ [ qw(buy sell) ], [ qw(commodid) ],
205 commodid INTEGER PRIMARY KEY NOT NULL
206 commodname TEXT UNIQUE NOT NULL
214 table_maycompact('islands', 'islandid',
215 [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ],
216 [ qw(dists routes) ], [ qw(aiid biid) ],
218 islandid INTEGER PRIMARY KEY NOT NULL
219 islandname TEXT UNIQUE NOT NULL
220 archipelago TEXT NOT NULL
223 table('stalls', <<END);
224 stallid INTEGER PRIMARY KEY NOT NULL
225 islandid INTEGER NOT NULL
226 stallname TEXT NOT NULL
227 + UNIQUE (islandid, stallname)
230 table('commodclasses', <<END);
231 commodclass TEXT PRIMARY KEY NOT NULL
236 CREATE TABLE IF NOT EXISTS uploads (
237 islandid INTEGER PRIMARY KEY NOT NULL,
238 timestamp INTEGER NOT NULL,
239 message TEXT NOT NULL,
240 clientspec TEXT NOT NULL,
241 serverspec TEXT NOT NULL
243 CREATE TABLE IF NOT EXISTS dists (
244 aiid INTEGER NOT NULL,
245 biid INTEGER NOT NULL,
246 dist INTEGER NOT NULL,
247 PRIMARY KEY (aiid, biid)
249 CREATE TABLE IF NOT EXISTS routes (
250 aiid INTEGER NOT NULL,
251 biid INTEGER NOT NULL,
252 dist INTEGER NOT NULL,
253 PRIMARY KEY (aiid, biid)
255 CREATE TABLE IF NOT EXISTS vessels (
257 mass INTEGER NOT NULL,
258 volume INTEGER NOT NULL,
259 shot INTEGER NOT NULL,
266 #---------- commodity list ----------
268 sub commodsortkey ($) {
270 my $ordval= $commods{$commod}{Ordval};
271 return sprintf "B %20d", $ordval if defined $ordval;
272 return sprintf "A %s", $commod;
276 my $insert= $dbh->prepare(<<'END');
277 INSERT OR IGNORE INTO commods
283 my $setsizes= $dbh->prepare(<<'END');
289 my $setordval= $dbh->prepare(<<'END');
294 my $setclass= $dbh->prepare(<<'END');
299 my $setinclass= $dbh->prepare(<<'END');
305 foreach my $commod (sort {
306 commodsortkey($a) cmp commodsortkey($b)
308 my $c= $commods{$commod};
309 die "no mass for $commod" unless defined $c->{Mass};
310 die "no volume for $commod" unless defined $c->{Volume};
312 my @qa= ($c->{Mass}, $c->{Volume}, $commod);
313 $insert->execute(@qa);
314 $setsizes->execute(@qa);
315 $setordval->execute($c->{Ordval} || 0, $commod);
317 $setclass->execute($cl, $commod);
319 if (defined $c->{Ordval} and defined $cl) {
321 $setinclass->execute($incl{$cl}, $commod);
322 } elsif (defined $cl) {
327 DELETE FROM commodclasses;
329 my $addclass= $dbh->prepare(<<'END');
330 INSERT INTO commodclasses
334 foreach my $cl (sort keys %incl) {
335 $addclass->execute($cl, $incl{$cl});
338 my $search= $dbh->prepare(<<'END');
339 SELECT commodname,commodid FROM commods;
342 foreach my $bs (qw(buy sell)) {
343 $check{$bs}= $dbh->prepare(<<END);
344 SELECT islandname,stallname,price,qty
346 JOIN stalls USING (stallid)
347 JOIN islands ON ($bs.islandid = islands.islandid)
348 WHERE commodid = ? LIMIT 1
351 my $delete= $dbh->prepare(<<'END');
352 DELETE FROM commods WHERE commodid = ?
356 while (my $row= $search->fetchrow_hashref()) {
357 next if defined $commods{$row->{'commodname'}};
358 print $any++ ? '; ' : " Dropping old commodities: ",
359 $row->{'commodname'};
360 foreach my $bs (qw(buy sell)) {
361 $check{$bs}->execute($row->{'commodid'});
362 my $problem= $check{$bs}->fetchrow_hashref();
373 $problem->{'islandname'}
374 $problem->{'stallname'}
375 $problem->{'qty'} at $problem->{'price'}
379 $delete->execute($row->{'commodid'});
382 db_check_referential_integrity();
386 #---------- vessel types ----------
388 my $idempotent= $dbh->prepare(<<'END')
389 INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
393 foreach my $name (sort keys %vessels) {
394 my $v= $vessels{$name};
395 my $shotdamage= $shotname2damage{$v->{Shot}};
396 die "no shot damage for shot $v->{Shot} for vessel $name"
397 unless defined $shotdamage;
398 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
399 $idempotent->execute(@qa);
404 #---------- compact IDs ----------
406 sub getminmax ($$$) {
407 my ($tab,$minmax,$f) = @_;
408 my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
410 my ($val)= $sth->fetchrow_array();
411 return defined($val) ? $val : '?';
414 foreach my $cp (@need_compact) {
415 print " Compacting $cp->{Table}";
416 my $tab= $cp->{Table};
418 my $tmp_field_specs= $cp->{FieldSpecs};
419 my $fields= join ',', @{$cp->{Fields}};
420 $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
421 die "$tab $tmp_field_specs ?";
423 CREATE TABLE aside_$tab (
424 new_$id INTEGER PRIMARY KEY NOT NULL,
427 INSERT INTO aside_$tab ($fields)
431 my $oldmax= getminmax($tab,'max',$id);
432 my $offset= $oldmax+1;
434 printf(" %s %s..%d=>1..%d:",
436 getminmax($tab,'min',$id),
438 getminmax("aside_$tab",'max',"new_$id"));
439 my @updates= @{ $cp->{Updates} };
441 my $utabs= shift @updates;
442 my $ufields= shift @updates;
443 foreach my $utab (@$utabs) {
446 foreach my $ufield (@$ufields) {
447 printf("%s%s",$fh,$ufield); $fh=',';
450 SET $ufield = $offset +
451 (SELECT new_$id FROM aside_$tab
452 WHERE aside_$tab.$id = $utab.$ufield);
454 SET $ufield = $ufield - $offset;
462 #---------- put it all into effect ----------
467 local $dbh->{AutoCommit} = 1;