chiark / gitweb /
Further generalisation of text string entry; add missing copyrights
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 16 Aug 2009 02:03:37 +0000 (03:03 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 16 Aug 2009 02:03:37 +0000 (03:03 +0100)
yarrg/web/autohandler
yarrg/web/check_routestring
yarrg/web/qtextstring
yarrg/web/qtextstringcheck [new file with mode: 0644]
yarrg/web/query_route

index b0d7d98..7344f07 100644 (file)
@@ -1,4 +1,39 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero 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.
+
+
+ This Mason autohandler contains the doctype, charset and
+ copyright message.
+
+
+</%doc><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
 <!--
     This HTML is generated by the YARRG website, which is
     <& copyrightdate &>.
 <!--
     This HTML is generated by the YARRG website, which is
     <& copyrightdate &>.
index be009d4..2cbe719 100755 (executable)
  This Mason component parses textual strings giving lists of islands
  and archipelagoes, ie textual route strings.
 
  This Mason component parses textual strings giving lists of islands
  and archipelagoes, ie textual route strings.
 
-
 </%doc>
 
 <%flags>
 </%doc>
 
 <%flags>
-inherit => undef
+inherit => 'qtextstringcheck'
 </%flags>
 
 <%args>
 </%flags>
 
 <%args>
@@ -44,6 +43,7 @@ $ocean
 $format
 $ctype => undef
 $string
 $format
 $ctype => undef
 $string
+$returnhash => { }
 </%args>
 
 <%perl>
 </%args>
 
 <%perl>
@@ -51,11 +51,7 @@ $string
 # typical url for this script:
 #  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/routetextstring?format=json&ocean=Midnight&string=d
 
 # typical url for this script:
 #  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/routetextstring?format=json&ocean=Midnight&string=d
 
-
 use CommodsWeb;
 use CommodsWeb;
-use HTML::Entities;
-use JSON;
-use Data::Dumper;
 
 my $dbh= dbw_connect($ocean);
 
 
 my $dbh= dbw_connect($ocean);
 
@@ -64,38 +60,13 @@ my $sth= $dbh->prepare("SELECT archipelago,islandid,islandname
        UNION ALL       SELECT DISTINCT archipelago,NULL,archipelago
                                FROM islands WHERE archipelago LIKE ?");
 
        UNION ALL       SELECT DISTINCT archipelago,NULL,archipelago
                                FROM islands WHERE archipelago LIKE ?");
 
+my $emsg= '';
 my (@results, $canontext);
 my (@results, $canontext);
-my ($output, $output_wrong);
-
-if ($format =~ /json/) {
-       $r->content_type($ctype or $format);
-       $output= sub { print to_json_shim({
-               success => 1,
-               show => length $canontext ? encode_entities($canontext)
-                       : '&nbsp;',
-               })};
-       $output_wrong= sub { print to_json_shim({
-               success => 0,
-               show => $_[0],
-               })};
-}
-if ($format =~ /return/) {
-       $output= sub { return { Error => '', Results => \@results }; };
-       $output_wrong= sub { return { Error => $_[0] }; };
-}
-if ($format =~ /dump/) {
-       $r->content_type('text/plain');
-       $output_wrong= sub { print Dumper(\@_); };
-       $output= sub { print Dumper(\@results, $canontext); };
-}
 
 foreach my $each (split m#[/|,]#, $string) {
        $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
        next if !length $each;
 
 foreach my $each (split m#[/|,]#, $string) {
        $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
        next if !length $each;
-       my $err= sub {
-               my $msg= sprintf $_[0], encode_entities($each);
-               $output_wrong->($msg);
-       };
+       my $err= sub { $emsg= sprintf $_[0], $each; last; };
        my %m;
        my $results;
        foreach my $pat ("$each\%", "\%$each\%") {
        my %m;
        my $results;
        foreach my $pat ("$each\%", "\%$each\%") {
@@ -107,18 +78,21 @@ foreach my $each (split m#[/|,]#, $string) {
        }
        if (!$results) {
                if (!%m) {
        }
        if (!$results) {
                if (!%m) {
-                       return $err->('no island or arch matches "%s"');
+                       $err->('no island or arch matches "%s"');
                } elsif (keys(%m) > 5) {
                } elsif (keys(%m) > 5) {
-                       return $err->('&nbsp;');
+                       $err->('&nbsp;');
                } else {
                } else {
-                       return $err->('ambiguous island or arch "%s",'.
+                       $err->('ambiguous island or arch "%s",'.
                                ' could be '.join(', ', sort keys %m));
                }
        }
        push @results, $results->[0];
                                ' could be '.join(', ', sort keys %m));
                }
        }
        push @results, $results->[0];
-}
+};
+
+$dbh->disconnect();
 
 
-$canontext= join ' | ', map { $_->[2] } @results;
-return $output->();
+return  $emsg,
+       (join ' | ', map { $_->[2] } @results),
+       [ @results ];
 
 </%perl>
 
 </%perl>
index c0f2482..400716f 100644 (file)
@@ -1,3 +1,38 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero 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.
+
+
+ This Mason component handles `live' analysis of text string entries.
+
+
+</%doc>
 <%args>
 $thingstring
 $qa => $m->caller_args(1)->{'qa'}
 <%args>
 $thingstring
 $qa => $m->caller_args(1)->{'qa'}
@@ -37,6 +72,7 @@ function ts_Ready() {
   if (ts_request.readyState != 4) return;
   if (ts_request.status == 200) {
     response= ts_request.responseText;
   if (ts_request.readyState != 4) return;
   if (ts_request.status == 200) {
     response= ts_request.responseText;
+    debug('got '+response);
     eval('results='+response);
     toedit= document.getElementById('ts_results');
     toedit.innerHTML= results.show;
     eval('results='+response);
     toedit= document.getElementById('ts_results');
     toedit.innerHTML= results.show;
diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck
new file mode 100644 (file)
index 0000000..4196018
--- /dev/null
@@ -0,0 +1,73 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero 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.
+
+
+ This Mason component handles the generic output format options for
+ text string parsers/checkers like check_routestring.
+
+</%doc>
+<%flags>
+inherit => undef
+</%flags>
+<%perl>
+
+use JSON;
+use Data::Dumper;
+use HTML::Entities;
+
+my ($emsg, $canontext, $results)= $m->call_next();
+
+$emsg='' if !defined $emsg;
+
+my $format= $ARGS{'format'};
+my $ctype= $ARGS{'ctype'};
+
+if ($format =~ /json/) {
+       $r->content_type($ctype or $format);
+       my $jobj= {
+               success => 1*!length $emsg,
+               show => (length $emsg      ? encode_entities($emsg)      :
+                        length $canontext ? encode_entities($canontext) :
+                                             '&nbsp;'),
+       };
+       print to_json_shim($jobj);
+}
+if ($format =~ /return/) {
+       return {
+               Error => $emsg,
+               Results => length $emsg ? $results : undef
+       };
+}
+if ($format =~ /dump/) {
+       $r->content_type('text/plain');
+       print Dumper($emsg, $canontext, $results);
+}
+
+</%perl>
index f409e70..b91e55c 100644 (file)
@@ -1,3 +1,38 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero 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 Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero 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.
+
+
+ This Mason component generates the core of the `trade route' query.
+
+
+</%doc>
 <%args>
 $quri
 $qa
 <%args>
 $quri
 $qa