use strict (qw(vars));
use LWP::UserAgent;
use JSON;
-use Data::Dumper;
+#use Data::Dumper;
+use IO::File;
-@ARGV==1 or die "You probably don't want to run this program directly.\n";
+use Commods;
+
+@ARGV>=1 or die "You probably don't want to run this program directly.\n";
our ($which) = shift @ARGV;
$which =~ s/\W//g;
-our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'}; die unless $pctb;
+our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'};
our ($ua)= LWP::UserAgent->new;
our $jsonresp;
my ($json) = @_;
# In JSON.pm 2.x, jsonToObj prints a warning to stderr which
# our callers don't like at all.
- if ($JSON::VERSION >= 2) {
+ if ($JSON::VERSION >= 2.0) {
return from_json($json);
} else {
return jsonToObj($json);
}
}
-sub get_arches_islands () {
- my $ocean= $ENV{'YPPSC_OCEAN'}; die unless $ocean;
+sub get_arches_islands_pctb ($) {
+ my ($ocean)= @_;
+ die unless $pctb;
my $url= "$pctb/islands.php?oceanName=".uc $ocean;
my $resp= $ua->get($url);
die $resp->status_line unless $resp->is_success;
my $jobj= json_convert_shim($resp->content);
my $arches= [ jparsetable($jobj, 'arches') ];
my $islands= [ jparsetable($jobj, 'islands') ];
- return ($arches,$islands);
-}
-sub main__island () {
- my ($arches, $islands) = get_arches_islands();
-# print Dumper(\@arches, \@islands);
my $islands_done=0;
- foreach my $arch (sort_by_name(@$arches)) {
-# print Dumper($arch);
+ foreach my $arch (@$arches) {
+# print Dumper($arnch);
my $aname= $arch->{'name'};
die "$jsonresp ?" unless defined $aname;
- ptcl($aname); p(' '); ptcl($aname); p(" {\n");
- foreach my $island (sort_by_name(@$islands)) {
+
+ foreach my $island (@$islands) {
my $iname= $island->{'name'};
die "$jsonresp $aname ?" unless defined $iname;
next unless $arch->{'id'} == $island->{'arch'};
- p(' '); ptcl($iname); p(' '); ptcl($iname); p("\n");
+
+ $oceans{$ocean}{$aname}{$iname} .= 'b';
+
$islands_done++;
}
- p("}\n");
}
die "$jsonresp $islands_done ?" unless $islands_done == @$islands;
}
+sub get_ocean () {
+ my $ocean= $ENV{'YPPSC_OCEAN'}; die unless $ocean;
+ return ucfirst lc $ocean;
+}
+
+sub for_islands ($$$$) {
+ my ($ocean,$forarch,$forisle,$endarch) = @_;
+
+ my $arches= $oceans{$ocean};
+ foreach my $aname (sort keys %$arches) {
+ &$forarch($ocean,$aname);
+ my $islands= $arches->{$aname};
+ foreach my $iname (sort keys %$islands) {
+ &$forisle($ocean,$aname,$iname);
+ }
+ &$endarch();
+ }
+}
+
+sub for_commods ($) {
+ my ($forcommod) = @_;
+ foreach my $commod (sort keys %commods) { &$forcommod($commod); }
+}
+
+sub compare_sources_one ($$) {
+ my ($srcs,$what) = @_;
+ return if $srcs =~ m,^sl?(?:\%sl?)*b$,;
+ print "srcs=$srcs $what\n";
+}
+
+sub main__comparesources () {
+ my $ocean= get_ocean();
+
+ parse_masters();
+ get_arches_islands_pctb($ocean);
+ parse_pctb_commodmap() or die;
+
+ for_islands($ocean,
+ sub { },
+ sub {
+ my ($ocean,$a,$i)= @_;
+ my $srcs= $oceans{$ocean}{$a}{$i};
+ compare_sources_one($srcs, "island $ocean / $a / $i");
+ },
+ sub { });
+ for_commods(sub {
+ my ($commod)= @_;
+ my $srcs= $commods{$commod};
+ compare_sources_one($srcs, "commodity $commod");
+ });
+}
+
+sub main__island () {
+ my $ocean= get_ocean();
+
+ parse_masters();
+ get_arches_islands_pctb($ocean);
+
+ for_islands($ocean,
+ sub {
+ my ($ocean,$aname)= @_;
+ ptcl($aname); p(' '); ptcl($aname); p(" {\n");
+ },
+ sub {
+ my ($ocean,$aname,$iname)= @_;
+ p(' '); ptcl($iname); p(' '); ptcl($iname); p("\n");
+ },
+ sub {
+ p("}\n");
+ });
+}
+
sub main__sunshinewidget () {
print <<END
Land {On land} {
or die $!;
}
-&{"main__$which"}();
+&{"main__$which"}(@ARGV);