--- /dev/null
+#!/usr/bin/perl -w
+#
+# This script is invoked when the YPP SC PCTB client uploads to
+# the chiark database.
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission. This program is not endorsed or
+# sponsored by Three Rings.
+
+
+# Uploads contain:
+# ocean canonical mixed case
+# island canonical mixed case
+# clientname "ypp-sc-tools"
+# clientversion 2.1-g2e06a26 [from git-describe --tags HEAD]
+# clientfixes "lastpage" [space separated list]
+# deduped.tsv.gz output of ypp-commodities --tsv
+
+use strict (qw(vars));
+use POSIX;
+
+$CGI::POST_MAX= 3*1024*1024;
+$CGI::DISABLE_UPLOADS= 1;
+
+use CGI qw/:standard -private_tempfiles/;
+
+setlocale(LC_CTYPE, "en_GB.UTF-8");
+
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";
+@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;
close $mm or die $!;
#print Dumper(\%oceans);
-print Dumper(\@rawcm);
+#print Dumper(\@rawcm);
%commods= ();
my $ca;
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;
});
}
+sub main__allowablecommods ($$) {
+ my ($ocean,$island) = @_;
+ parse_masters();
+ my $arches= $oceans{$ocean};
+ if (!$arches) { print "unknown ocean\n"; exit 1; }
+ my $found= 0;
+ foreach my $islands (values %$arches) {
+ my $sources= $islands->{$island};
+ next unless $sources;
+ die if $found;
+ $found= $sources;
+ }
+ if (!$found) { print "unknown island\n"; exit 1; }
+
+ print "\n";
+ foreach my $commod (sort keys %commods) {
+ print "$commod\n";
+ }
+ STDOUT->error and die $!;
+ close STDOUT or die $!;
+}
+
sub main__sunshinewidget () {
print <<END
Land {On land} {
or die $!;
}
-&{"main__$which"}();
+&{"main__$which"}(@ARGV);