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;
48 #---------- setup ----------
50 parse_info_serverside();
52 db_setocean($oceanname);
56 $dbh->trace(1) if $trace;
58 #---------- referential integrity constraints ----------
60 # SQLite doesn't support foreign key constraints so we do it by steam:
66 foreach my $stmt (split /\;/, $stmts) {
67 next unless $stmt =~ /\S/;
70 $stmt =~ s/^([ \t]*\#.*)$/ $etxt .= $1."\n"; ''; /mge;
71 $etxt= $letxt unless length $etxt;
74 $stmt =~ s/^\s+//; $stmt =~ s/\s+$//;
75 my $sth= $dbh->prepare($stmt);
79 my @cols= @{ $sth->{NAME_lc} };
81 while ($row= $sth->fetchrow_hashref) {
83 print STDERR "REFERENTIAL INTEGRITY ERROR\n";
84 print STDERR "\n$etxt\n $stmt\n\n";
85 printf STDERR "|%-${w}s", $_ foreach @cols; print STDERR "|\n";
86 print STDERR "+",('-'x$w) foreach @cols; print STDERR "+\n";
88 if ($ecount>5) { print STDERR "...\n"; last; }
89 printf STDERR "|%-$w.${w}s",
90 (defined $row->{$_} ? $row->{$_} : 'NULL')
99 die "REFERENTIAL INTEGRITY ERRORS $ekindcount\n"
103 sub check_referential_integrity () {
104 foreach my $bs (qw(buy sell)) {
107 # Every buy/sell must refer to an entry in commods, islands, and stalls:
108 SELECT * FROM $bs NATURAL LEFT JOIN commods WHERE commodname IS NULL;
109 SELECT * FROM $bs NATURAL LEFT JOIN islands WHERE islandname IS NULL;
110 SELECT * FROM $bs LEFT JOIN STALLS USING (stallid) WHERE stallname IS NULL;
112 # Every buy/sell must be part of an upload:
113 SELECT * FROM $bs NATURAL LEFT JOIN uploads WHERE timestamp IS NULL;
115 # The islandid in stalls must be the same as the islandid in buy/sell:
116 SELECT * FROM $bs JOIN stalls USING (stallid)
117 WHERE $bs.islandid != stalls.islandid;
121 foreach my $end (qw(aiid biid)) {
122 foreach my $tab (qw(dists routes)) {
125 # Every row in dists and routes must refer to two existing rows in islands:
126 SELECT * FROM $tab d LEFT JOIN islands ON (d.$end=islandid)
127 WHERE islandname IS NULL;
134 # Every pair of islands must have an entry in dists:
135 SELECT * FROM islands ia JOIN islands ib LEFT JOIN dists
136 ON (ia.islandid=aiid and ib.islandid=biid)
139 # Every stall and upload must refer to an island:
140 SELECT * FROM stalls NATURAL LEFT JOIN islands WHERE islandname IS NULL;
141 SELECT * FROM uploads NATURAL LEFT JOIN islands WHERE islandname IS NULL;
143 # Every commod which refers to a commodclass refers to an existing one:
144 SELECT * FROM commods WHERE commodclass NOT IN
145 (SELECT commodclass FROM commodclasses);
147 # There are no empty commodclasses:
148 SELECT * FROM commodclasses NATURAL LEFT JOIN commods
149 WHERE commodname IS NULL;
151 # Ordvals which are not zero are unique:
152 SELECT ordval,count(*) FROM COMMODS
153 WHERE ordval IS NOT NULL AND ordval != 0
161 check_referential_integrity();
165 #---------- schema ----------
167 foreach my $bs (qw(buy sell)) {
169 CREATE TABLE IF NOT EXISTS $bs (
170 commodid INTEGER NOT NULL,
171 islandid INTEGER NOT NULL,
172 stallid INTEGER NOT NULL,
173 price INTEGER NOT NULL,
174 qty INTEGER NOT NULL,
175 PRIMARY KEY (commodid, islandid, stallid)
177 CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
178 CREATE INDEX IF NOT EXISTS ${bs}_by_price ON $bs (commodid, price, islandid);
184 my ($table,$fields) = @_;
185 db_doall(" CREATE TABLE IF NOT EXISTS $table (\n$fields );");
187 my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
190 $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
193 my (@have_fields, @missing_fields);
194 my $have_field_specs='';
196 foreach my $fspec (split /,/, $fields) {
197 next unless $fspec =~ m/\S/;
198 $fspec =~ m/^\s*(\w+)\s+(\w.*\S)\s*$/ or die "$table $fspec ?";
199 my ($f,$spec) = ($1,$2);
200 if ($have_fields{$f}) {
201 push @have_fields, $f;
202 $have_field_specs .= ",\n" if length $have_field_specs;
203 $have_field_specs .= "\t$f\t\t$spec\n";
205 push @missing_fields, $f;
209 return unless @missing_fields;
210 print " Adding missing fields to $table: @missing_fields ...\n";
212 my $have_fields= join ',', @have_fields;
215 CREATE TEMPORARY TABLE aside_$table (
217 INSERT INTO aside_$table SELECT $have_fields FROM $table;
220 CREATE TABLE $table (
223 INSERT INTO $table ($have_fields) SELECT $have_fields FROM aside_$table;
225 DROP TABLE aside_$table;
229 table('commods', <<END);
230 commodid INTEGER PRIMARY KEY NOT NULL,
231 commodname TEXT UNIQUE NOT NULL,
239 table('commodclasses', <<END);
240 commodclass TEXT PRIMARY KEY NOT NULL,
245 CREATE TABLE IF NOT EXISTS islands (
246 islandid INTEGER PRIMARY KEY NOT NULL,
247 islandname TEXT UNIQUE NOT NULL,
248 archipelago TEXT NOT NULL
250 CREATE TABLE IF NOT EXISTS stalls (
251 stallid INTEGER PRIMARY KEY NOT NULL,
252 islandid INTEGER NOT NULL,
253 stallname TEXT NOT NULL,
254 UNIQUE (islandid, stallname)
256 CREATE TABLE IF NOT EXISTS uploads (
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
263 CREATE TABLE IF NOT EXISTS dists (
264 aiid INTEGER NOT NULL,
265 biid INTEGER NOT NULL,
266 dist INTEGER NOT NULL,
267 PRIMARY KEY (aiid, biid)
269 CREATE TABLE IF NOT EXISTS routes (
270 aiid INTEGER NOT NULL,
271 biid INTEGER NOT NULL,
272 dist INTEGER NOT NULL,
273 PRIMARY KEY (aiid, biid)
275 CREATE TABLE IF NOT EXISTS vessels (
277 mass INTEGER NOT NULL,
278 volume INTEGER NOT NULL,
279 shot INTEGER NOT NULL,
287 #---------- commodity list ----------
289 sub commodsortkey ($) {
291 my $ordval= $commods{$commod}{Ordval};
292 return sprintf "B %20d", $ordval if defined $ordval;
293 return sprintf "A %s", $commod;
297 my $insert= $dbh->prepare(<<'END')
298 INSERT OR IGNORE INTO commods
305 my $setsizes= $dbh->prepare(<<'END')
312 my $setordval= $dbh->prepare(<<'END')
318 my $setclass= $dbh->prepare(<<'END')
324 my $setinclass= $dbh->prepare(<<'END')
331 foreach my $commod (sort {
332 commodsortkey($a) cmp commodsortkey($b)
334 my $c= $commods{$commod};
335 die "no mass for $commod" unless defined $c->{Mass};
336 die "no volume for $commod" unless defined $c->{Volume};
338 my @qa= ($c->{Mass}, $c->{Volume}, $commod);
339 $insert->execute(@qa);
340 $setsizes->execute(@qa);
341 $setordval->execute($c->{Ordval} || 0, $commod);
343 $setclass->execute($cl, $commod);
345 if (defined $c->{Ordval} and defined $cl) {
347 $setinclass->execute($incl{$cl}, $commod);
351 DELETE FROM commodclasses;
353 my $addclass= $dbh->prepare(<<'END')
354 INSERT INTO commodclasses
359 foreach my $cl (sort keys %incl) {
360 $addclass->execute($cl, $incl{$cl});
365 #---------- vessel types ----------
367 my $idempotent= $dbh->prepare(<<'END')
368 INSERT OR REPLACE INTO vessels (name, shot, mass, volume)
372 foreach my $name (sort keys %vessels) {
373 my $v= $vessels{$name};
374 my $shotdamage= $shotname2damage{$v->{Shot}};
375 die "no shot damage for shot $v->{Shot} for vessel $name"
376 unless defined $shotdamage;
377 my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
378 $idempotent->execute(@qa);