chiark / gitweb /
4d59c7fa5e2d4b5697d9e55bb6a00aa7d1e90bc9
[ypp-sc-tools.db-test.git] / yarrg / web / routetextstring
1 <%args>
2 $ocean
3 $format
4 $ctype => undef
5 $string
6 </%args>
7 <%perl>
8
9 # typical url for this script:
10 #  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/routetextstring?format=json&ocean=Midnight&string=d
11
12
13 use CommodsWeb;
14 use HTML::Entities;
15 use JSON;
16 use Data::Dumper;
17
18 my $dbh= dbw_connect($ocean);
19
20 my $sth= $dbh->prepare("SELECT archipelago,islandid,islandname
21                                 FROM islands WHERE islandname LIKE ?
22         UNION ALL       SELECT DISTINCT archipelago,NULL,archipelago
23                                 FROM islands WHERE archipelago LIKE ?");
24
25 my (@results, $canontext);
26 my ($output, $output_wrong);
27
28 if ($format =~ /json/) {
29         $r->content_type($ctype or $format);
30         $output= sub { print to_json({
31                 success => 1,
32                 show => length $canontext ? encode_entities($canontext)
33                         : '&nbsp;',
34                 })};
35         $output_wrong= sub { print to_json({
36                 success => 0,
37                 show => $_[0],
38                 })};
39 }
40 if ($format =~ /return/) {
41         $output= sub { return { Error => '', Results => \@results }; };
42         $output_wrong= sub { return { Error => $_[0] }; };
43 }
44 if ($format =~ /dump/) {
45         $r->content_type('text/plain');
46         $output_wrong= sub { print Dumper(\@_); };
47         $output= sub { print Dumper(\@results, $canontext); };
48 }
49
50 foreach my $each (split m#[/|,]#, $string) {
51         $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
52         next if !length $each;
53         my $err= sub {
54                 my $msg= sprintf $_[0], encode_entities($each);
55                 $output_wrong->($msg);
56         };
57         my %m;
58         my $results;
59         foreach my $pat ("$each\%", "\%$each\%") {
60                 $sth->execute($pat,$pat);
61                 $results= $sth->fetchall_arrayref();
62                 last if @$results==1;
63                 map { $m{ $_->[2] }=1 } @$results;
64                 $results= undef;
65         }
66         if (!$results) {
67                 if (!%m) {
68                         return $err->('no island or arch matches "%s"');
69                 } elsif (%m > 5) {
70                         return $err->('&nbsp;');
71                 } else {
72                         return $err->('ambiguous island or arch "%s",'.
73                                 ' could be '.join(', ', sort keys %m));
74                 }
75         }
76         push @results, $results->[0];
77 }
78
79 $canontext= join ' | ', map { $_->[2] } @results;
80 return $output->();
81
82 </%perl>