X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fcheck_routestring;h=cfa7ec72303e2ea671acb4ef28aa7de9cdedb662;hp=be009d4e5a4b8fa624a5f809a079a432d0b1da2f;hb=a7d3f0bd7f84b3b40a7a7860f467f2beda20a227;hpb=38e2919be138f8a77eef7a2fc93d34eff8897f5e

diff --git a/yarrg/web/check_routestring b/yarrg/web/check_routestring
old mode 100755
new mode 100644
index be009d4..cfa7ec7
--- a/yarrg/web/check_routestring
+++ b/yarrg/web/check_routestring
@@ -29,96 +29,32 @@
  sponsored by Three Rings.
 
 
- This Mason component parses textual strings giving lists of islands
- and archipelagoes, ie textual route strings.
-
+ This Mason component simply defines how to look up route entries.
+ It is called by qtextstring.
 
 </%doc>
 
-<%flags>
-inherit => undef
-</%flags>
-
-<%args>
-$ocean
-$format
-$ctype => undef
-$string
-</%args>
-
-<%perl>
-
-# 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 HTML::Entities;
-use JSON;
-use Data::Dumper;
-
-my $dbh= dbw_connect($ocean);
-
-my $sth= $dbh->prepare("SELECT archipelago,islandid,islandname
-	 			FROM islands WHERE islandname LIKE ?
-	UNION ALL	SELECT DISTINCT archipelago,NULL,archipelago
-				FROM islands WHERE archipelago LIKE ?");
-
-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;
-	my $err= sub {
-		my $msg= sprintf $_[0], encode_entities($each);
-		$output_wrong->($msg);
-	};
-	my %m;
-	my $results;
-	foreach my $pat ("$each\%", "\%$each\%") {
-		$sth->execute($pat,$pat);
-		$results= $sth->fetchall_arrayref();
-		last if @$results==1;
-		map { $m{ $_->[2] }=1 } @$results;
-		$results= undef;
-	}
-	if (!$results) {
-		if (!%m) {
-			return $err->('no island or arch matches "%s"');
-		} elsif (keys(%m) > 5) {
-			return $err->('&nbsp;');
-		} else {
-			return $err->('ambiguous island or arch "%s",'.
-				' could be '.join(', ', sort keys %m));
-		}
-	}
-	push @results, $results->[0];
-}
-
-$canontext= join ' | ', map { $_->[2] } @results;
-return $output->();
-
-</%perl>
+<%attr>
+multiple => 1
+maxambig => 5
+</%attr>
+
+<%method sqlstmt>
+		SELECT islandname,islandid,archipelago
+			FROM islands WHERE islandname LIKE ?
+UNION ALL	SELECT DISTINCT archipelago,NULL,archipelago
+			FROM islands WHERE archipelago LIKE ?
+</%method>
+
+<%method nomatch>
+  no island or arch matches "<% $ARGS{spec} |h %>"
+</%method>
+
+<%method ambiguous>
+  ambiguous island or arch "<% $ARGS{spec} |h %>",
+  could be <% $ARGS{couldbe} |h %>
+</%method>
+
+<%method manyambig>
+  &nbsp;
+</%method>