X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=pctb%2Fdatabase-info-fetch;h=2e195c7a01b2d06471b540a3201721a39701aad2;hb=3c3e5dc8eae9b239f2dab871a3bd47222af09538;hp=e83f685a7275d0ae103042dab646e9f2b09fb674;hpb=c3bdac1bb1e4dd2ac8f7934748232d3cd2e477ad;p=ypp-sc-tools.db-test.git

diff --git a/pctb/database-info-fetch b/pctb/database-info-fetch
index e83f685..2e195c7 100755
--- a/pctb/database-info-fetch
+++ b/pctb/database-info-fetch
@@ -28,13 +28,16 @@ use strict (qw(vars));
 use LWP::UserAgent;
 use JSON;
 #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;
 
@@ -67,33 +70,118 @@ sub ptcl ($) {
     die "$_ $& ?" if m/[^-+'"# 0-9a-z]/i;
     p("{$_[0]}");
 }
-    
-sub main__island () {
-    my $ocean= $ENV{'YPPSC_OCEAN'};  die unless $ocean;
+
+sub json_convert_shim ($) {
+    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.0) {
+	return from_json($json);
+    } else {
+	return jsonToObj($json);
+    }
+}
+
+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;
     $jsonresp= $resp->content;
-    my $jobj= jsonToObj($resp->content);
-    my @arches= jparsetable($jobj, 'arches');
-    my @islands= jparsetable($jobj, 'islands');
-#    print Dumper(\@arches, \@islands);
+    my $jobj= json_convert_shim($resp->content);
+    my $arches= [ jparsetable($jobj, 'arches') ];
+    my $islands= [ jparsetable($jobj, '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;
+    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 () {
@@ -116,4 +204,4 @@ END
     or die $!;
 }
 
-&{"main__$which"}();
+&{"main__$which"}(@ARGV);