chiark / gitweb /
panner is a proper package
[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 END
233
234 table_maycompact('islands', 'islandid',
235                  [ [ qw(buy sell stalls uploads) ], [ qw(islandid) ], 
236                    [ qw(dists routes) ], [ qw(aiid biid) ], 
237  ], <<END);
238         islandid        INTEGER PRIMARY KEY     NOT NULL
239         islandname      TEXT    UNIQUE          NOT NULL
240         archipelago     TEXT                    NOT NULL
241 END
242
243 table('stalls', <<END);
244         stallid         INTEGER PRIMARY KEY     NOT NULL
245         islandid        INTEGER                 NOT NULL
246         stallname       TEXT                    NOT NULL
247         + UNIQUE (islandid, stallname)
248 END
249
250 table('commodclasses', <<END);
251         commodclassid   INTEGER PRIMARY KEY     NOT NULL
252         commodclass     TEXT    UNIQUE          NOT NULL
253         maxposinclass   INTEGER                 NOT NULL
254 END
255
256 table('uploads', <<END);
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
262 END
263
264 table('dists', <<END);
265         aiid            INTEGER                 NOT NULL
266         biid            INTEGER                 NOT NULL
267         dist            INTEGER                 NOT NULL
268         + PRIMARY KEY (aiid, biid)
269 END
270
271 table('routes', <<END);
272         aiid            INTEGER                 NOT NULL
273         biid            INTEGER                 NOT NULL
274         dist            INTEGER                 NOT NULL
275         + PRIMARY KEY (aiid, biid)
276 END
277
278 table('vessels', <<END);
279         name            TEXT                    NOT NULL
280         mass            INTEGER                 NOT NULL
281         volume          INTEGER                 NOT NULL
282         shot            INTEGER                 NOT NULL
283         + PRIMARY KEY (name)
284 END
285
286
287 #---------- commodity list ----------
288
289 sub commodsortkey ($) {
290     my ($commod) = @_;
291     return $commods{$commod}{Ordval} ||
292            $commods{$commod}{ClassOrdval};
293 }
294 sub commods_ordered () {
295     sort {
296         commodsortkey($a) <=> commodsortkey($b);
297     } keys %commods;
298 }
299
300 our %posincl;
301
302 {
303     my %classorderedcount;
304
305     foreach my $cl (keys %commodclasses) {
306         $classorderedcount{$cl}= 0;
307     }
308     foreach my $commod (commods_ordered()) {
309         my $cl= $commods{$commod}{Class};
310         die "no class for commodity $commod" unless defined $cl;
311
312         my $clid= $commodclasses{$cl};
313         die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid;
314
315         if (defined $commods{$commod}{Ordval}) {
316             $posincl{$commod}= ++$classorderedcount{$cl};
317         } else {
318             $posincl{$commod}= 0;
319         }
320     }
321
322     db_doall(<<END);
323  DELETE FROM $table{commodclasses};
324 END
325     my $addclass= $dbh->prepare(<<END);
326  INSERT INTO $table{commodclasses}
327      (commodclassid, commodclass, maxposinclass)
328      VALUES (?,?,?)
329 END
330     foreach my $cl (sort keys %commodclasses) {
331         my $clname= $cl;
332         $clname =~ s/_/ /g;
333         $addclass->execute($commodclasses{$cl}+1,
334                            ucfirst $clname,
335                            $classorderedcount{$cl});
336     }
337 }
338
339 {
340     my @valuefields= qw(
341                         unitmass
342                         unitvolume
343                         commodclassid
344                         ordval
345                         posinclass
346                         );
347     my $insert= $dbh->prepare("
348  INSERT OR IGNORE INTO $table{commods}
349       ( commodname,
350         ".join(",
351         ", @valuefields)." )
352      VALUES (?,".join(',', map {'?'} @valuefields).")
353 ");
354     my $update= $dbh->prepare("
355  UPDATE $table{commods}
356      SET ".join(",
357         ", map { "$_ = ?" } @valuefields)."
358      WHERE commodname = ?
359 ");
360     foreach my $commod (commods_ordered()) {
361         my $c= $commods{$commod};
362         die "no mass for $commod" unless defined $c->{Mass};
363         die "no volume for $commod" unless defined $c->{Volume};
364         
365         my $cl= $c->{Class};
366         my $clid= $commodclasses{$cl}+1;
367
368         my @valuevalues= (
369                           $c->{Mass},
370                           $c->{Volume},
371                           $clid,
372                           commodsortkey($commod),
373                           $posincl{$commod}
374                           );
375         $insert->execute($commod, @valuevalues);
376         $update->execute(@valuevalues, $commod);
377     }
378
379     my $search= $dbh->prepare(<<END);
380  SELECT commodname,commodid FROM $table{commods};
381 END
382     my %check;
383     foreach my $bs (qw(buy sell)) {
384         $check{$bs}= $dbh->prepare(<<END);
385  SELECT islandname,stallname,price,qty
386    FROM $table{$bs}
387    JOIN $table{stalls} USING (stallid)
388    JOIN $table{islands} ON ($bs.islandid = $table{islands}.islandid)
389    WHERE commodid = ? LIMIT 1
390 END
391     }
392     my $delete= $dbh->prepare(<<END);
393  DELETE FROM $table{commods} WHERE commodid = ?
394 END
395     $search->execute();
396     my $any=0;
397     while (my $row= $search->fetchrow_hashref()) {
398         next if defined $commods{$row->{'commodname'}};
399         print $any++ ? '; ' : "    Dropping old commodities: ",
400               $row->{'commodname'};
401         foreach my $bs (qw(buy sell)) {
402             $check{$bs}->execute($row->{'commodid'});
403             my $problem= $check{$bs}->fetchrow_hashref();
404             if ($problem) {
405                 print "\n";
406                 die <<END
407
408 FATAL ERROR
409     Removed commodity
410        $row->{'commodid'}
411        $row->{'commodname'}
412     but
413        $bs
414        $problem->{'islandname'}
415        $problem->{'stallname'}
416        $problem->{'qty'} at $problem->{'price'}
417 END
418             }
419         }
420         $delete->execute($row->{'commodid'});
421     }
422     print ".\n" if $any;
423 }
424
425 #---------- vessel types ----------
426 {
427     my $idempotent= $dbh->prepare(<<END)
428  INSERT OR REPLACE INTO $table{vessels}
429         (name, shot, mass, volume)
430         VALUES (?,?,?,?)
431 END
432     ;
433     foreach my $name (sort keys %vessels) {
434         my $v= $vessels{$name};
435         my $shotdamage= $shotname2damage{$v->{Shot}};
436         die "no shot damage for shot $v->{Shot} for vessel $name"
437             unless defined $shotdamage;
438         my @qa= ($name, $shotdamage, map { $v->{$_} } qw(Mass Volume));
439         $idempotent->execute(@qa);
440     }
441 }
442
443 #---------- transfer data back from any recreated tables ----------
444
445 foreach my $tb (@need_transfer_back) {
446     my $tab= $tb->{Table};
447     print "    Retransferring $tab...";
448
449     if (!eval {
450         db_doall($tb->{Sql});
451         1;
452     }) {
453         my $emsg= $@;
454         my $w=20;
455         print STDERR "\n=== $tab retransfer failed, dumping:\n";
456         my $dumph= $dbh->prepare("SELECT * FROM aside_$tab");
457         $dumph->execute();
458         my @cols= @{ $dumph->{NAME_lc} };
459         dumptab_head(\*STDERR,$w,\@cols);
460         my $row;
461         while ($row= $dumph->fetchrow_hashref()) {
462             dumptab_row_hashref(\*STDERR,$w,\@cols,$row);
463         }
464         die "\n$emsg";
465     }
466     print "\n";
467     $table{$tab}= $tab;
468 }
469
470 #---------- create indices ----------
471
472 foreach my $bs (qw(buy sell)) {
473     db_doall(<<END)
474  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
475  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
476 END
477     ;
478 }
479
480 db_check_referential_integrity(1);
481
482 #---------- compact IDs ----------
483
484 sub getminmax ($$$) {
485     my ($tab,$minmax,$f) = @_;
486     my $sth= $dbh->prepare("SELECT $minmax($f) FROM $tab");
487     $sth->execute();
488     my ($val)= $sth->fetchrow_array();
489     return defined($val) ? $val : '?';
490 }
491
492 foreach my $cp (@need_compact) {
493     print "    Compacting $cp->{Table}";
494     my $tab= $cp->{Table};
495     my $id= $cp->{Id};
496     my $tmp_field_specs= $cp->{FieldSpecs};
497     my $fields= join ',', @{$cp->{Fields}};
498     $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or
499         die "$tab $tmp_field_specs ?";
500     db_doall(<<END);
501  CREATE TEMPORARY TABLE idlookup_$tab (
502         new_$id         INTEGER PRIMARY KEY NOT NULL,
503 $tmp_field_specs
504  );
505  INSERT INTO idlookup_$tab ($fields)
506         SELECT $fields
507         FROM $tab;
508 END
509     my $oldmax= getminmax($tab,'max',$id);
510     my $offset= $oldmax+1;
511     
512     printf(" %s %s..%d=>1..%d:",
513            $cp->{Id},
514            getminmax($tab,'min',$id),
515            $oldmax,
516            getminmax("idlookup_$tab",'max',"new_$id"));
517     my @updates= @{ $cp->{Updates} };
518     while (@updates) {
519         my $utabs= shift @updates;
520         my $ufields= shift @updates;
521         foreach my $utab (@$utabs) {
522             printf(" %s",$utab);
523             my $fh= '.';
524             foreach my $ufield (@$ufields) {
525                 printf("%s%s",$fh,$ufield); $fh=',';
526                 db_doall(<<END);
527  UPDATE $utab
528     SET $ufield = $offset +
529         (SELECT new_$id FROM idlookup_$tab
530           WHERE idlookup_$tab.$id = $utab.$ufield);
531  UPDATE $utab
532     SET $ufield = $ufield - $offset;
533 END
534             }
535         }
536     }
537     print "\n";
538 }
539
540 #---------- put it all into effect ----------
541
542 db_chkcommit(1);
543
544 {
545     local $dbh->{AutoCommit} = 1;
546     $dbh->do('VACUUM');
547 }