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;
49 #---------- setup ----------
51 parse_info_serverside();
53 db_setocean($oceanname);
57 $dbh->trace(1) if $trace;
60 #---------- schema update code ----------
65 my ($table, $fields) = @_;
66 table_maycompact($table,undef,undef,$fields);
69 sub table_maycompact ($$$$) {
70 my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
72 #----- parse $fields -----
78 foreach my $fspec (split /\n/, $fields) {
79 next unless $fspec =~ m/\S/;
80 if ($fspec =~ m/^\s*\+/) {
81 push @want_field_specs, "\t".$';
83 } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) {
84 my ($f,$spaces,$rhs) = ($1,$2,$3);
85 my $spec= "\t".$f.$spaces.$rhs;
86 push @want_fields, $f;
87 push @want_field_specs, $spec;
88 $want_field_specs{$f}= $spec;
90 die "$table $fspec ?";
94 my $want_field_specs= join ",\n", @want_field_specs;
96 #----- ensure table exists -----
99 CREATE TABLE IF NOT EXISTS $table (
105 #----- check whether we need to remove autoinc -----
107 if ($fields !~ /\bautoinc/i) {
108 my $autoinc= $dbh->prepare(<<END);
109 SELECT sql FROM sqlite_master
110 WHERE type='table' and name=? and tbl_name=?
112 $autoinc->execute($table,$table);
113 my ($sql)= $autoinc->fetchrow_array();
114 die unless defined $sql;
115 push @need_recreate, 'remove autoinc'
116 if $sql =~ m/\bautoinc/i;
119 #----- check whether we need to add fields -----
121 my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
124 $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
128 my @have_field_specs;
130 foreach my $f (@want_fields) {
131 if ($have_fields{$f}) {
132 push @have_fields, $f;
133 push @have_field_specs, $want_field_specs{$f};
135 push @need_recreate, "field $f";
139 #----- Do we need to recreate ? -----
140 return unless @need_recreate;
143 print " Recreating $table:\n";
144 print " $_\n" foreach @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 ? -----
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
284 my $setsizes= $dbh->prepare(<<'END')
291 my $setordval= $dbh->prepare(<<'END')
297 my $setclass= $dbh->prepare(<<'END')
303 my $setinclass= $dbh->prepare(<<'END')
310 foreach my $commod (sort {
311 commodsortkey($a) cmp commodsortkey($b)
313 my $c= $commods{$commod};
314 die "no mass for $commod" unless defined $c->{Mass};
315 die "no volume for $commod" unless defined $c->{Volume};
317 my @qa= ($c->{Mass}, $c->{Volume}, $commod);
318 $insert->execute(@qa);
319 $setsizes->execute(@qa);
320 $setordval->execute($c->{Ordval} || 0, $commod);
322 $setclass->execute($cl, $commod);
324 if (defined $c->{Ordval} and defined $cl) {
326 $setinclass->execute($incl{$cl}, $commod);
327 } elsif (defined $cl) {
332 DELETE FROM commodclasses;
334 my $addclass= $dbh->prepare(<<'END')
335 INSERT INTO commodclasses
340 foreach my $cl (sort keys %incl) {
341 $addclass->execute($cl, $incl{$cl});
346 #---------- vessel types ----------
348 my $idempotent= $dbh->prepare(<<'END')
349 INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
353 foreach my $name (sort keys %vessels) {
354 my $v= $vessels{$name};
355 my $shotdamage= $shotname2damage{$v->{Shot}};
356 die "no shot damage for shot $v->{Shot} for vessel $name"
357 unless defined $shotdamage;
358 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
359 $idempotent->execute(@qa);
364 #---------- put it all into effect ----------
367 local $dbh->{AutoCommit} = 1;
368 print " Vacuuming.\n";