source: subversion/applications/editors/potlatch2/resources/tinyamf.cgi @ 25367

Last change on this file since 25367 was 21567, checked in by richard, 10 years ago

simple read-only AMF API for use with Halcyon

  • Property svn:executable set to *
File size: 12.6 KB
Line 
1#!/usr/bin/perl -w
2
3        # ----------------------
4        # Tiny AMF read-only API
5        # Richard Fairhurst 2010
6        # richard@systemeD.net
7       
8        # This is the simplest possible server for Halcyon (Flash vector map
9        # renderer) to read from an OpenStreetMap database - populated by
10        # Osmosis, for example. It has no dependencies other than DBI. It
11        # expects to run on Apache or another server that populates the
12        # CONTENT_LENGTH environment variable.
13        #
14        # The database should have the current_ tables populated, and be
15        # consistent with a changeset and user table containing at least one
16        # entry each. Edit the DBI->connect line to contain the connection
17        # details for your database.
18        #
19        # Configure Halcyon's connection like this:
20        #   fo.addVariable("api","tinyamf.cgi?");
21        #   fo.addVariable("connection","AMF");
22        #
23        # Note the question mark at the end of tinyamf.cgi.
24        #
25        # Questions? Patches? Please subscribe to the potlatch-dev mailing
26        # list at lists.openstreetmap.org and ask there.
27
28        # With thanks to Musicman (AMF) and Tom Hughes (quadtiles) from whose
29        # PHP and Ruby code some of this is adapted.
30       
31        # The following globals are maintained throughout the program:
32        #       $d               - input file
33        #       $offset  - position in input file
34        #       $result  - response file
35        #       $results - number of responses
36        #       $dbh     - database handle
37        #       $ppc     - PowerPC or Intel byte-order
38       
39        use DBI;
40        $dbh=DBI->connect('DBI:mysql:openstreetmap','openstreetmap','openstreetmap', { RaiseError =>1 } ); 
41        $"=',';
42       
43        # ----- Get data
44       
45        $l=$ENV{'CONTENT_LENGTH'};
46        read (STDIN, $d, $l);
47
48        $tmp=pack("d", 1); $ppc=0;
49        if        ($tmp eq "\0\0\0\0\0\0\360\77") { $ppc=0; }
50        elsif ($tmp eq "\77\360\0\0\0\0\0\0") { $ppc=1; }
51        else { die "Unknown byte order\n"; }
52
53        # ----- Read headers
54       
55        %headers=();
56        $offset=3;
57        $hc=ord(substr($d,$offset++,1));
58        while (--$hc>=0) {
59                $key=getstr($d, $offset);
60                $offset++;
61                $lo=getlength($d, $offset);     # not used
62                $ch=ord(substr($d,$offset++,1));
63                $val=parseitem($ch, $offset);
64                $headers{$key}=$val;
65        }
66
67        # ----- Read calls
68       
69        $result=''; $results=0;
70        $offset+=2;
71        while ($offset<$l) {
72
73                # -     Get call name
74                $fn=getstr($d, $offset);
75
76                # -     Get number in sequence
77                $seq=substr(getstr($d, $offset),1);
78                $lo=getlength($d, $offset);     # length of all params? not used
79
80                # -     Get all parameters (sent as an array, hence the '10')
81                @params=();
82                $ch=ord(substr($d,$offset++,1)); if ($ch!=10) { print "Error - expecting array"; }
83                $lo=getlength($d, $offset);
84                for ($ni=0; $ni<$lo; $ni++) {
85                        $ch=ord(substr($d,$offset++,1));
86                        $p=parseitem($ch, $offset);
87                        push (@params,$p);
88                }
89
90                if ($fn eq 'whichways') { addresult($seq,whichways(@params)); }
91                elsif ($fn eq 'getway') { addresult($seq,getway(@params)); }
92                elsif ($fn eq 'getrelation') { addresult($seq,getrelation(@params)); }
93               
94        }
95
96        # ----- Write response
97
98        $dbh->disconnect();
99
100        print "Content-type: application/x-amf\n\n";
101        print "\0\0\0\0";
102        print pack("n",$results);
103        print $result;
104       
105
106        # ====================================================================================
107        # whichways
108
109        sub whichways {
110                my ($query,$query2,$sql,$id,$lat,$lon,$v,$k,$vv);
111                my ($xmin,$ymin,$xmax,$ymax)=@_;
112                my $enlarge = ($xmax-$xmin)/8; if ($enlarge<0.01) { $enlarge=0.01; }
113                $xmin -= $enlarge; $ymin -= $enlarge;
114                $xmax += $enlarge; $ymax += $enlarge;
115                my $sqlarea=sql_for_area($ymin,$xmin,$ymax,$xmax,'current_nodes.');
116
117                # -     Ways in area
118
119                $sql=<<EOF;
120    SELECT DISTINCT current_ways.id AS wayid,current_ways.version AS version
121               FROM current_way_nodes
122         INNER JOIN current_nodes ON current_nodes.id=current_way_nodes.node_id
123         INNER JOIN current_ways  ON current_ways.id =current_way_nodes.id
124              WHERE current_nodes.visible=TRUE
125                AND current_ways.visible=TRUE
126                AND $sqlarea
127EOF
128                $query=$dbh->prepare($sql); $query->execute();
129                my $ways=(); my @wayids=();
130                while (($id,$v)=$query->fetchrow_array()) { push (@ways,[$id,$v]); push (@wayids,$id); }
131                $query->finish();
132               
133                # - POIs in area
134               
135                $sql=<<EOF;
136          SELECT current_nodes.id,current_nodes.latitude*0.0000001 AS lat,current_nodes.longitude*0.0000001 AS lon,current_nodes.version
137            FROM current_nodes
138 LEFT OUTER JOIN current_way_nodes cwn ON cwn.node_id=current_nodes.id
139           WHERE current_nodes.visible=TRUE
140             AND cwn.id IS NULL
141             AND $sqlarea
142EOF
143                $query=$dbh->prepare($sql); $query->execute();
144                my @pois=();
145                while (($id,$lat,$lon,$v)=$query->fetchrow_array()) {
146                        my %tags=();
147                        $query2=$dbh->prepare("SELECT k,v FROM current_node_tags WHERE id=?");
148                        $query2->execute($id); while (($k,$vv)=$query2->fetchrow_array()) { $tags{$k}=$vv; }
149                        $query2->finish();
150                        push (@pois,[$id,$lon,$lat,{%tags},$v]);
151                }
152                $query->finish();
153               
154                # - Relations in area
155
156                $sql=<<EOF;
157SELECT DISTINCT cr.id AS relid,cr.version AS version
158           FROM current_relations cr
159     INNER JOIN current_relation_members crm ON crm.id=cr.id
160     INNER JOIN current_nodes ON crm.member_id=current_nodes.id AND crm.member_type='Node'
161          WHERE $sqlarea
162EOF
163                unless ($#wayids) {
164                        $sql.=<<EOF;
165          UNION
166SELECT DISTINCT cr.id AS relid,cr.version AS version
167           FROM current_relations cr
168     INNER JOIN current_relation_members crm ON crm.id=cr.id
169          WHERE crm.member_type='Way'
170            AND crm.member_id IN (@wayids)
171EOF
172                }
173                $query=$dbh->prepare($sql); $query->execute();
174                my @rels=();
175                while (($id,$v)=$query->fetchrow_array()) { push (@rels,[$id,$v]); }
176                $query->finish();
177
178                return [0,'',[@ways],[@pois],[@rels]];
179        }
180
181        # ====================================================================================
182        # getway
183
184        sub getway {
185                my $wayid=$_[0];
186                my ($sql,$query,$lat,$lon,$id,$v,$k,$vv,$uid,%tags);
187                $sql=<<EOF;
188   SELECT latitude*0.0000001 AS lat,longitude*0.0000001 AS lon,current_nodes.id,current_nodes.version
189     FROM current_way_nodes,current_nodes
190    WHERE current_way_nodes.id=?
191      AND current_way_nodes.node_id=current_nodes.id
192      AND current_nodes.visible=TRUE
193 ORDER BY sequence_id
194EOF
195                $query=$dbh->prepare($sql); $query->execute($wayid);
196                my @points=();
197                while (($lat,$lon,$id,$v)=$query->fetchrow_array()) {
198                        %tags=();
199                        $query2=$dbh->prepare("SELECT k,v FROM current_node_tags WHERE id=?");
200                        $query2->execute($id); while (($k,$vv)=$query2->fetchrow_array()) { $tags{$k}=$vv; }
201                        $query2->finish();
202                        push (@points,[$lon,$lat,$id,{%tags},$v]);
203                }
204                $query->finish();
205               
206                $query=$dbh->prepare("SELECT k,v FROM current_way_tags WHERE id=?"); $query->execute($wayid);
207                %tags=();
208                while (($k,$vv)=$query->fetchrow_array()) { $tags{$k}=$vv; }
209                $query->finish();
210               
211                $query=$dbh->prepare("SELECT version FROM current_ways WHERE id=?"); $query->execute($wayid);
212                $v=$query->fetchrow_array();
213                $query->finish();
214               
215                $query=$dbh->prepare("SELECT user_id FROM current_ways,changesets WHERE current_ways.id=? AND current_ways.changeset_id=changesets.id"); $query->execute($wayid);
216                $uid=$query->fetchrow_array();
217                $query->finish();
218
219                return [0, '', $wayid, [@points], {%tags}, $v, $uid];
220        }
221
222        # ====================================================================================
223        # getrelation
224       
225        sub getrelation {
226                my $relid=$_[0];
227                my ($sql,$query,$v,$k,$vv,$type,$id,$role);
228
229                $query=$dbh->prepare("SELECT member_type,member_id,member_role FROM current_relation_members,current_relations WHERE current_relations.id=? AND current_relation_members.id=current_relations.id ORDER BY sequence_id");
230                $query->execute($relid);
231                my @members=();
232                while (($type,$id,$role)=$query->fetchrow_array()) { push(@members,[ucfirst $type,$id,$role]); }
233                $query->finish();
234
235                $query=$dbh->prepare("SELECT k,v FROM current_relation_tags WHERE id=?"); $query->execute($relid);
236                my %tags=();
237                while (($k,$vv)=$query->fetchrow_array()) { $tags{$k}=$vv; }
238                $query->finish();
239               
240                $query=$dbh->prepare("SELECT version FROM current_relations WHERE id=?"); $query->execute($relid);
241                $v=$query->fetchrow_array();
242                $query->finish();
243               
244                return [0, '', $relid, {%tags}, [@members], $v];
245        }
246
247
248        # ====================================================================================
249        # AMF decoding routines
250
251        # returns object of unknown type
252        sub parseitem {
253                my $ch=$_[0];
254
255                if    ($ch==0) { return getnumber(); }                                  # number
256                elsif ($ch==1) { return ord(subtr($d,$offset++,1)); }   # boolean
257                elsif ($ch==2) { return getstr(); }                                             # string
258                elsif ($ch==3) { return getobj(); }                                             # object
259                elsif ($ch==5) { return undef; }                                                # null
260                elsif ($ch==6) { return undef; }                                                # undefined
261                elsif ($ch==8) { return getmixed(); }                                   # mixedArray
262                elsif ($ch==10){ return getarray(); }                                   # array
263
264                print "Didn't recognise type $ch\n";
265        }
266
267        sub getstr {       
268                my $hi=ord(substr($d,$offset++,1));
269                my $lo=ord(substr($d,$offset++,1))+256*$hi;
270                my $val=substr($d,$offset,$lo);
271                $offset+=$lo;
272                return $val;
273        }
274
275
276        sub getnumber {       
277                my $ibf='';
278                if ($ppc) { $ibf=substr($d,$offset,8); }
279                     else { for (my $nc=7; $nc>=0; $nc--) { $ibf.=substr($d,$offset+$nc,1); } }
280                $offset+=8;
281                return unpack("d", $ibf);
282        }
283
284        sub getobj {
285                my %ret=();
286                my ($key,$ch);
287                while($key=getstr()) {
288                        $ch=ord(substr($d,$offset++,1));
289                        $ret{$key}=parseitem($ch);
290                }
291                $ch=ord(substr($d,$offset++,1));
292                if ($ch!=9) { print "Unexpected object end: $ch"; }
293                return $ret;
294        }
295
296        sub getmixed {
297                my $lo=getlength();
298                return getobj();
299        }
300
301        sub getarray {
302                my @ret=();
303                my $lo=getlength();
304                for (my $ni=0; $ni<$lo; $ni++) {
305                        my $ch=ord(substr($d,$offset++,1));
306                        push (@ret,parseitem($ch));
307                }
308                return $ret;
309        }
310
311
312        # ====================================================================================
313        # AMF encoding routines
314
315        # $data is object of unknown type
316        sub addresult {
317                my $seq=$_[0]; my $data=$_[1];
318                $results++;
319                $result.=sendstr("/$seq/onResult").sendstr("null").pack("N",-1).sendobj($data);
320        }
321
322        # $ref is a reference to an object of unknown type
323        sub sendobj {
324                my $ref=$_[0];
325                my $type=ref $ref;
326                my ($key,$first,$n);
327
328                if ($type eq 'ARRAY') {
329                        # Send as array (code 10)
330                        my @arr=@{$ref};
331                        my $ret="\12".pack("N",$#arr+1);
332                        for ($n=0; $n<=$#arr; $n++) { $ret.=sendobj($arr[$n]); }
333                        return $ret;
334
335                } elsif ($type eq 'HASH') {
336                        # Send as object (code 3)
337                        my %hash=%{$ref};
338                        my $ret="\3";
339                        foreach $key (keys %hash) { $ret.=sendstr($key).sendobj($hash{$key}); }
340                        return $ret.sendstr('')."\11";
341
342                } elsif ($ref=~/^[+\-]?[\d\.]+$/) {
343                        # Send as number (code 0)
344                        return "\0" . sendnum($ref);
345
346                } elsif ($ref) {
347                        # Send as string (code 2)
348                        return "\2" . sendstr($ref);
349
350                } else {
351                        # Send as undefined
352                        return "\6";
353                }
354
355        }
356
357        sub sendstr {
358                my $b=$_[0];
359                return pack("n", length($b)).$b;
360        }
361
362        sub sendnum {
363                my $b=pack("d", $_[0]);
364                if ($ppc) { return $b; }
365                my $r=''; for (my $n=7; $n>=0; $n--) { $r.=substr($b,$n,1); }
366                return $r;
367        }
368
369        sub getlength {
370                my $b=0;
371                for (my $c=0; $c<4; $c++) {
372                        $b*=256;
373                        $b+=ord(substr($d,$offset++,1));
374                }
375                return $b;
376        }
377
378        # ================================================================
379        # OSM quadtile routines
380        # based on original Ruby code by Tom Hughes
381
382        sub tile_for_point {
383                my $lat=$_[0]; my $lon=$_[1];
384                return tile_for_xy(round(($lon+180)*65535/360),round(($lat+90)*65535/180));
385        }
386       
387        sub round {
388                return int($_[0] + .5 * ($_[0] <=> 0));
389        }
390       
391        sub tiles_for_area {
392                my $minlat=$_[0]; my $minlon=$_[1];
393                my $maxlat=$_[2]; my $maxlon=$_[3];
394       
395                $minx=round(($minlon + 180) * 65535 / 360);
396                $maxx=round(($maxlon + 180) * 65535 / 360);
397                $miny=round(($minlat + 90 ) * 65535 / 180);
398                $maxy=round(($maxlat + 90 ) * 65535 / 180);
399                @tiles=();
400       
401                for ($x=$minx; $x<=$maxx; $x++) {
402                        for ($y=$miny; $y<=$maxy; $y++) {
403                                push(@tiles,tile_for_xy($x,$y));
404                        }
405                }
406                return @tiles;
407        }
408       
409        sub tile_for_xy {
410                my $x=$_[0];
411                my $y=$_[1];
412                my $t=0;
413                my $i;
414               
415                for ($i=0; $i<16; $i++) {
416                        $t=$t<<1;
417                        unless (($x & 0x8000)==0) { $t=$t | 1; }
418                        $x<<=1;
419       
420                        $t=$t<< 1;
421                        unless (($y & 0x8000)==0) { $t=$t | 1; }
422                        $y<<=1;
423                }
424                return $t;
425        }
426       
427        sub sql_for_area {
428                my $minlat=$_[0]; my $minlon=$_[1];
429                my $maxlat=$_[2]; my $maxlon=$_[3];
430                my $prefix=$_[4];
431                my @tiles=tiles_for_area($minlat,$minlon,$maxlat,$maxlon);
432       
433                my @singles=();
434                my $sql='';
435                my $tile;
436                my $last=-2;
437                my @run=();
438                my $rl;
439               
440                foreach $tile (sort @tiles) {
441                        if ($tile==$last+1) {
442                                # part of a run, so keep going
443                                push (@run,$tile); 
444                        } else {
445                                # end of a run
446                                $rl=@run;
447                                if ($rl<3) { push (@singles,@run); }
448                                          else { $sql.="${prefix}tile BETWEEN ".$run[0].' AND '.$run[$rl-1]." OR "; }
449                                @run=();
450                                push (@run,$tile); 
451                        }
452                        $last=$tile;
453                }
454                $rl=@run;
455                if ($rl<3) { push (@singles,@run); }
456                          else { $sql.="${prefix}tile BETWEEN ".$run[0].' AND '.$run[$rl-1]." OR "; }
457                if ($#singles>-1) { $sql.="${prefix}tile IN (".join(',',@singles).') '; }
458                $sql=~s/ OR $//;
459                return $sql;
460        }
Note: See TracBrowser for help on using the repository browser.