<%args> $ocean $format $ctype => undef $string <%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({ success => 1, show => length $canontext ? encode_entities($canontext) : ' ', })}; $output_wrong= sub { print to_json({ 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 (%m > 5) { return $err->(' '); } 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->();