Modify behaviour when removing node from way (minus key): remove, but don't delete...
[potlatch2.git] / resources / tinyamf.cgi
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
127 EOF
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
142 EOF
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;
157 SELECT 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
162 EOF
163                 unless ($#wayids) {
164                         $sql.=<<EOF;
165           UNION 
166 SELECT 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)
171 EOF
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
194 EOF
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         }