our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
- @EXPORT = qw(&parse_masters %oceans %commods %clients
+ @EXPORT = qw(&parse_masters &parse_masters_ocean
+ %oceans %commods %clients %routes %route_mysteries
&parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
&get_our_version &check_tsv_line
&pipethrough_prep &pipethrough_run
our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources;
our %commods; # eg $commods{'Fine black cloth'}= $sources;
our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ];
+our %routes; # eg $routes{'Midnight'}{'Orca'}{'Tinga'}= $sources NB abbrevs!
+our %route_mysteries; # eg $route_mysteries{'Midnight'}{'Norse'}= 3
# $sources = 's[l]b';
# 's' = Special Circumstances; 'l' = local ; B = with Bleach
$oceans{$ocean}{$arch}{$_} .= $src;
};
});
+ } elsif (m/^routes (\w+)$/) {
+ my $ocean= $1;
+ @ctx= (sub {
+ m/^(\S[^\t]*\S)\t+(\S[^\t]*\S)\t+([1-9][0-9]{0,2})$/ or die;
+ $routes{$ocean}{$1}{$2}= $3;
+ });
} elsif (m/^client (\S+.*\S)$/) {
my $client= $1;
$clients{$client}= [ ];
}
};
foreach (@rawcm) { &$ca($_,$src); }
+
+ foreach my $on (keys %routes) {
+ my $routes= $routes{$on};
+ my $ocean= $oceans{$on};
+ die unless defined $ocean;
+
+ my @allislands;
+ foreach my $an (sort keys %$ocean) {
+ my $arch= $ocean->{$an};
+ push @allislands, sort keys %$arch;
+ }
+ parse_master_map_route_islands($on, \@allislands, $routes);
+ foreach my $route (values %$routes) {
+ parse_master_map_route_islands($on, \@allislands, $route);
+ }
+ }
+}
+
+sub parse_master_map_route_islands ($$$) {
+ my ($on, $allislands, $routemap) = @_;;
+ foreach my $k (sort keys %$routemap) {
+ my @ok= grep { index($_,$k) >= 0 } @$allislands;
+ die "ambiguous $k" if @ok>1;
+ if (!@ok) {
+ $route_mysteries{$on}{$k}++;
+ delete $routemap->{$k};
+ } elsif ($ok[0] ne $k) {
+ $routemap->{$ok[0]}= $routemap->{$k};
+ delete $routemap->{$k};
+ }
+ }
}
sub parse_masters () {
parse_master_master1('master-master.txt','s');
}
+sub parse_masters_ocean ($) {
+ my ($oceanname) = @_;
+ parse_master_master1('master-master.txt','s');
+ die "unknown ocean $oceanname ?" unless exists $oceans{$oceanname};
+ parse_master_master1("ocean-".(lc $oceanname).".txt",'s');
+}
sub parse_pctb_commodmap () {
undef %pctb_commodmap;
use Commods;
@ARGV==1 or die;
-my ($ocean) = @ARGV;
+my ($oceanname) = @ARGV;
-my $dbfn= "OCEAN-$ocean.db";
+my $dbfn= "OCEAN-$oceanname.db";
our $dbh;
}
}
+#---------- setup ----------
+
+parse_masters_ocean($oceanname);
+our $ocean= $oceans{$oceanname};
+
$dbh= DBI->connect("dbi:SQLite:$dbfn",'','',
{ AutoCommit=>0,
RaiseError=>1, ShowErrorStatement=>1,
unicode=>1 })
or die "$dbfn $DBI::errstr ?";
+#---------- schema ----------
+
foreach my $bs (qw(buy sell)) {
dbdoall(<<END)
CREATE TABLE IF NOT EXISTS $bs (
commodid INTEGER NOT NULL,
islandid INTEGER NOT NULL,
stallid INTEGER NOT NULL,
- price INTEGER,
- qty INTEGER,
+ price INTEGER NOT NULL,
+ qty INTEGER NOT NULL,
PRIMARY KEY (commodid, islandid, stallid)
);
CREATE INDEX IF NOT EXISTS ${bs}_by_island ON $bs (commodid, islandid, price);
$dbh->commit;
-parse_masters();
+#---------- commodity list ----------
{
my $sth= $dbh->prepare(<<'END')
}
$dbh->commit;
}
+
+#---------- island list ----------
+
+{
+ my $sth= $dbh->prepare(<<'END')
+ INSERT OR IGNORE INTO islands (islandname, archipelago) values (?, ?);
+END
+ ;
+ foreach my $archname (sort keys %$ocean) {
+ my $arch= $ocean->{$archname};
+ foreach my $islandname (sort keys %$arch) {
+ $sth->execute($islandname, $archname);
+ }
+ }
+ $dbh->commit;
+}
+
+#---------- routes ----------
+
+foreach my $islandname (sort keys %{ $route_mysteries{$oceanname} }) {
+ warn "$route_mysteries{$oceanname}{$islandname} routes".
+ " for unknown island $islandname\n";
+}
+
+#use Data::Dumper;
+#print Dumper(\%routes);
+
+__DATA__
+
+ /* 'distances' will hold the final results. */
+ create table distances (
+ a varchar(40) not null references islands(name),
+ b varchar(40) not null references islands(name),
+ distance int not null,
+ primary key (a,b) );
+
+ /* Create a rule such that insertion into the distances table is only
+ possible if a shorter route or a new route is being recorded; all other
+ inserts are ignored. */
+
+ create or replace rule update_only_if_shorter as
+ on insert to distances
+ where ((new.a,new.b) in (select a,b from distances))
+ do instead
+ update distances set distance=(case when new.distance<=distance then
+ new.distance else distance end)
+ where a=new.a and b=new.b;
+
+ /* Start by copying manually entered routes into distances */
+ insert into distances (select a,b,distance from routes);
+ /* Also all the reverse routes */
+ insert into distances (select b,a,distance from routes);
+ /* Also all the null routes */
+ insert into distances (select distinct a,a,0 from routes);
+ insert into distances (select distinct b,b,0 from routes);
+
+ /* Now extend the distances table by computing new routes */
+ insert into distances (select source.a,dest.b,
+ min(source.distance+dest.distance)
+ from distances source,distances dest
+ where source.b=dest.a group by source.a,dest.b);
+
+ /* Repeat that query until no new routes are added (i.e. select count(*)
+ from distances; returns the same value after the query as it does before) */
--- /dev/null
+routes Midnight
+ # Try to include "shortcut" routes (those where you can chart a
+ # league that isn't actually on any inter-island charts), but if you
+ # don't it won't affect things too much.
+
+ # Ruby internal
+ Olivia Midsummer 3
+ Midsummer Cranberry 2
+ Olivia Lynx 5
+ Olivia Eta 7
+ Cranberry Eta 3
+ Lynx Eta 3
+ Lynx Islay of Luthien 5
+ Eta Islay of Luthien 4
+ Islay of Luthien Jorvik 5
+ Eta Jorvik 5
+
+ # Pearl internal and interarch
+ Cleopatra O'Reilly 3
+ Cleopatra Zeta 4
+ Cleopatra Nuptial 6
+ O'Reilly Nuptial 4
+ O'Reilly Zeta 6
+ Nuptial Zeta 4
+ Nuptial Ostreum 6
+ Zeta Tadpole 4
+ Tadpole Ostreum 6
+ Tadpole Frond 4
+ Frond Ostreum 4
+ Frond Zeta 6
+ Nuptial Islay of Luthien 10
+ Ostreum Wrasse 6
+ Ostreum Gaea 10
+ Frond Wrasse 9
+ Frond Gaea 13
+
+ # Diamond internal and interarch - this has lots of shortcut routes
+ Turtle Jorvik 6
+ Turtle Papaya 3
+ Turtle Cnossos 8
+ Turtle Alpha 7
+ Papaya Byrne 3
+ Papaya Alpha 6
+ Papaya Oyster 8
+ Papaya Winter Solstice 11
+ Cnossos Alpha 3
+ Cnossos Winter Solstice 4
+ Cnossos Guava 6
+ Winter Solstice Guava 9
+ Winter Solstice Alpha 6
+ Winter Solstice Oyster 5
+ Winter Solstice Park 11
+ Winter Solstice Delta 16
+ Winter Solstice Byrne 9
+ Alpha Oyster 3
+ Oyster Park 7
+ Oyster Delta 12
+ Alpha Byrne 4
+ Byrne Remora 10
+ Papaya Remora 8
+
+ # Emerald internal and interarch to Jet and Opal
+ Wrasse Guava 5
+ Wrasse Gaea 5
+ Wrasse Epsilon 11
+ Guava Epsilon 7
+ Gaea Epsilon 4
+ Gaea Tinga 8
+ Epsilon Emperor 3
+ Epsilon Spring 6
+ Emperor Spring 4
+ Epsilon Tinga 5
+ Tinga Spring 4
+ Tinga Hephaestus 11
+ Spring Hephaestus 8
+ Tinga Orca 8
+
+ # Opal internal
+ Orca Endurance 3
+ Orca Norse 5
+ Orca Nu 4
+ Nu Norse 3
+ Nu Endurance 3
+ Nu Oseberg 4
+ Norse Oseberg 6
+ Norse Waterberry 4
+ Waterberry Boyle 3
+ Boyle Flow 3
+ Flow Oseberg 3
+
+ # Jet internal
+ Hephaestus Namath 6
+ Hephaestus Xi 4
+ Hephaestus Lagniappe 8
+ Hephaestus Dugong 10
+ Namath Rhinoceros Ridge 3
+ Rhinoceros Ridge Lagniappe 2
+ Xi Lagniappe 5
+ Xi Chaparral 4
+ Xi Eclipse 6
+ Chaparral Eclipse 4
+ Lagniappe Dugong 3
+ Lagniappe Eclipse 5
+
+ # Coral internal and interarch to Jet
+ Park Angelfish 5
+ Angelfish Meke 4
+ Park Delta 6
+ Delta Angelfish 3
+ Delta Macaw 5
+ Macaw Monsoon 3
+ Monsoon Chaparral 6
+ Monsoon Turongo 4
+ Monsoon Durian 6
+ Turongo Durian 3
+ Turongo Angelfish 7
+ Turongo Delta 8
+ Turongo Park 11
+
+ # Sapphire internal
+ Remora The Horseshoe Crabs 3
+ Remora Beta 3
+ The Horseshoe Crabs Verdant Atoll 3
+ The Horseshoe Crabs Beta 5
+ Beta Iris 4
+ Verdant Atoll Uxmal 3
+ Verdant Atoll Iris 6
+ Uxmal Iris 4
+ Iris Vernal Equinox 3
~yarrgweb / ypp-sc-tools.db-test.git / commitdiff