<%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; db_setocean($ocean); db_connect(); 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 => encode_entities($canontext), })}; $output_wrong= sub { print to_json({ success => 0, show => $_[0], })}; } foreach my $each (split m#[/|,]#, $string) { $each =~ s/^\s*//; $each =~ s/\s*$//; $each =~ s/\s+/ /g; next if !length $each; my $pat= "\%$each\%"; my $nrows= $sth->execute($pat,$pat); my $err= sub { my $msg= sprintf $_[0], encode_entities($each); $output_wrong->($msg); $m->abort(); }; my $results= $sth->fetchall_arrayref(); if (!@$results) { $err->('no island or arch matches "%s"'); } elsif (@$results > 3) { $err->(' '); } elsif (@$results > 1) { my @m= map { $_->[2] } @$results; $err->('ambiguous island or arch "%s", could be '. join(', ', @m)); } push @results, $results->[0]; } $canontext= join ' | ', map { $_->[2] } @results; $output->();