chiark / gitweb /
cope with unknown vessels by turning them unto zz vcunk
[ypp-sc-tools.db-live.git] / yarrg / db-idempotent-populate
1 #!/usr/bin/perl -w
2 #
3 # Normally run from
4 #  update-master-info
5 #
6 # usage: ./db-idempotent-populate <Oceanname>
7 #  creates or updates OCEAN-Oceanname.db
8 #  from source-info.txt
9
10 # This is part of the YARRG website.  YARRG is a tool and website
11 # for assisting players of Yohoho Puzzle Pirates.
12 #
13 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
14 #
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.
19 #
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.
24 #
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/>.
27 #
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.
31
32 use strict (qw(vars));
33
34 use DBI;
35
36 use Commods;
37 use CommodsDatabase;
38
39 my $trace=0;
40 while (@ARGV and $ARGV[0] eq '-D') {
41         $trace++;
42         shift @ARGV;
43 }
44
45 @ARGV==1 or die;
46 my ($oceanname) = @ARGV;
47
48 $|=1;
49
50 #---------- setup ----------
51
52 parse_info_serverside();
53
54 db_setocean($oceanname);
55 db_writer();
56 db_connect();
57
58 $dbh->trace(1) if $trace;
59
60
61 #---------- schema update code ----------
62
63 our @need_compact;
64 our @need_transfer_back;
65
66 our %table;
67
68 sub table ($$) {
69     my ($table, $fields) = @_;
70     table_maycompact($table,undef,undef,$fields);
71 }
72
73 sub table_maycompact ($$$$) {
74     my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_;
75
76     #----- parse $fields -----
77
78     my @want_fields;
79     my @want_field_specs;
80     my %want_field_specs;
81
82     foreach my $fspec (split /\n/, $fields) {
83         next unless $fspec =~ m/\S/;
84         if ($fspec =~ m/^\s*\+/) {
85             push @want_field_specs, "\t".$';
86             next;
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;
93         } else {
94             die "$table $fspec ?";
95         }
96     }
97
98     my $want_field_specs= join ",\n", @want_field_specs;
99
100     #----- ensure table exists -----
101
102     db_doall(<<END);
103  CREATE TABLE IF NOT EXISTS $table (
104 $want_field_specs
105         );
106 END
107     my @need_recreate;
108
109     #----- check whether we need to remove autoinc -----
110
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=?
115 END
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;
121     }
122
123     #----- check whether we need to add fields -----
124
125     my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1");
126     $check->execute();
127     my %have_fields;
128     $have_fields{$_}=1 foreach @{ $check->{NAME_lc} };
129     $check->finish();
130
131     my @have_fields;
132     my @aside_fields;
133     my @have_field_specs;
134     my @aside_field_specs;
135
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};
140         } else {
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;
145             $aside =~ s/\s+$//;
146             push @aside_fields, $f;
147             push @aside_field_specs, $aside;
148             push @need_recreate, "field $f";
149         }
150     }
151
152     #----- Do we need to recreate ? -----
153     if (!@need_recreate) {
154         $table{$table}= $table;
155         return;
156     }
157     #----- Yes, recreate: -----
158
159     print "    Recreating $table: ", join('; ',@need_recreate);
160     $table{$table}= "aside_$table";
161
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;
166
167     db_doall(<<END);
168  CREATE TEMPORARY TABLE aside_$table (
169 $aside_field_specs
170         );
171  INSERT INTO aside_$table ($have_fields) 
172         SELECT $have_fields FROM $table;
173
174  DROP TABLE $table;
175 END
176
177     push @need_transfer_back, {
178         Table => $table,
179         Sql => <<END
180  CREATE TABLE $table (
181 $want_field_specs
182         );
183
184  INSERT INTO $table ($aside_fields) SELECT $aside_fields FROM aside_$table;
185
186  DROP TABLE aside_$table;
187 END
188     };
189     
190     #----- Do we need to compact ids ? -----
191     (print(".\n"), return) unless
192         defined $cpact_idfield
193         and grep { m/^remove autoinc/ } @need_recreate;
194     # yes:
195
196     print "; will compact.\n";
197     unshift @$cpact_needupdates, [ $table ], [ $cpact_idfield ];
198
199     push @need_compact, {
200         Table => $table,
201         Id => $cpact_idfield,
202         Updates => $cpact_needupdates,
203         Fields => [ @want_fields ],
204         FieldSpecs => $want_field_specs
205         };
206 }
207
208
209 #---------- actual schema ----------
210
211 foreach my $bs (qw(buy sell)) {
212     table($bs,<<END);
213         commodid        INTEGER                 NOT NULL
214         islandid        INTEGER                 NOT NULL
215         stallid         INTEGER                 NOT NULL
216         price           INTEGER                 NOT NULL
217         qty             INTEGER                 NOT NULL
218         + PRIMARY KEY (commodid, islandid, stallid)
219 END
220 }
221
222 table_maycompact('commods', 'commodid',
223                  [ [ qw(buy sell) ], [ qw(commodid) ],
224  ], <<END);
225         commodid        INTEGER PRIMARY KEY     NOT NULL
226         commodname      TEXT    UNIQUE          NOT NULL
227         unitmass        INTEGER
228         unitvolume      INTEGER
229         commodclassid   INTEGER                 NOT NULL
230         ordval          INTEGER                 NOT NULL
231         posinclass      INTEGER                 NOT NULL
232         flags           TEXT                    NOT NULL
233 END
234
235 table_maycompact('islands', 'islandid',
236                  [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ], 
237                    [ qw(dists routes) ], [ qw(aiid biid) ], 
238  ], <<END);
239         islandid        INTEGER PRIMARY KEY     NOT NULL
240         islandname      TEXT    UNIQUE          NOT NULL
241         archipelago     TEXT                    NOT NULL
242 END
243
244 table('stalls', <<END);
245         stallid         INTEGER PRIMARY KEY     NOT NULL
246         islandid        INTEGER                 NOT NULL
247         stallname       TEXT                    NOT NULL
248         + UNIQUE (islandid, stallname)
249 END
250
251 table('commodclasses', <<END);
252         commodclassid   INTEGER PRIMARY KEY     NOT NULL
253         commodclass     TEXT    UNIQUE          NOT NULL
254         maxposinclass   INTEGER                 NOT NULL
255 END
256
257 table('uploads', <<END);
258         islandid        INTEGER PRIMARY KEY     NOT NULL
259         timestamp       INTEGER                 NOT NULL
260         message         TEXT                    NOT NULL
261         clientspec      TEXT                    NOT NULL
262         serverspec      TEXT                    NOT NULL
263 END
264
265 table('dists', <<END);
266         aiid            INTEGER                 NOT NULL
267         biid            INTEGER                 NOT NULL
268         dist            INTEGER                 NOT NULL
269         + PRIMARY KEY (aiid, biid)
270 END
271
272 table('routes', <<END);
273         aiid            INTEGER                 NOT NULL
274         biid            INTEGER                 NOT NULL
275         dist            INTEGER                 NOT NULL
276         + PRIMARY KEY (aiid, biid)
277 END
278
279 table('vessels', <<END);
280         name            TEXT                    NOT NULL
281         mass            INTEGER                 NOT NULL
282         volume          INTEGER                 NOT NULL
283         shot            INTEGER                 NOT NULL
284         + PRIMARY KEY (name)
285 END
286
287
288 #---------- commodity list ----------
289
290 sub commodsortkey ($) {
291     my ($commod) = @_;
292     return $commods{$commod}{Ordval} ||
293            $commods{$commod}{ClassOrdval};
294 }
295 sub commods_ordered () {
296     sort {
297         commodsortkey($a) <=> commodsortkey($b);
298     } keys %commods;
299 }
300
301 our %posincl;
302
303 {
304     my %classorderedcount;
305
306     foreach my $cl (keys %commodclasses) {
307         $classorderedcount{$cl}= 0;
308     }
309     foreach my $commod (commods_ordered()) {
310         my $cl= $commods{$commod}{Class};
311         die "no class for commodity $commod" unless defined $cl;
312
313         my $clid= $commodclasses{$cl};
314         die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
315
316         if (defined $commods{$commod}{Ordval}) {
317             $posincl{$commod}= ++$classorderedcount{$cl};
318         } else {
319             $posincl{$commod}= 0;
320         }
321     }
322
323     db_doall(<<END);
324  DELETE FROM $table{commodclasses};
325 END
326     my $addclass= $dbh->prepare(<<END);
327  INSERT INTO $table{commodclasses}
328      (commodclassid, commodclass, maxposinclass)
329      VALUES (?,?,?)
330 END
331     foreach my $cl (sort keys %commodclasses) {
332         my $clname= $cl;
333         $clname =~ s/_/ /g;
334         $addclass->execute($commodclasses{$cl}+1,
335                            ucfirst $clname,
336                            $classorderedcount{$cl});
337     }
338 }
339
340 {
341     my @valuefields= qw(
342                         unitmass
343                         unitvolume
344                         commodclassid
345                         ordval
346                         posinclass
347                         flags
348                         );
349     my $insert= $dbh->prepare("
350  INSERT OR IGNORE INTO $table{commods}
351       ( commodname,
352         ".join(",
353         ", @valuefields)." )
354      VALUES (?,".join(',', map {'?'} @valuefields).")
355 ");
356     my $update= $dbh->prepare("
357  UPDATE $table{commods}
358      SET ".join(",
359         ", map { "$_ = ?" } @valuefields)."
360      WHERE commodname = ?
361 ");
362     foreach my $commod (commods_ordered()) {
363         my $c= $commods{$commod};
364         die "no mass for $commod" unless defined $c->{Mass};
365         die "no volume for $commod" unless defined $c->{Volume};
366         
367         my $cl= $c->{Class};
368         my $clid= $commodclasses{$cl}+1;
369
370         my @valuevalues= (
371                           $c->{Mass},
372                           $c->{Volume},
373                           $clid,
374                           commodsortkey($commod),
375                           $posincl{$commod},
376                           $c->{Flags}
377                           );
378         $insert->execute($commod, @valuevalues);
379         $update->execute(@valuevalues, $commod);
380     }
381
382     my $search= $dbh->prepare(<<END);
383  SELECT commodname,commodid FROM $table{commods};
384 END
385     my %check;
386     foreach my $bs (qw(buy sell)) {
387         $check{$bs}= $dbh->prepare(<<END);
388  SELECT islandname,stallname,price,qty
389    FROM $table{$bs}
390    JOIN $table{stalls} USING (stallid)
391    JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
392    WHERE commodid = ? LIMIT 1
393 END
394     }
395     my $delete= $dbh->prepare(<<END);
396  DELETE FROM $table{commods} WHERE commodid = ?
397 END
398     $search->execute();
399     my $any=0;
400     while (my $row= $search->fetchrow_hashref()) {
401         next if defined $commods{$row->{'commodname'}};
402         print $any++ ? '; ' : "    Dropping old commodities: ",
403               $row->{'commodname'};
404         foreach my $bs (qw(buy sell)) {
405             $check{$bs}->execute($row->{'commodid'});
406             my $problem= $check{$bs}->fetchrow_hashref();
407             if ($problem) {
408                 print "\n";
409                 die <<END
410
411 FATAL ERROR
412     Removed commodity
413        $row->{'commodid'}
414        $row->{'commodname'}
415     but
416        $bs
417        $problem->{'islandname'}
418        $problem->{'stallname'}
419        $problem->{'qty'} at $problem->{'price'}
420 END
421             }
422         }
423         $delete->execute($row->{'commodid'});
424     }
425     print ".\n" if $any;
426 }
427
428 #---------- vessel types ----------
429 {
430     my $idempotent= $dbh->prepare(<<END)
431  INSERT OR REPLACE INTO $table{vessels}
432         (name, shot, mass, volume)
433         VALUES (?,?,?,?)
434 END
435     ;
436     foreach my $name (sort keys %vessels) {
437         my $v= $vessels{$name};
438         my $shotdamage= $shotname2damage{$v->{Shot}};
439         die "no shot damage for shot $v->{Shot} for vessel $name"
440             unless defined $shotdamage;
441         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
442         $idempotent->execute(@qa);
443     }
444 }
445
446 #---------- transfer data back from any recreated tables ----------
447
448 foreach my $tb (@need_transfer_back) {
449     my $tab= $tb->{Table};
450     print "    Retransferring $tab...";
451
452     if (!eval {
453         db_doall($tb->{Sql});
454         1;
455     }) {
456         my $emsg= $@;
457         my $w=20;
458         print STDERR "\n=== $tab retransfer failed, dumping:\n";
459         my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
460         $dumph->execute();
461         my @cols= @{ $dumph->{NAME_lc} };
462         dumptab_head(\*STDERR,$w,\@cols);
463         my $row;
464         while ($row= $dumph->fetchrow_hashref()) {
465             dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
466         }
467         die "\n$emsg";
468     }
469     print "\n";
470     $table{$tab}= $tab;
471 }
472
473 #---------- create indices ----------
474
475 foreach my $bs (qw(buy sell)) {
476     db_doall(<<END)
477  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
478  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
479 END
480     ;
481 }
482
483 db_check_referential_integrity(1);
484
485 #---------- compact IDs ----------
486
487 sub getminmax ($$$) {
488     my ($tab,$minmax,$f) = @_;
489     my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
490     $sth->execute();
491     my ($val)= $sth->fetchrow_array();
492     return defined($val) ? $val : '?';
493 }
494
495 foreach my $cp (@need_compact) {
496     print "    Compacting $cp->{Table}";
497     my $tab= $cp->{Table};
498     my $id= $cp->{Id};
499     my $tmp_field_specs= $cp->{FieldSpecs};
500     my $fields= join ',', @{$cp->{Fields}};
501     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
502         die "$tab $tmp_field_specs ?";
503     db_doall(<<END);
504  CREATE TEMPORARY TABLE idlookup_$tab (
505         new_$id         INTEGER PRIMARY KEY NOT NULL,
506 $tmp_field_specs
507  );
508  INSERT INTO idlookup_$tab ($fields)
509         SELECT $fields
510         FROM $tab;
511 END
512     my $oldmax= getminmax($tab,'max',$id);
513     my $offset= $oldmax+1;
514     
515     printf(" %s %s..%d=>1..%d:",
516            $cp->{Id},
517            getminmax($tab,'min',$id),
518            $oldmax,
519            getminmax("idlookup_$tab",'max',"new_$id"));
520     my @updates= @{ $cp->{Updates} };
521     while (@updates) {
522         my $utabs= shift @updates;
523         my $ufields= shift @updates;
524         foreach my $utab (@$utabs) {
525             printf(" %s",$utab);
526             my $fh= '.';
527             foreach my $ufield (@$ufields) {
528                 printf("%s%s",$fh,$ufield); $fh=',';
529                 db_doall(<<END);
530  UPDATE $utab
531     SET $ufield = $offset +
532         (SELECT new_$id FROM idlookup_$tab
533           WHERE idlookup_$tab.$id = $utab.$ufield);
534  UPDATE $utab
535     SET $ufield = $ufield - $offset;
536 END
537             }
538         }
539     }
540     print "\n";
541 }
542
543 #---------- put it all into effect ----------
544
545 db_chkcommit(1);
546
547 {
548     local $dbh->{AutoCommit} = 1;
549     $dbh->do('VACUUM');
550 }