yarrg/yppedia-chart-parser

   1 #!/usr/bin/perl
   2 #
   3 # Normally run from
   4 #  update-master-info
   5 #
   6 # usage: ./yppedia-chart-parser <Oceanname>
   7 #  updates OCEAN-Oceanname.db and _ocean-<oceanname>.txt
   8 #  from YPPedia (chart and ocean page) and source-info.txt
   9
  10 # This is part of ypp-sc-tools, a set of third-party tools for assisting
  11 # 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 General Public License as published by
  17 # the Free Software Foundation, either version 3 of the License, or
  18 # (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 General Public License for more details.
  24 #
  25 # You should have received a copy of the GNU 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 use warnings;
  34
  35 use Graph::Undirected;
  36 use Commods;
  37 use CommodsDatabase;
  38 use CommodsScrape;
  39
  40 my $widists= Graph::Undirected->new();
  41 my $wiarchs= Graph::Undirected->new();
  42 my $wispr;
  43 my $dbspr;
  44 my @wiarchlabels;
  45 my %wiisland2node;
  46 my %winode2island;
  47 my %winode2lines;
  48 my %wiccix2arch;
  49 my $wialldists;
  50 my %wtisland2arch;
  51
  52 my $dbdists;
  53 my %dbisland2arch;
  54
  55 my $debugfh;
  56
  57 my @msgkinds= qw(change warning error);
  58 my %msgs;
  59 my %msgprinted;
  60 my %msgkindprinted;
  61 sub pmsg ($$) {
  62     my $m= "$_[0]: $_[1]\n";
  63     print $debugfh "D $m";
  64     push @{ $msgs{$_[0]} }, $m;
  65 }
  66 sub warning ($) { pmsg("warning",$_[0]); }
  67 sub error   ($) { pmsg("error",  $_[0]); }
  68 sub change  ($) { pmsg("change", $_[0]); }
  69 sub print_messages () {
  70     foreach my $k (@msgkinds) {
  71         my $ms= $msgs{$k};
  72         next unless $ms;
  73         foreach my $m (sort @$ms) {
  74             next if $msgprinted{$m};
  75             print $m or die $!;
  76             $msgprinted{$m}++;
  77             $msgkindprinted{$k}++;
  78         }
  79     }
  80 }
  81 sub progress ($) { print "($_[0])\n"; }
  82
  83 my $stdin_chart=0;
  84
  85 $debugfh= new IO::File ">/dev/null" or die $!;
  86
  87 while (@ARGV) {
  88     last unless $ARGV[0] =~ m/^-/;
  89     $_= shift @ARGV;
  90     last if m/^--$/;
  91     if ($_ eq '--debug') {
  92         $debugfh= new IO::File ">&STDOUT" or die $!;
  93         select($debugfh); $|=1; select(STDOUT);
  94     } elsif ($_ eq '--stdin-chart') {
  95         $stdin_chart=1;
  96     } else {
  97         die;
  98     }
  99 }
 100 $|=1;
 101
 102 @ARGV==1 or die;
 103 my $ocean= shift @ARGV;
 104
 105
 106 my $parity;
 107 sub nn_xy ($$) {
 108     my ($x,$y) = @_;
 109     my $tp= (0+$x ^ 0+$y) & 1;
 110     defined $parity or $parity=$tp;
 111     $tp==$parity or warning("line $.: parity error $x,$y is $tp not $parity");
 112     my $n= "$_[0],$_[1]";
 113     $winode2lines{$n}{$.}++;
 114     return $n;
 115 }
 116
 117 sub run_yppedia_chart_parse ($) {
 118     my ($oceanfh) = @_;
 119     yppedia_chart_parse($oceanfh, $debugfh,
 120                         \&nn_xy,
 121                         sub {
 122                             my ($x,$y,$arch) = @_;
 123                             push @wiarchlabels, [ $x,$y,$arch ];
 124                         },
 125                         sub {
 126                             my ($n, $island) = @_;
 127                             $wiisland2node{$island}= $n;
 128                             $winode2island{$n}= $island;
 129                             $widists->add_vertex($n);
 130                             $wiarchs->add_vertex($n);
 131                         },
 132                         sub {
 133                             my ($na, $nb, $solid) = @_;
 134                             $widists->add_weighted_edge($na, $nb, 1);
 135                             $wiarchs->add_edge($na, $nb) if $solid;
 136                             $wiarchs->add_edge($na, $nb) if $solid;
 137                         },
 138                         sub {
 139                             my ($lno,$l) = @_;
 140                             warning("line $l: ignoring incomprehensible: $l");
 141                         });
 142 }
 143
 144 sub yppedia_graphs_add_shortcuts () {
 145     # We add edges between LPs we know about, as you can chart
 146     # between them.  Yppedia often lacks these edges.
 147     #
 148     foreach my $p ($widists->vertices) {
 149         my ($ax,$ay) = $p =~ m/^(\d+)\,(\d+)$/ or die;
 150         my $add_shortcut= sub {
 151             my $q= sprintf "%d,%d", $ax+$_[0], $ay+$_[1];
 152             return unless $widists->has_vertex($q);
 153             return if $widists->has_edge($p,$q);
 154             printf $debugfh "%-5s league-shortcut %-5s\n", $p, $q;
 155             $widists->add_weighted_edge($p,$q,1);
 156         };
 157         $add_shortcut->( 2,0);
 158         $add_shortcut->(+1,1);
 159         $add_shortcut->(-1,1);
 160     }
 161 }
 162
 163 sub yppedia_graphs_prune_boring () {
 164     # Prune the LP database by eliminating boring intermediate vertices
 165     foreach my $delete ($widists->vertices()) {
 166         next if exists $winode2island{$delete};
 167         my @neigh= $widists->neighbours($delete);
 168         next unless @neigh==2;
 169         my $weight= 0;
 170         map { $weight += $widists->get_edge_weight($delete, $_) } @neigh;
 171         $widists->add_weighted_edge(@neigh, $weight);
 172         $widists->delete_vertex($delete);
 173         printf $debugfh "%-5s elide %5s %-5s %2d\n", $delete, @neigh, $weight;
 174     }
 175 }
 176
 177 sub yppedia_graphs_check () {
 178     # Check that it's connected.
 179     foreach my $cc ($widists->connected_components()) {
 180         next if 2*@$cc > $widists->vertices();
 181         my $m= "disconnected league point(s):";
 182         foreach my $n (@$cc) {
 183             $m .= "\n    LP $n, def. yppedia line(s): ".
 184                 join(',', sort keys %{ $winode2lines{$n} });
 185         }
 186         warning($m);
 187     }
 188 }
 189
 190 sub yppedia_archs_sourceinfo () {
 191     # Assign archipelagoes according to the source-info file
 192     foreach my $arch (sort keys %{ $oceans{$ocean} }) {
 193         foreach my $islename (sort keys %{ $oceans{$ocean}{$arch} }) {
 194             my $islenode= $wiisland2node{$islename};
 195             if (!defined $islenode) {
 196                 error("island $islename in source-info but not in WP map");
 197                 next;
 198             }
 199             my $ccix= $wiarchs->connected_component_by_vertex($islenode);
 200             my $oldarch= $wiccix2arch{$ccix};
 201             error("island in $arch in source-info".
 202                   " connected to $oldarch as well: $islename")
 203                 if defined $oldarch && $oldarch ne $arch;
 204             printf $debugfh "%-5s force-island-arch cc%-2d %-10s %s\n",
 205                 $islenode, $ccix, $arch, $islename;
 206             $wiccix2arch{$ccix}= $arch;
 207         }
 208     }
 209 }
 210
 211 sub yppedia_archs_chart_labels () {
 212     # Assign archipelago labels to groups of islands
 213     #
 214     foreach my $label (@wiarchlabels) {
 215         my ($ax,$ay,$arch) = @$label;
 216         my $best_d2= 9999999;
 217         my $best_n;
 218 #       print $debugfh "$ax,$ay arch-island-search $arch\n";
 219         $ay += 1;  $ax += 2;  # coords are rather to the top left of label
 220         foreach my $vertex ($wiarchs->vertices()) {
 221             next unless exists $winode2island{$vertex};
 222             my $ccix= $wiarchs->connected_component_by_vertex($vertex);
 223             my @cc= $wiarchs->connected_component_by_index($ccix);
 224             my ($vx,$vy) = split /,/, $vertex;  # /
 225             my $d2= ($vx-$ax)*($vx-$ax) + ($vy-$ay)*($vy-$ay);
 226             my $cmp= $best_d2 <=> $d2;
 227             printf $debugfh "%2d,%-2d arch-island-search %5s d2=%4d cc%-2d".
 228                          " #cc=%2d cmp=%2d %s\n",
 229                 $ax,$ay, $vertex, $d2, $ccix, scalar(@cc), $cmp,
 230                 $winode2island{$vertex};
 231             next unless $cmp > 0;
 232             $best_n=       $vertex;
 233             $best_d2=      $d2;
 234         }
 235         die 'no island vertices?!' unless defined $best_n;
 236         my $ccix= $wiarchs->connected_component_by_vertex($best_n);
 237         printf $debugfh
 238             "%2d,%-2d arch-island-select %-5s d2=%4d cc%-2d     %-10s %s\n",
 239             $ax,$ay, $best_n, $ccix, $best_d2, $arch, $winode2island{$best_n};
 240         my $desc= join "\n", map {
 241             my $in= $winode2island{$_};
 242             "    LP $_". (defined $in ? ", $in" : "");
 243         } sort $wiarchs->connected_component_by_index($ccix);
 244
 245         if (exists $wiccix2arch{$ccix} and $wiccix2arch{$ccix} ne $arch) {
 246             error("archipelago determination failed, wrongly merged:\n".
 247                   "    archipelago $arch\n".
 248                   "    archipelago $wiccix2arch{$ccix}\n".
 249                   $desc);
 250             next;
 251         }
 252         $wiccix2arch{$ccix}= $arch;
 253 #       print "$ccix $arch ::\n$desc\n";
 254     }
 255 }
 256
 257 sub yppedia_archs_fillbynearest() {
 258     # Assign islands not labelled above to archipelagoes.
 259     #
 260     # We do this by, for each connected component (set of islands
 261     # linked by purchaseable charts), searching for the nearest other
 262     # connected component which has already been assigned an arch.
 263     # `Nearest' means shortest distance of unpurchaseable charts, in
 264     # leagues.
 265     #
 266     # we need only consider vertices which weren't `boring intermediate
 267     # vertices' (removed during optimisation as being of order 2)
 268     my @ccs_useful= map {
 269         [ grep { $widists->has_vertex($_) } @$_ ]
 270     } $wiarchs->connected_components();
 271
 272     my @assignments;
 273
 274     foreach my $sourceccix (0..$#ccs_useful) {
 275         next if defined $wiccix2arch{$sourceccix};
 276         next unless $ccs_useful[$sourceccix];
 277
 278         my @sourcecc= $wiarchs->connected_component_by_index($sourceccix);
 279         my @islandnodes= grep { $winode2island{$_} } @sourcecc;
 280         next unless @islandnodes; # don't care, then
 281
 282         foreach my $islandnode (@islandnodes) {
 283             printf $debugfh "%-5s arch-join-need cc%-2d             %s\n",
 284                 $islandnode, $sourceccix, $winode2island{$islandnode};
 285         }
 286         my $best_dist= 9999999;
 287         my ($best_target, $best_targetccix, $best_source);
 288         foreach my $targetccix (0..$#ccs_useful) {
 289             next unless defined $wiccix2arch{$targetccix}; # not helpful
 290             next unless $ccs_useful[$targetccix];
 291             foreach my $target ($wiarchs->
 292                          connected_component_by_index($targetccix)) {
 293                 next unless $widists->has_vertex($target);
 294                 foreach my $source (@sourcecc) {
 295                     my $target_dist= widist($target,$source);
 296                     next unless defined $target_dist;
 297                     next if $target_dist >= $best_dist;
 298                     $best_dist= $target_dist;
 299                     $best_source= $source;
 300                     $best_target= $target;
 301                     $best_targetccix= $targetccix;
 302                 }
 303             }
 304         }
 305         die "no possible target ?!" unless defined $best_target;
 306
 307         my $arch= $wiccix2arch{$best_targetccix};
 308         my $best_island= $winode2island{$best_target};
 309         printf $debugfh "%-5s arch-join-to %-5s dist=%2d cc%-2d  %-10s %s\n",
 310             $best_source, $best_target, $best_dist,
 311             $best_targetccix, $arch,
 312             defined($best_island) ? $best_island : "-";
 313
 314         push @assignments, [ $sourceccix, $arch ];
 315     }
 316     foreach my $assign (@assignments) {
 317         $wiccix2arch{$assign->[0]}= $assign->[1];
 318     }
 319 }
 320
 321 sub yppedia_graph_shortest_paths () {
 322     $wialldists= $widists->APSP_Floyd_Warshall();
 323 }
 324
 325 sub widist ($$) {
 326     my ($p,$q) = @_;
 327     my $pl= $wialldists->path_length($p,$q);
 328 #    die "$p $q" unless defined $pl;
 329 #    my @pv= $wialldists->path_vertices($p,$q);
 330 #    if (@pv == $pl) { return $pl; }
 331 #   printf $debugfh "%-5s PATHLENGTH %-5s pl=%s pv=%s\n", $p,$q,$pl,join('|',@pv);
 332     return $pl;
 333 }
 334
 335 sub winode2arch ($) {
 336     my ($node) = @_;
 337     my $ccix= $wiarchs->connected_component_by_vertex($node);
 338     return $wiccix2arch{$ccix};
 339 }
 340 sub wiisland2arch ($) {
 341     my ($island) = @_;
 342     my $node= $wiisland2node{$island};
 343     die "$island ?" unless defined $node;
 344     return winode2arch($node);
 345 }
 346
 347 sub compare_island_lists () {
 348     foreach my $island (sort keys %dbisland2arch) {
 349         my $node= $wiisland2node{$island};
 350         if (!defined $node) {
 351             error("would delete island: $island");
 352             next;
 353         }
 354         my $wiarch= winode2arch($node);
 355         if (!defined $wiarch) {
 356             error("island has no arch: $island");
 357             next;
 358         }
 359         my $dbarch= $dbisland2arch{$island};
 360         if ($wiarch ne $dbarch) {
 361             change("archipelago change from $dbarch to $wiarch".
 362                    " for island $island");
 363         }
 364     }
 365     foreach my $island (sort keys %wiisland2node) {
 366         my $wtarch= $wtisland2arch{$island};
 367         my $wiarch= wiisland2arch($island);
 368         if (!$stdin_chart) {
 369             if (!defined $wtarch) {
 370                 error("island from chart not found on ocean page: $island");
 371             } elsif (defined $wiarch and $wtarch ne $wiarch) {
 372 #               error("island in $wtarch on ocean page but".
 373                 warning("island in $wtarch on ocean page but".
 374                       " concluded $wiarch from chart: $island");
 375             }
 376         }
 377
 378         my $dbarch= $dbisland2arch{$island};
 379         if (!defined $dbarch) {
 380             my $wiarch= wiisland2arch($island);
 381             if (!defined $wiarch) {
 382                 error("new island has no arch: $island");
 383                 next;
 384                 # We check arches of non-new islands above
 385             }
 386             change("island new in $wiarch: $island");
 387         }
 388     }
 389     if (!$stdin_chart) {
 390         foreach my $island (sort keys %wtisland2arch) {
 391             my $node= $wiisland2node{$island};
 392             next if defined $node;
 393             error("island on ocean page but not in chart: $island");
 394         }
 395     }
 396 }
 397
 398 sub shortest_path_reduction ($$) {
 399     my ($what,$g) = @_;
 400     #
 401     # Takes a graph $g (and a string for messages $what) and returns
 402     # a new graph which is the miminal shortest path transient reduction
 403     # of $g.
 404     #
 405     # We also check that the shortest path closure of the intended result
 406     # is the same graph as the input.  Thus the input must itself be
 407     # a shortest path closure; if it isn't, we die.
 408
 409     my $proof=<<'END'; # way to make a big comment
 410
 411     Premises and definitions:
 412
 413     1. F is an undirected weighted graph with positive edge weights.
 414
 415     2. All graphs we will consider have the same vertices as F
 416        and none have self-edges.
 417
 418     3. G = Closure(F) is the graph of cliques whose edge weights
 419        are the shortest paths in F, one clique for each connected
 420        component in F.
 421
 422     3a. |XY| for vertices X, Y is the weight of the edge XY in G.
 423        If XY is not in G, |XY| is infinite.
 424
 425     4. A `reduction' of G is a subgraph K of G such that Closure(K) = G.
 426        The reduction is `minimal' if there is no strict subgraph K'
 427        of K such that Closure(K') = G.
 428
 429     5. Now each edge of G may be:
 430        - `unnecessary': included in no minimal reductions of G.
 431        - `essential': included in all minimal reductions of G.
 432        - `contingent': included in some but not all.
 433
 434     6. Consider for any edge AC between the vertices A and C,
 435        whether there is any B such that |AB|+|BC| = |AC| ?
 436        (There can be no B such that the sum < |AC| since that would
 437        mean that |AC| wasn't equal to the shortest path length.)
 438
 439     6a. No such B:  AC is therefore the only shortest path from A to C
 440         (since G is not a multigraph).  AC is thus an essential edge.
 441
 442     6b. Some such B: Call all such edges AC `questionable'.
 443
 444     6c. Thus all edges are essential or questionable.
 445
 446     7. Suppose AC is a shortest contingent edge.  AC must be
 447        questionable since it is not essential.  Suppose it is
 448        made questionable by the existence of B such that |AB|+|BC| =
 449        |AC|.  Consider AB and BC.  Since |AB| and |BC| are positive,
 450        |BC| and |AB| must be < |AC| ie AB and BC are shorter than AC.
 451        Since AC is a shortest contingent edge, there must be shortest
 452        paths in G for AB and BC consisting entirely of essential edges.
 453
 454     8. Therefore it is always safe to remove AC since the paths
 455        A..B and B..C will definitely still remain and provide a path
 456        A..B..C with length |AB|+|BC| = |AC|.
 457
 458     9. Thus AC is unnecessary, contradicting the assumption in 7.
 459        There are therefore no shortest contingent edges, and
 460        thus no contingent edges.
 461
 462     10. We can construct a minimal reduction directly: for each edge
 463         AC in G, search for a vertex B such that |AB|+|BC| = |AC|.
 464         If we find none, AC is essential.  If we find one then AC is
 465         not essential and is therefore unnecessary.
 466
 467 END
 468     # `
 469
 470     printf $debugfh "spr %s before %d\n", $what, scalar($g->edges());
 471
 472     my $result= Graph::Undirected->new();
 473     foreach my $edge_ac ($g->edges()) {
 474         $result->add_vertex($edge_ac->[0]); # just in case
 475         next if $edge_ac->[0] eq $edge_ac->[1];
 476         my $edgename_ac= join ' .. ', @$edge_ac;
 477         printf $debugfh "spr %s edge %s\n", $what, $edgename_ac;
 478         my $w_ac= $g->get_edge_weight(@$edge_ac);
 479         my $needed= 1;
 480         foreach my $vertex_b ($g->vertices()) {
 481             next if grep { $_ eq $vertex_b } @$edge_ac;
 482             my $w_ab= $g->get_edge_weight($edge_ac->[0], $vertex_b);
 483             next unless defined $w_ab;
 484             next if $w_ab >= $w_ac;
 485             my $w_bc= $g->get_edge_weight($vertex_b, $edge_ac->[1]);
 486             next unless defined $w_ac;
 487             next if $w_ab + $w_bc > $w_ac;
 488             # found path
 489             printf $debugfh "spr %s edge %s unnecessary %s\n",
 490                 $what, $edgename_ac, $vertex_b;
 491             $needed= 0;
 492             last;
 493         }
 494         if ($needed) {
 495             printf $debugfh "spr %s edge %s essential\n", $what, $edgename_ac;
 496             $result->add_weighted_edge(@$edge_ac,$w_ac);
 497         }
 498     }
 499     printf $debugfh "spr %s result %d\n", $what, scalar($result->edges());
 500
 501     my $apsp= $result->APSP_Floyd_Warshall();
 502     foreach my $ia (sort $g->vertices()) {
 503         foreach my $ib (sort $g->vertices()) {
 504             my $din= $g->get_edge_weight($ia,$ib);
 505             my $dout= $apsp->path_length($ia,$ib);
 506             $din= defined($din) ? $din : 'infinity';
 507             $dout= defined($dout) ? $dout : 'infinity';
 508             error("$what spr apsp discrepancy in=$din out=$dout".
 509                   " for $ia .. $ib")
 510                 if $din != $dout;
 511         }
 512     }
 513     return $result;
 514 }
 515
 516 sub yppedia_graph_spr () {
 517     my $base= Graph::Undirected->new();
 518     foreach my $na (sort keys %winode2island) {
 519         my $ia= $winode2island{$na};
 520         foreach my $nb (sort keys %winode2island) {
 521             my $ib= $winode2island{$nb};
 522             $base->add_weighted_edge($ia,$ib, widist($na,$nb));
 523         }
 524     }
 525     $wispr= shortest_path_reduction('wi',$base);
 526 }
 527
 528 sub yppedia_ocean_fetch_start ($) {
 529     my ($chart) = @_;
 530     my @args= ();
 531     push @args, '--chart' if $chart;
 532     push @args, $ocean;
 533     open OCEAN, '-|', "./yppedia-ocean-scraper", @args or die $!;
 534 }
 535 sub yppedia_ocean_fetch_done () {
 536     $?=0; $!=0; close OCEAN; $? and die $?; $! and die $!;
 537 }
 538
 539 sub yppedia_ocean_fetch_chart () {
 540     if ($stdin_chart) {
 541         run_yppedia_chart_parse('::STDIN');
 542     } else {
 543         yppedia_ocean_fetch_start(1);
 544         run_yppedia_chart_parse('::OCEAN');
 545         yppedia_ocean_fetch_done();
 546     }
 547 }
 548
 549 sub yppedia_ocean_fetch_text () {
 550     yppedia_ocean_fetch_start(0);
 551     my $arch;
 552     while (<OCEAN>) {
 553         chomp;
 554         if (m/^ocean /) {
 555             $' eq $ocean or die;
 556         } elsif (m/^  /) {
 557             die unless defined $arch;
 558             $wtisland2arch{$'}= $arch;
 559         } elsif (m/^ /) {
 560             $arch= $'; # '
 561         } else {
 562             die;
 563         }
 564     }
 565     yppedia_ocean_fetch_done();
 566 }
 567
 568 sub compare_distances () {
 569     foreach my $ia (sort keys %dbisland2arch) {
 570         my $na= $wiisland2node{$ia};
 571         next unless defined $na;
 572         foreach my $ib (sort keys %dbisland2arch) {
 573             next unless $ia le $ib; # do every pair only once
 574             my $dbdist= $dbspr->get_edge_weight($ia,$ib);
 575             my $widist= $wispr->get_edge_weight($ia,$ib);
 576             next unless defined $dbdist || defined $widist;
 577
 578             if (!defined $widist) {
 579                 warning(sprintf "route delete %2d for %s .. %s",
 580                         $dbdist, $ia,$ib);
 581             } elsif (!defined $dbdist) {
 582                 change(sprintf "route new %2d for %s .. %s",
 583                        $widist, $ia,$ib);
 584             } elsif ($dbdist != $widist) {
 585                 change(sprintf "route change %2d to %2d for %s .. %s",
 586                        $dbdist, $widist, $ia,$ib);
 587             }
 588         }
 589     }
 590 }
 591
 592 #========== database handling ==========
 593
 594 sub database_fetch_ocean () {
 595     my ($row,$sth);
 596     $sth= $dbh->prepare('SELECT islandname, archipelago FROM islands');
 597     $sth->execute();
 598     undef %dbisland2arch;
 599     $dbdists= Graph::Undirected->new();
 600     while ($row= $sth->fetchrow_hashref) {
 601         print $debugfh "database-island $row->{'islandname'}".
 602                      " $row->{'archipelago'}\n";
 603         $dbisland2arch{$row->{'islandname'}}= $row->{'archipelago'};
 604     }
 605     $sth= $dbh->prepare('SELECT dist, a.islandname a, b.islandname b
 606                                 FROM dists
 607                                 JOIN islands AS a ON dists.aiid==a.islandid
 608                                 JOIN islands AS b ON dists.biid==b.islandid');
 609     $sth->execute();
 610     while ($row= $sth->fetchrow_hashref) {
 611         $dbdists->add_weighted_edge($row->{'a'}, $row->{'b'}, $row->{'dist'});
 612     }
 613 }
 614
 615 sub database_graph_spr () {
 616     $dbspr= shortest_path_reduction('db',$dbdists);
 617 }
 618
 619 sub database_do_updates () {
 620     my $addisland= $dbh->prepare(<<'END')
 621  INSERT OR IGNORE INTO islands (islandname, archipelago) VALUES (?, ?);
 622 END
 623     ;
 624     foreach my $island (sort keys %wiisland2node) {
 625         my $wiarch= wiisland2arch($island);
 626         $addisland->execute($island, $wiarch);
 627     }
 628
 629     db_doall(<<END)
 630  DELETE FROM dists;
 631  DELETE FROM routes;
 632 END
 633     ;
 634     my $adddist= $dbh->prepare(<<'END')
 635  INSERT INTO dists VALUES
 636         ((SELECT islandid FROM islands WHERE islandname == ?),
 637          (SELECT islandid FROM islands WHERE islandname == ?),
 638          ?);
 639 END
 640     ;
 641     my $addroute= $dbh->prepare(<<'END')
 642  INSERT INTO routes VALUES
 643         ((SELECT islandid FROM islands WHERE islandname == ?),
 644          (SELECT islandid FROM islands WHERE islandname == ?),
 645          ?);
 646 END
 647     ;
 648     foreach my $ia (sort keys %wiisland2node) {
 649         my $na= $wiisland2node{$ia};
 650         foreach my $ib (sort keys %wiisland2node) {
 651             my $nb= $wiisland2node{$ib};
 652             my $apdist= $ia eq $ib ? 0 : widist($na,$nb);
 653             die "$ia $ib" unless defined $apdist;
 654             my $sprdist= $wispr->get_edge_weight($ia,$ib);
 655             die "$ia $ib $apdist $sprdist" if
 656                 defined($sprdist) && $sprdist != $apdist;
 657
 658             $adddist->execute($ia,$ib,$apdist);
 659             $addroute->execute($ia,$ib,$sprdist) if defined $sprdist;
 660         }
 661     }
 662
 663     # select ia.islandname, ib.islandname, d.dist from dists as d, islands as ia on d.aiid = ia.islandid, islands as ib on d.biid = ib.islandid order by ia.islandname, ib.islandname;
 664
 665 }
 666
 667 #========== update _ocean-*.txt ==========
 668
 669 our $localtopo_path;
 670
 671 sub localtopo_rewrite () {
 672     $localtopo_path= '_ocean-'.(lc $ocean).'.txt';
 673     my $fh= new IO::File "$localtopo_path.tmp", 'w';
 674     print $fh "# autogenerated - do not edit\n" or die $!;
 675     print $fh "ocean $ocean\n" or die $!;
 676     my %arches;
 677     foreach my $isle (sort keys %wtisland2arch) {
 678         my $arch= $wtisland2arch{$isle};
 679         push @{ $arches{$arch} }, $isle;
 680     }
 681     foreach my $arch (sort keys %arches) {
 682         print $fh " $arch\n" or die $!;
 683         foreach my $isle (@{ $arches{$arch} }) {
 684             print $fh "  $isle\n" or die $!;
 685         }
 686     }
 687     print $fh "\n" or die $!;
 688     close $fh or die $!;
 689 }
 690
 691 sub localtopo_commit () {
 692     rename "$localtopo_path.tmp", $localtopo_path or die $!;
 693 }
 694
 695 #========== main program ==========
 696
 697 parse_info_serverside();
 698
 699 progress("fetching yppedia chart");         yppedia_ocean_fetch_chart();
 700 progress("adding shortcuts");               yppedia_graphs_add_shortcuts();
 701 progress("pruning boring vertices");        yppedia_graphs_prune_boring();
 702 progress("checking yppedia graphs");        yppedia_graphs_check();
 703 progress("setting archs from source-info"); yppedia_archs_sourceinfo();
 704 progress("computing shortest paths");       yppedia_graph_shortest_paths();
 705 progress("setting archs from labels");      yppedia_archs_chart_labels();
 706 progress("setting archs from nearby");      yppedia_archs_fillbynearest();
 707 progress("computing yppedia spr");          yppedia_graph_spr();
 708
 709 if (!$stdin_chart) {
 710     progress("fetching yppedia ocean text");    yppedia_ocean_fetch_text();
 711 }
 712
 713 db_setocean($ocean);
 714 db_connect();
 715 my $iteration=0;
 716 for (;;) {
 717     progress("reading database");
 718     database_fetch_ocean();
 719     progress("computing database spr");         database_graph_spr();
 720
 721     progress("comparing islands");              compare_island_lists();
 722     progress("comparing distances");            compare_distances();
 723
 724     print "\n";
 725     print_messages();
 726
 727     foreach my $k (@msgkinds) {
 728         my $n= $msgkindprinted{$k};
 729         next unless $n;
 730         printf STDERR "*** %d%s %ss\n", $n, $iteration?' additional':'', $k;
 731     }
 732
 733     if ($msgs{'error'}) {
 734         print STDERR "*** errors, aborting update\n";
 735         exit 1;
 736     }
 737
 738     if (!%msgkindprinted) {
 739         progress("updating database");         database_do_updates();
 740         progress("updating _ocean-*.txt");     localtopo_rewrite();
 741         if ($stdin_chart) {
 742             print STDERR "*** --stdin-chart, aborting!\n";
 743             exit 1;
 744         }
 745         progress("checking database");      db_check_referential_integrity(1);
 746         progress("committing database");       $dbh->commit();
 747         progress("committing _ocean-*.txt");   localtopo_commit();
 748         exit 0;
 749     }
 750     $dbh->rollback();
 751
 752     my $default= !$msgkindprinted{'warning'};
 753     printf STDERR "*** confirm update %s ? ", $default?'(y/n)':'(n/y)';
 754
 755     if ($stdin_chart) {
 756         printf STDERR "[--stdin-chart]\n";
 757         exit 1;
 758     }
 759
 760     $!=0; my $result= <STDIN>;  defined $result or die $!;
 761     $result =~ s/\s//g;
 762     $result= $default?'y':'n' if !length $result;
 763     $result= $result =~ m/^y/i;
 764
 765     if (!$result) {
 766         printf STDERR "*** updated abandoned at your request\n";
 767         exit 1;
 768     }
 769
 770     print "\n";
 771     undef %msgkindprinted;
 772     $iteration++;
 773 }
 774
 775 print_messages();