chiark / gitweb /
Found a bug with circular routes
[ypp-sc-tools.db-live.git] / yarrg / db-idempotent-populate
1 #!/usr/bin/perl -w
2 #
3 # usage: ./db-idempotent-populate <Oceanname>
4 #  creates or updates OCEAN-Oceanname.db
5 #  from master-master.txt
6
7 # This is part of ypp-sc-tools, a set of third-party tools for assisting
8 # players of Yohoho Puzzle Pirates.
9 #
10 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
11 #
12 # This program is free software: you can redistribute it and/or modify
13 # it under the terms of the GNU General Public License as published by
14 # the Free Software Foundation, either version 3 of the License, or
15 # (at your option) any later version.
16 #
17 # This program is distributed in the hope that it will be useful,
18 # but WITHOUT ANY WARRANTY; without even the implied warranty of
19 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20 # GNU General Public License for more details.
21 #
22 # You should have received a copy of the GNU General Public License
23 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
24 #
25 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
26 # are used without permission.  This program is not endorsed or
27 # sponsored by Three Rings.
28
29 use strict (qw(vars));
30
31 use DBI;
32
33 use Commods;
34 use CommodsDatabase;
35
36 @ARGV==1 or die;
37 my ($oceanname) = @ARGV;
38
39 #---------- setup ----------
40
41 parse_info_serverside();
42 parse_info_serverside_ocean($oceanname);
43 our $ocean= $oceans{$oceanname};
44
45 db_setocean($oceanname);
46 db_writer();
47 db_connect();
48
49 #---------- schema ----------
50
51 foreach my $bs (qw(buy sell)) {
52     db_doall(<<END)
53  CREATE TABLE IF NOT EXISTS $bs (
54         commodid        INTEGER                 NOT NULL,
55         islandid        INTEGER                 NOT NULL,
56         stallid         INTEGER                 NOT NULL,
57         price           INTEGER                 NOT NULL,
58         qty             INTEGER                 NOT NULL,
59         PRIMARY KEY (commodid, islandid, stallid)
60  );
61  CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
62  CREATE INDEX IF NOT EXISTS ${bs}_by_price  ON $bs (commodid, price, islandid);
63 END
64     ;
65 }
66
67 db_doall(<<END)
68  CREATE TABLE IF NOT EXISTS commods (
69         commodid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
70         commodname      TEXT    UNIQUE          NOT NULL,
71         unitmass        INTEGER,
72         unitvolume      INTEGER
73  );
74  CREATE TABLE IF NOT EXISTS islands (
75         islandid        INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
76         islandname      TEXT    UNIQUE          NOT NULL,
77         archipelago     TEXT                    NOT NULL
78  );
79  CREATE TABLE IF NOT EXISTS stalls (
80         stallid         INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,
81         islandid        INTEGER                 NOT NULL,
82         stallname       TEXT                    NOT NULL,
83         UNIQUE (islandid, stallname)
84  );
85  CREATE TABLE IF NOT EXISTS uploads (
86         islandid        INTEGER PRIMARY KEY     NOT NULL,
87         timestamp       INTEGER                 NOT NULL,
88         message         TEXT                    NOT NULL,
89         clientspec      TEXT                    NOT NULL,
90         serverspec      TEXT                    NOT NULL
91  );
92  CREATE TABLE IF NOT EXISTS dists (
93         aiid            INTEGER                 NOT NULL,
94         biid            INTEGER                 NOT NULL,
95         dist            INTEGER                 NOT NULL,
96         PRIMARY KEY (aiid, biid)
97  );
98 END
99     ;
100
101 $dbh->commit;
102
103 #---------- commodity list ----------
104
105 {
106     my $insert= $dbh->prepare(<<'END')
107  INSERT OR IGNORE INTO commods
108      (unitmass,
109       unitvolume,
110       commodname)
111      VALUES (?,?,?);
112 END
113     ;
114     my $update= $dbh->prepare(<<'END')
115  UPDATE commods
116      SET unitmass = ?,
117          unitvolume = ?
118      WHERE commodname = ?
119 END
120     ;
121     foreach my $commod (sort keys %commods) {
122         my $c= $commods{$commod};
123         die "no mass for $commod" unless defined $c->{Mass};
124         die "no colume for $commod" unless defined $c->{Volume};
125         my @qa= ($c->{Mass}, $c->{Volume}, $commod);
126         $insert->execute(@qa);
127         $update->execute(@qa);
128     }
129     $dbh->commit;
130 }
131
132 #---------- island list ----------
133
134 {
135     my $sth= $dbh->prepare(<<'END')
136  INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
137 END
138     ;
139     foreach my $archname (sort keys %$ocean) {
140         my $arch= $ocean->{$archname};
141         foreach my $islandname (sort keys %$arch) {
142             $sth->execute($islandname, $archname);
143         }
144     }
145     $dbh->commit;
146 }
147
148 #---------- routes ----------
149
150 {
151     foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
152         warn "$route_mysteries{$oceanname}{$islandname} routes".
153             " for unknown island $islandname\n";
154     }
155
156     my $allroutes= $routes{$oceanname};
157
158     my @propqueue= ();
159
160     sub distance_set_propagate ($$$$) {
161         my ($lev, $start, $upto, $start2upto) = @_;
162         $allroutes->{$start}{$upto}= $start2upto;
163         push @propqueue, [ $lev, $start, $upto ];
164     }
165
166     sub distance_propagate_now {
167         my ($lev, $start, $upto) = @_;
168         my $startref= $allroutes->{$start};
169         my $start2upto= $startref->{$upto};
170         my $uptoref=  $allroutes->{$upto};
171
172         for my $next (keys %$uptoref) {
173             next if $next eq $upto;
174             my $unext= $uptoref->{$next};
175             next unless defined $unext;
176             distance_update("${lev}p", $start, $next, $start2upto + $unext);
177         }
178     }
179
180     sub distance_update ($$$$) {
181         my ($lev, $x, $y, $newdist) = @_;
182         distance_update_one("${lev}x",$x,$y,$newdist);
183         distance_update_one("${lev}y",$y,$x,$newdist);
184     }
185
186     sub distance_update_one ($$$$) {
187         my ($lev, $x, $y, $newdist) = @_;
188         my $xref= $allroutes->{$x};
189         my $currently= $xref->{$y};
190         return if defined($currently) and $currently <= $newdist;
191         distance_set_propagate("${lev}o",$x,$y,$newdist);
192     }
193
194     foreach my $xn (keys %$allroutes) {
195         my $routes= $allroutes->{$xn};
196         distance_set_propagate('0', $xn, $xn, 0);
197         foreach my $yn (keys %$routes) {
198             distance_set_propagate('0', $yn, $yn, 0);
199             distance_set_propagate('X', $xn, $yn, $routes->{$yn});
200             distance_set_propagate('Y', $yn, $xn, $routes->{$yn});
201         }
202     }
203     my $ref;
204     while ($ref= shift @propqueue) {
205         distance_propagate_now(@$ref);
206     }
207
208     db_doall(<<END)
209  DELETE FROM dists;
210 END
211     ;
212     my $sth= $dbh->prepare(<<'END')
213  INSERT INTO dists VALUES
214         ((SELECT islandid FROM islands WHERE islandname == ?),
215          (SELECT islandid FROM islands WHERE islandname == ?),
216          ?);
217 END
218     ;
219     foreach my $xn (keys %$allroutes) {
220         my $routes= $allroutes->{$xn};
221         foreach my $yn (keys %$routes) {
222             $sth->execute($xn, $yn, $routes->{$yn});
223         }
224     }
225     $dbh->commit();
226
227     # select ia.islandname, ib.islandname,dists.dist from dists, islands as ia on dists.aiid = ia.islandid, islands as ib on dists.biid = ib.islandid order by ia.islandname, ib.islandname;
228 }
229
230 __DATA__