From c60024527fa80e1b572c95d4763350e691f9d4f3 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 19 Jul 2009 20:18:32 +0100 Subject: [PATCH] WIP commod-update-receiver; before make parse_parser into library --- pctb/commod-update-receiver | 46 +++++++++++++++++++++++++++++++++++++ pctb/database-info-fetch | 33 ++++++++++++++++++++++---- 2 files changed, 74 insertions(+), 5 deletions(-) create mode 100755 pctb/commod-update-receiver diff --git a/pctb/commod-update-receiver b/pctb/commod-update-receiver new file mode 100755 index 0000000..531ff1a --- /dev/null +++ b/pctb/commod-update-receiver @@ -0,0 +1,46 @@ +#!/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 +# +# 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 . +# +# 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"); + diff --git a/pctb/database-info-fetch b/pctb/database-info-fetch index 8b464a1..0752ae0 100755 --- a/pctb/database-info-fetch +++ b/pctb/database-info-fetch @@ -27,15 +27,15 @@ 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; @@ -83,7 +83,7 @@ BEGIN { close $mm or die $!; #print Dumper(\%oceans); -print Dumper(\@rawcm); +#print Dumper(\@rawcm); %commods= (); my $ca; @@ -147,6 +147,7 @@ sub json_convert_shim ($) { 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; @@ -256,6 +257,28 @@ sub main__island () { }); } +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 <