source: subversion/applications/utils/gary68/OSM/osm.pm @ 24892

Revision 24892, 37.6 KB checked in by gary68, 3 years ago (diff)

new osm.pm version

  • Property svn:executable set to *
Line 
1#
2#
3# PERL osm module by gary68
4#
5# !!! store as osm.pm in folder OSM in lib directory !!!
6#
7# This module contains a lot of useful functions for working with osm files and data. it also
8# includes functions for calculation and output.
9#
10#
11# Copyright (C) 2008, 2009, 2010 Gerhard Schwanz
12#
13# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
14# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
20#
21#
22# version 2
23# - added html table functions
24#
25# Version 3
26# - added project and angle
27# - added support for bz2 files
28#
29# Version 4
30# - add support for relations
31# - select multiple ways in JOSM link
32# - getNode2, getWay2: return tags as arrays
33#
34# Version 4.1
35# - getBugs added
36#
37# Version 4.2
38# - map compare link added
39#
40# Version 4.3
41# - regex for k/v changed
42#
43# Version 4.4
44# -added relation analyzer link
45#
46# Version 4.41 (gary68)
47# - changed regex for openosmfile from /node/ to /<node/ - seems better since changesets are now in planet...
48#
49# Version 4.5 (gary68)
50# - OSB address changed
51#
52# Version 4.6 (gary68)
53# - getnode2 error correction
54#
55# Version 4.7 (gary68)
56# - hidden iframe for josm links
57#
58# Version 4.8
59# - josm dont select added
60#
61# Version 4.9
62# - APIgetWay new
63#
64# Version 5.0
65# - new osm link function
66#
67# Version 5.1
68# - new hash function
69#
70# Version 5.2
71# - josm select nodes added
72#
73# Version 5.3
74# - new html output functions
75#
76# Version 5.4
77# - support negative ids
78#
79# Version 5.5
80# - support comments in osm files
81# - ignore a space after the last attribute in the <node> tag.
82#
83# Version 6.0
84# - regex improvements
85#
86# Version 7.0
87# - skip nodes and skip ways performance boost by using seek in files
88#
89# Version 7.1
90# - get...Xml functions added
91#
92#
93# Version 8.0
94# - read xml subs implemented for different getXXX
95#
96#
97# USAGE
98#
99# analyzerLink ($id)                                    > $htmlString, link to relation analyzer
100# angle (x1,y1,x2,y2)                                   > angle (N=0,E=90...)
101# APIgetWay ($id)                                       > ($wayId, $wayUser, \@wayNodes, \@wayTags)
102# binSearch ($value, @ref)                              > $index or -1
103# closeOsmFile ()
104# checkOverlap (w1xMin, w1yMin, w1xMax, w1yMax, w2xMin, w2yMin, w2xMax, w2yMax)   > 0=no overlap, 1=overlap
105# crossing (g1x1,g1y1,g1x2,g1y2,g2x1,g2y1,g2x2,g2y2)    > ($sx, $sy)
106# distance (x1,y1,x2,y2)                                > $distance in km
107# getBugs ($lon, $lat, $bugsDownDist, $bugsMaxDist)     > pos, down dist in deg, max dist in km -> html text
108# getNode2 ()                                           > ($gId, $gLon, $gLat, $gU, \@gTags) ; # in main @array = @$ref // returns k/v as array, not string!
109# getNode3 ()                                           > (\%nodeProperties \@nodeTags) ; # in main @array = @$ref // returns k/v as array, not string!
110# getNodeXml ()                  > ($gId, $xml) ;
111# getRelation
112# getRelation3                                  > (\%properties, \@members, \@tags)
113# getWay2 ()                                            > ($gId, $gU, \@gNodes, \@gTags) ; # in main @array = @$ref // returns k/v as array, not string!
114# getWay3 ()                                            > (\%properties, \@Nodes, \@Tags) ;
115# getWayXml ()                  > ($gId, $xml) ;
116# getRelationXml ()                  > ($gId, $xml) ;
117# hashValue ($lon, $lat)                                > $hashValue 0.1 deg
118# hashValue2 ($lon, $lat)                               > $hashValue 0.01 deg
119# historyLink ($type, $key)                             > $htmlString
120# josmLinkDontSelect ($lon, $lat, $span)                > $htmlString
121# josmLinkSelectWay ($lon, $lat, $span, $wayId)         > $htmlString
122# josmLinkSelectWays ($lon, $lat, $span, @wayIds)       > $htmlString
123# josmLinkSelectNode ($lon, $lat, $span, $nodeId)       > $htmlString
124# josmLinkSelectNodes ($lon, $lat, $span, @nodes)       > $htmlString
125# DON'T USE ANYMORE! josmLink ($lon, $lat, $span, $wayId)       > $htmlString
126# mapCompareLink ($lon, $lat, $zoom)                    > $htmlString
127# openOsmFile ($file)                                   > osm file open and $line set to first node (*.osm or *.osm.bz2)
128# osbLink ($lon, $lat, $zoom)                                   > $htmlString
129# osmLink ($lon, $lat, $zoom)                                   > $htmlString
130# osmLinkMarkerWay ($lon, $lat, $zoom, $way)            > $htmlString
131# picLinkMapnik ($lon, $lat, $zoom)                     > $htmlString
132# picLinkOsmarender ($lon, $lat, $zoom)                 > $htmlString
133# printGPXHeader ($file)
134# printGPXFoot ($file)
135# printGPXWaypoint ($file, $lon, $lat, $text)
136# printHTMLCellCenter ($file, $value)
137# printHTMLCellLeft ($file, $value)
138# printHTMLCellLeftEM
139# printHTMLCellLeftTwoValues
140# printHTMLCellRight ($file, $value)
141# printHTMLFoot ($file)                                 > print foot to file
142# printHTMLHeader ($file, $title)                       > print header to file
143# printHTMLHeaderiFrame ($file)                         > print iFrame code for josm links, call before body
144# printHTMLRowStart ($file)
145# printHTMLRowEnd ($file)
146# printHTMLTableFoot ($file)
147# printHTMLTableHead ($file)
148# printHTMLTableHeadings ($file, @list)
149# printHTMLTableRowLeft ($file, @list)
150# printHTMLTableRowRight ($file, @list)
151# printNodeList ($file, @list)
152# printProgress ($program, $osm, $startTime, $fullCount, $actualCount)
153# printWayList ($file, @list)
154# project (x1, y1, angle, dist)                         > (x2,y2)
155# shortestDistance ($gx1, $gy1, $gx2, $gy2, $nx, $ny)   > roughly the distance of node to segment in km
156# skipNodes ()
157# skipWays ()
158# stringFileInfo ($file)                                > $string
159# stringTimeSpent ($timeSpent in seconds)               > $string
160# tileNumber ($lon,$lat,$zoom)                          > ($xTile, $yTile)
161#
162
163
164
165
166package OSM::osm ; 
167
168use strict;
169use warnings;
170
171use LWP::Simple;
172use Math::Trig;
173# use IO::Handle ;
174use File::stat;
175use Time::localtime;
176use List::Util qw[min max] ;
177use Compress::Bzip2 ;           # install packet "libcompress-bzip2-perl"
178                                        # if you have problems with this module/library then just comment out all lines using these functions
179                                        # and don't use zipped files
180
181use vars qw($VERSION @ISA @EXPORT @EXPORT_OK) ;
182
183$VERSION = '8.0' ; 
184
185my $apiUrl = "http://www.openstreetmap.org/api/0.6/" ; # way/Id
186
187require Exporter ;
188
189@ISA = qw ( Exporter AutoLoader ) ;
190
191@EXPORT = qw (analyzerLink getBugs getNode2 getNode3 getNodeXml getWay2 getWay3 getWayXml getRelation getRelation3 getRelationXml crossing historyLink hashValue hashValue2 tileNumber openOsmFile osmLink osmLinkMarkerWay osbLink mapCompareLink josmLink josmLinkDontSelect josmLinkSelectWay josmLinkSelectWays josmLinkSelectNode josmLinkSelectNodes printHTMLHeader printHTMLFoot stringTimeSpent distance angle project picLinkMapnik picLinkOsmarender stringFileInfo closeOsmFile skipNodes skipWays binSearch printProgress printNodeList printWayList printGPXHeader printGPXFoot printGPXWaypoint checkOverlap shortestDistance printHTMLTableHead printHTMLTableFoot printHTMLTableHeadings printHTMLTableRowLeft printHTMLTableRowRight printHTMLCellLeft  printHTMLCellLeftEM printHTMLCellLeftTwoValues printHTMLCellCenter printHTMLCellRight printHTMLRowStart printHTMLRowEnd printHTMLiFrameHeader APIgetWay) ;
192
193our $line ; 
194our $file ; 
195our $fileName ;
196my $bufferSize = 512000 ;
197
198my $bz ; my $isBz2 ;
199
200######
201# file
202######
203sub openOsmFile {
204        $fileName = shift ;
205
206        if (grep /.bz2/, $fileName) { $isBz2 = 1 ; } else { $isBz2 = 0 ; }
207
208        if ($isBz2) {
209                $bz = bzopen($fileName, "rb") or die "Cannot open $fileName: $bzerrno\n" ;
210        }
211        else {
212                open ($file, "<", $fileName) || die "can't open osm file" ;
213        }
214
215        nextLine() ;           
216        while ( ! (grep /\<node/, $line) ) {
217                nextLine() ;
218                #print "LINE: $line" ;
219        }
220        return 1 ;
221}
222
223sub closeOsmFile {
224        if ($isBz2) {
225                $bz->bzclose() ;
226        }
227        else {
228                close ($file) ;
229        }
230}
231
232sub stringFileInfo {
233        my $file = shift ;
234        my $string = "file " . $file . " " . ctime(stat($file)->mtime) ;
235        return ($string) ;
236}
237
238sub nextLine {
239        do {
240                if ($isBz2) {
241                        $bz->bzreadline($line) ;
242                }
243                else {
244                        $line = <$file> ;
245                }
246        } while ($line =~ /^<!--/) ;
247}
248
249sub seek_to_way_section
250{
251        my $sb = stat ($fileName) ;
252        my $size = $sb->size ;
253
254     my $firstindex = 0;
255     my $lastindex = $size;
256     my $index = int($size / 2) ;
257
258     while(1)
259     {
260         my $buf;
261         seek($file, $index, 0);
262         read($file, $buf, $bufferSize);
263         my $relationstart = index($buf, "<relation id");
264         my $waystart = index($buf, "<way id");
265         my $nodestart = index($buf, "<node id");
266        # print "$index $nodestart $waystart $relationstart\n" ;
267         if (($waystart > -1) && ($nodestart > -1))
268         {
269             seek($file, $index + $waystart - 1, 0);
270             return;
271         }
272         # elsif ($waystart > -1)
273         elsif ( ($waystart > -1) or ($relationstart > -1) )
274         {
275             $lastindex = $index;
276             $index = int(($index + $firstindex) / 2);
277         }
278         else
279         {
280             $firstindex = $index;
281             $index = int(($index + $lastindex) / 2);
282         }
283     }
284}
285
286sub seek_to_relation_section
287{
288        my $sb = stat ($fileName) ;
289        my $size = $sb->size ;
290     my $firstindex = 0;
291     my $lastindex = $size;
292     my $index = int($size / 2);
293
294     while(1)
295     {
296         my $buf;
297         seek($file, $index, 0);
298         read($file, $buf, $bufferSize);
299         my $relationstart = index($buf, "<relation id");
300         my $waystart = index($buf, "<way id");
301         my $nodestart = index($buf, "<node id");
302        # print "$index $nodestart $waystart $relationstart\n" ;
303         if (($relationstart > -1) && ($waystart > -1))
304         {
305             seek($file, $index + $relationstart - 1, 0);
306             return;
307         }
308         elsif ($relationstart > -1)
309         {
310             $lastindex = $index;
311             $index = int(($index + $firstindex) / 2);
312         }
313         else
314         {
315             $firstindex = $index;
316             $index = int(($index + $lastindex) / 2);
317         }
318     }
319}
320
321
322
323#######
324# NODES
325#######
326sub skipNodes {
327        if ($isBz2) {
328                while ( ! (grep /<way/, $line) ) {
329                        nextLine() ;           
330                }
331        }
332        else {
333                seek_to_way_section() ;
334                nextLine() ;
335        }
336}
337
338
339sub getNode2 {
340        my $gId ; my $gLon ; my $gLat ; my $gU ; 
341        my ($ref0, $ref1) ;
342        if($line =~ /^\s*\<node/) {
343                ($ref0, $ref1) = readNode () ;
344                my %properties = %$ref0 ;
345                $gId = $properties{"id"} ;
346                $gLon = $properties{"lon"} ;
347                $gLat = $properties{"lat"} ;
348                $gU = $properties{"user"} ;
349        } # node
350        else {
351                return (-1, -1, -1, -1, -1) ; 
352        } # node
353        return ($gId, $gLon, $gLat, $gU, $ref1) ;
354} # getNode2
355
356
357sub getNode3 {
358        my $ref0 ; my $ref1 ;
359        if($line =~ /^\s*\<node/) {
360                ($ref0, $ref1) = readNode () ;
361        } 
362        else {
363                return (undef, undef) ; 
364        } 
365        return ($ref0, $ref1) ;
366} # getNode3
367
368
369sub readNode {
370        my $id ; 
371        my $propRef = () ;     
372        my @nodeTags = () ;
373
374        ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
375
376        if (! defined $id ) {
377                print "WARNING reading osm file, line follows (expecting id, lon, lat and user for node):\n", $line, "\n" ; 
378        }
379        else {
380                $propRef = getProperties ($line, "node", $id) ;
381                if ( (grep (/"\s*>/, $line)) or (grep (/'\s*>/, $line)) ) {                  # more lines, get tags
382                        nextLine() ;
383                        while (!grep(/<\/node>/, $line)) {
384                                my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
385                                if ( (defined ($k)) and (defined ($v)) ) {
386                                        my $tag = [$k, $v] ;
387                                        push @nodeTags, $tag ;
388                                }
389                                else {
390                                        #print "WARNING tag not recognized: ", $line, "\n" ;
391                                }
392                                nextLine() ;
393                        }
394                        nextLine() ;
395                }
396                else {
397                        nextLine() ;
398                }
399        }
400        return ($propRef, \@nodeTags) ;
401}
402
403sub getProperties {
404        my ($line, $type, $id) = @_ ;
405        my $version ; my $timestamp ; my $uid ; my $lon ; my $lat ; my $u ; my $cs ; 
406        my %properties = () ;
407        ($u) = ($line =~ / user=[\'\"](.+?)[\'\"]/ ) ;
408        ($version) = ($line =~ / version=[\'\"](.+?)[\'\"]/ ) ;
409        ($timestamp) = ($line =~ / timestamp=[\'\"](.+?)[\'\"]/ ) ;
410        ($uid) = ($line =~ / uid=[\'\"](.+?)[\'\"]/ ) ;
411        ($cs) = ($line =~ / changeset=[\'\"](.+?)[\'\"]/ ) ;
412
413        if ( ! defined $u) { $u = "undefined" ; } 
414        if ( ! defined $version) { $version = "0" ; } 
415        if ( ! defined $uid) { $uid = 0 ; } 
416        if ( ! defined $timestamp) { $timestamp = "" ; } 
417        if ( ! defined $cs) { $cs = "" ; } 
418        $properties{"id"} = $id ;
419        $properties{"user"} = $u ;
420        $properties{"uid"} = $uid ;
421        $properties{"version"} = $version ;
422        $properties{"timestamp"} = $timestamp ;
423        $properties{"changeset"} = $cs ;
424        if ($type eq "node") {
425                ($lon) = ($line =~ / lon=[\'\"](.+?)[\'\"]/ ) ;
426                ($lat) = ($line =~ / lat=[\'\"](.+?)[\'\"]/ ) ;
427                if ( ! defined $lon) { $lon = 0 ; } 
428                if ( ! defined $lat) { $lat = 0 ; } 
429                $properties{"lon"} = $lon ;
430                $properties{"lat"} = $lat ;
431        }
432        return ( \%properties ) ;
433}
434
435sub getNodeXml {
436   my $gId ;
437   my $xml ;
438   my $id ;
439   if($line =~ /^\s*\<node/) {
440      $xml .= $line;
441      my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
442
443      if (! defined $id ) {
444         print "WARNING reading osm file, line follows (expecting id, lon, lat and user for node):\n", $line, "\n" ;
445      }
446
447      unless ($id) { next; }
448      if ( (grep (/"\s*>/, $line)) or (grep (/'\s*>/, $line)) ) {                  # more lines, get tags
449         nextLine() ;
450         while (!grep(/<\/node>/, $line)) {
451
452            $xml .= $line ;
453
454            nextLine() ;
455         }
456         $line =~ /\/node>/ ;
457         $xml .= $line;
458
459         nextLine() ;
460      }
461      else {
462         nextLine() ;
463      }
464      $gId = $id ;
465   } # node
466   else {
467      return (-1, "") ;
468   } # node
469   #print "$gId $gLon $gLat $gU\n" ;
470   return ($gId, $xml) ; # in main @array = @$ref
471} # getNodeXml
472
473
474######
475# WAYS
476######
477
478sub skipWays {
479        if ($isBz2) {
480                while ( ! (grep /<relation/, $line) ) {
481                        nextLine() ;           
482                }
483        }
484        else {
485                seek_to_relation_section() ;
486                nextLine() ;
487        }
488}
489
490
491sub getWay2 {
492        my $gId ;
493        my $gU ;
494        my @gTags ;
495        my @gNodes ;
496        my ($ref0, $ref1, $ref2) ;
497        if($line =~ /^\s*\<way/) {
498                ($ref0, $ref1, $ref2) = readWay () ;
499                my %properties = %$ref0 ;
500                $gId = $properties{"id"} ;
501                $gU = $properties{"user"} ;
502        }
503        else {
504                return (-1, -1, -1, -1) ;
505        }
506        return ($gId, $gU, $ref1, $ref2) ;
507} # getWay2
508
509sub getWay3 {
510        my $ref0 ; my $ref1 ; my $ref3 ;
511        if($line =~ /^\s*\<way/) {
512                ($ref0, $ref1, $ref3) = readWay () ;
513        } 
514        else {
515                return (undef, undef, undef) ; 
516        } 
517        return ($ref0, $ref1, $ref3) ;
518}
519
520sub readWay {
521        my @gNodes ; my @gTags ;
522        my $propRef ;
523       
524        my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
525        if (! defined $id ) {
526                print "WARNING reading osm file, line follows :\n", $line, "\n" ; 
527        }
528        else {
529                $propRef = getProperties ($line, "way", $id) ;
530
531                nextLine() ;
532                while (not($line =~ /\/way>/)) { # more way data
533                        #get nodes and type
534                        my ($node) = ($line =~ /^\s*\<nd ref=[\'\"](\d+)[\'\"]/); # get node id
535                        my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
536
537                        if (!(($node) or ($k and defined($v) ))) {
538                                #print "WARNING tag not recognized", $line, "\n" ;
539                        }
540               
541                        if ($node) {
542                                push @gNodes, $node ;
543                        }
544
545                        #get tags
546                        if ($k and defined($v)) {
547                                my $tag = [$k, $v] ;
548                                push @gTags, $tag ;
549                        }
550                        nextLine() ;
551                }
552                nextLine() ;
553        }
554        return ($propRef, \@gNodes, \@gTags) ;
555}
556
557sub getWayXml {
558   my $gId ;
559   my $xml ;
560   if($line =~ /^\s*\<way/) {
561      my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
562
563      if (! defined $id ) { print "ERROR: $line\n" ; }
564
565      $xml = $line;
566      nextLine() ;
567      while (not($line =~ /\/way>/)) { # more way data
568         #get nodes and type
569         $xml .= $line;
570         nextLine() ;
571      }
572      $xml .= $line;
573      nextLine() ;
574      $gId = $id ;
575   }
576   else {
577      return (-1, "") ;
578   }
579   return ($gId, $xml) ;
580} # getWayXml
581
582
583###########
584# RELATIONS
585###########
586
587sub getRelation {
588        my $gId ;
589        my $gU ;
590        my ($ref1, $ref2) ;
591        my $propRef ;
592
593        if ($line =~ /^\s*\<relation/) {
594
595                ($propRef, $ref1, $ref2) = readRelation () ;
596                my %properties = %$propRef ;
597
598                $gId = $properties{"id"} ;
599                $gU = $properties{"user"} ;
600        }
601        else {
602                return (-1, -1, -1, -1) ;
603        }
604        return ($gId, $gU, $ref1, $ref2) ;
605}
606
607sub getRelation3 {
608        my $ref0 ; my $ref1 ; my $ref2 ;
609        if($line =~ /^\s*\<relation/) {
610                ($ref0, $ref1, $ref2) = readRelation () ;
611        } 
612        else {
613                return (undef, undef, undef) ; 
614        } 
615        return ($ref0, $ref1, $ref2) ;
616}
617
618sub readRelation {
619        my $propRef ; my @gTags ; my @gMembers ;
620
621        my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
622
623        if (! defined $id ) { 
624                print "ERROR: $line\n" ; 
625        }
626        else {         
627
628                $propRef = getProperties ($line, "relation", $id) ;
629
630                nextLine() ;
631                while (not($line =~ /\/relation>/)) { # more data
632                        if ($line =~ /<member/) {
633                                my ($memberType)   = ($line =~ /^\s*\<member type=[\'\"]([\w]*)[\'\"]/); 
634                                my ($memberRef) = ($line =~ /^.+ref=[\'\"](\d*)[\'\"]/);       
635                                my ($memberRole) = ($line =~ /^.+role=[\'\"](.*)[\'\"]/);
636                                if (!$memberRole) { $memberRole = "none" ; }
637                                my @member = [$memberType, $memberRef, $memberRole] ;
638                                push @gMembers, @member ;
639                        }
640                        if ($line =~ /<tag/) {
641                                my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
642                                if (!(($k and defined($v) ))) {
643                                        $k = "unknown" ; $v = "unknown" ;
644                                }
645                                my $tag = [$k, $v] ;
646                                push @gTags, $tag ;
647                        }
648                        nextLine() ;
649                }
650                nextLine() ;
651        }
652        return ($propRef, \@gMembers, \@gTags) ;
653}
654
655
656sub getRelationXml {
657   my $gId ;
658   my $xml;
659   
660   if ($line =~ /^\s*\<relation/) {
661
662      my ($id) = ($line =~ / id=[\'\"](.+?)[\'\"]/ ) ;
663      if (! defined $id ) { print "ERROR: $line\n" ; }
664      $xml .= $line;
665      unless ($id) { next ; }
666
667      nextLine() ;
668      while (not($line =~ /\/relation>/)) { # more data
669         $xml .= $line;
670         nextLine() ;
671      }
672      $gId = $id ;
673      $xml .= $line;
674      nextLine() ;
675   }
676   else {
677      return (-1, "") ;
678   }
679   return ($gId, $xml) ;
680}
681
682
683###########
684# CROSSINGS
685###########
686
687# crossing
688sub crossing {
689
690        my ($g1x1) = shift ;
691        my ($g1y1) = shift ;
692        my ($g1x2) = shift ;
693        my ($g1y2) = shift ;
694       
695        my ($g2x1) = shift ;
696        my ($g2y1) = shift ;
697        my ($g2x2) = shift ;
698        my ($g2y2) = shift ;
699
700        #printf "g1: %f/%f   %f/%f\n", $g1x1, $g1y1, $g1x2, $g1y2 ;
701        #printf "g2: %f/%f   %f/%f\n", $g2x1, $g2y1, $g2x2, $g2y2 ;
702
703
704
705        # wenn punkte gleich, dann 0 !!!
706        # nur geraden pr fen, wenn node ids ungleich !!!
707
708        if (($g1x1 == $g2x1) and ($g1y1 == $g2y1)) { # p1 = p1 ?
709                #print "gleicher punkt\n" ;
710                return (0, 0) ;
711        }
712        if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
713                #print "gleicher punkt\n" ;
714                return (0, 0) ;
715        }
716        if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
717                #print "gleicher punkt\n" ;
718                return (0, 0) ;
719        }
720
721        if (($g1x2 == $g2x2) and ($g1y2 == $g2y2)) { # p2 = p1 ?
722                #print "gleicher punkt\n" ;
723                return (0, 0) ;
724        }
725
726
727        my $g1m ;
728        if ( ($g1x2-$g1x1) != 0 )  {
729                $g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
730        }
731        else {
732                $g1m = 999999 ;
733        }
734
735        my $g2m ;
736        if ( ($g2x2-$g2x1) != 0 ) {
737                $g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
738        }
739        else {
740                $g2m = 999999 ;
741        }
742
743        #printf "Steigungen: m1=%f m2=%f\n", $g1m, $g2m ;
744
745        if ($g1m == $g2m) {   # parallel
746                #print "parallel\n" ;
747                return (0, 0) ;
748        }
749
750        my ($g1b) = $g1y1 - $g1m * $g1x1 ; # abschnitte
751        my ($g2b) = $g2y1 - $g2m * $g2x1 ;
752
753        #printf "b1=%f b2=%f\n", $g1b, $g2b ;
754
755       
756        # wenn punkt auf gerade, dann 1 - DELTA Pr fung !!! delta?
757
758
759        my ($sx) = ($g2b-$g1b) / ($g1m-$g2m) ;             # schnittpunkt
760        my ($sy) = ($g1m*$g2b - $g2m*$g1b) / ($g1m-$g2m);
761
762        #print "schnitt: ", $sx, "/", $sy, "\n" ;
763
764        my ($g1xmax) = max ($g1x1, $g1x2) ;
765        my ($g1xmin) = min ($g1x1, $g1x2) ;     
766        my ($g1ymax) = max ($g1y1, $g1y2) ;     
767        my ($g1ymin) = min ($g1y1, $g1y2) ;     
768
769        my ($g2xmax) = max ($g2x1, $g2x2) ;
770        my ($g2xmin) = min ($g2x1, $g2x2) ;     
771        my ($g2ymax) = max ($g2y1, $g2y2) ;     
772        my ($g2ymin) = min ($g2y1, $g2y2) ;     
773
774        if      (($sx >= $g1xmin) and
775                ($sx >= $g2xmin) and
776                ($sx <= $g1xmax) and
777                ($sx <= $g2xmax) and
778                ($sy >= $g1ymin) and
779                ($sy >= $g2ymin) and
780                ($sy <= $g1ymax) and
781                ($sy <= $g2ymax)) {
782                #print "*******IN*********\n" ;
783                return ($sx, $sy) ;
784        }
785        else {
786                #print "OUT\n" ;
787                return (0, 0) ;
788        }
789
790} # crossing
791
792
793
794####################
795# string linkHistory
796####################
797sub historyLink {
798        my ($type, $key) = @_;
799        return "<a href=\"http://www.openstreetmap.org/browse/$type/$key/history\">$key</a>";
800}
801
802
803
804##############
805# TILE NUMBERS
806##############
807sub tileNumber {
808  my ($lon,$lat,$zoom) = @_;
809  my $xtile = int( ($lon+180)/360 *2**$zoom ) ;
810  my $ytile = int( (1 - log(tan($lat*pi/180) + sec($lat*pi/180))/pi)/2 *2**$zoom ) ;
811  return(($xtile, $ytile));
812}
813
814
815############
816# hashValues
817############
818sub hashValue {
819        my $lon = shift ;
820        my $lat = shift ;
821
822        my $lo = int ($lon*10) * 10000 ;
823        my $la = int ($lat*10) ;
824
825        return ($lo+$la) ;
826}
827
828sub hashValue2 {
829        my $lon = shift ;
830        my $lat = shift ;
831
832        my $lo = int ($lon*100) * 100000 ;
833        my $la = int ($lat*100) ;
834
835        return ($lo+$la) ;
836}
837
838
839######
840# calc
841######
842sub angle {
843#
844# angle from point 1 to point 2
845# N = 0, O = 90, S = 180, W = 270
846#
847    my ($x1, $y1, $x2, $y2) = @_ ;
848
849    my $d_lat = ($y2-$y1) * 111.11 ;
850    my $d_lon = ($x2-$x1) * cos($y1/360*3.14*2) * 111.11 ;
851    my $a = - rad2deg(atan2($d_lat,$d_lon)) + 90 ;
852
853    if ($a < 0) { $a += 360 ; }
854
855    return $a ;
856}
857
858sub project {
859#
860# project point from point by angle and distance in km
861# N = 0, O = 90, S = 180, W = 270
862#
863#
864        my ($x1, $y1, $angle, $dist) = @_ ;
865        my $x2; my $y2 ;
866        my $dLat ; my $dLon ;
867
868        $dLat = $dist * cos ($angle/360*3.141592654*2) ; 
869        $dLon = $dist * sin ($angle/360*3.141592654*2) ; 
870
871        $x2 = $x1 + $dLon / (111.11 * cos($y1/360*3.14*2) ) ;
872        $y2 = $y1 + $dLat / 111.11 ;
873
874        return ($x2, $y2) ;
875}
876
877sub distance {
878        my ($x1, $y1, $x2, $y2) = @_ ;
879        my ($d_lat) = ($y2 - $y1) * 111.11 ;
880        my ($d_lon) = ($x2 - $x1) * cos ( $y1 / 360 * 3.14 * 2 ) * 111.11;
881        my ($dist) = sqrt ($d_lat*$d_lat+$d_lon*$d_lon);
882        return ($dist) ;
883}
884
885sub shortestDistance {
886        #
887        # distance in km ONLY ROUGHLY !!! TODO
888        # better calc point on line first and then calc distance with function above!
889        #
890        my ($gx1, $gy1, $gx2, $gy2, $nx, $ny) = @_ ;
891        my $m ; my $b ; my $t ;
892
893        $t = $gx2 - $gx1 ;
894        if ($t == 0) {
895                my ($d1) = distance ($gx1, $gy1, $nx, $ny) ;
896                my ($d2) = distance ($gx2, $gy2, $nx, $ny) ; 
897                my ($d3) = distance ($gx1, $gy1, $gx2, $gy2) ;
898                my ($d4) = abs ($nx - $gx1) * 111.11 * cos ( $gy1 / 360 * 3.14 * 2 ) ;
899                if ( ($d1 <= $d3) and ($d2 <= $d3) ) {
900                        return (abs ($d4)) ;
901                } 
902                else {
903                        return (999) ;
904                }
905        }
906        else {
907                my ($d10) = distance ($gx1, $gy1, $nx, $ny) ;
908                my ($d20) = distance ($gx2, $gy2, $nx, $ny) ; 
909                my ($d30) = distance ($gx1, $gy1, $gx2, $gy2) ;
910
911                $m = ($gy2 - $gy1) / $t ;
912                $b = $gy1 - $m * $gx1 ;
913                my ($d40) = ($ny - $m * $nx - $b) / sqrt ($m * $m + 1) ;
914               
915                if ( ($d10 <= $d30) and ($d20 <= $d30) ) {
916                        my $result = abs ($d40 * 111.11) ;                     
917                        # print "dist = $result\n" ;
918                        return $result ;
919                }
920                else {
921                        return (999) ;
922                }
923        }
924}
925
926sub checkOverlap {
927        my ($w1xMin, $w1yMin, $w1xMax, $w1yMax, $w2xMin, $w2yMin, $w2xMax, $w2yMax) = @_ ;
928
929        my $result = 1 ;
930
931        if ($w1xMin > $w2xMax) { $result = 0 ; }
932        if ($w2xMin > $w1xMax) { $result = 0 ; }
933        if ($w1yMin > $w2yMax) { $result = 0 ; }
934        if ($w2yMin > $w1yMax) { $result = 0 ; }
935
936        return $result ;
937}
938
939#######
940# links
941#######
942
943sub picLinkMapnik {
944        my $lon = shift ;
945        my $lat = shift ;
946        my $zoom = shift ;
947        my (@res) = tileNumber ($lon, $lat, $zoom) ;
948        my $link = "<img src=\"http://tile.openstreetmap.org/" . $zoom . "/" . $res[0] . "/" . $res[1] . ".png\">" ;
949        return ($link) ;
950}
951
952sub picLinkOsmarender {
953        my $lon = shift ;
954        my $lat = shift ;
955        my $zoom = shift ;
956        my (@res) = tileNumber ($lon, $lat, $zoom) ;
957        my $link = "<img src=\"http://tah.openstreetmap.org/Tiles/tile/" . $zoom . "/" . $res[0] . "/" . $res[1] . ".png\">" ;
958        return ($link) ;
959}
960
961
962
963sub osmLink {
964        my $lon = shift ;
965        my $lat = shift ;
966        my $zoom = shift ;
967        my $string = "<A HREF=\"http://www.openstreetmap.org/?mlat=" . $lat . "&mlon=" . $lon . "&zoom=" . $zoom . "\">OSM</A>" ;
968        return ($string) ;
969}
970
971sub osmLinkMarkerWay {
972        my $lon = shift ;
973        my $lat = shift ;
974        my $zoom = shift ;
975        my $way = shift ;
976        my $string = "<A HREF=\"http://www.openstreetmap.org/?mlat=" . $lat . "&mlon=" . $lon . "&zoom=" . $zoom . "&way=" . $way . "\">OSM marked</A>" ;
977        return ($string) ;
978}
979
980sub osbLink {
981        my $lon = shift ;
982        my $lat = shift ;
983        my $zoom = shift ;
984        my $string = "<A HREF=\"http://openstreetbugs.schokokeks.org/?lon=" . $lon . "&lat=" . $lat . "&zoom=" . $zoom . "\">OSB</A>" ;
985        return ($string) ;
986}
987
988sub mapCompareLink {
989        my $lon = shift ;
990        my $lat = shift ;
991        my $zoom = shift ;
992        my $string = "<A HREF=\"http://tools.geofabrik.de/mc/?mt0=mapnik&mt1=tah&lon=" . $lon . "&lat=" . $lat . "&zoom=" . $zoom . "\">mapcompare</A>" ;
993        return ($string) ;
994}
995
996sub josmLink {
997#
998# DON'T USE ANY LONGER
999#
1000        my $lon = shift ;
1001        my $lat = shift ;
1002        my $span = shift ;
1003        my $way = shift ;
1004        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1005        my $temp = $lon - $span ;
1006        $string = $string . "left=" . $temp ;
1007        $temp = $lon + $span ;
1008        $string = $string . "&right=" . $temp ;
1009        $temp = $lat + $span ;
1010        $string = $string . "&top=" . $temp ;
1011        $temp = $lat - $span ;
1012        $string = $string . "&bottom=" . $temp ;
1013        $string = $string . "&select=way" . $way ;
1014        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1015        return ($string) ;
1016}
1017
1018sub josmLinkDontSelect {
1019        my $lon = shift ;
1020        my $lat = shift ;
1021        my $span = shift ;
1022        my $way = shift ;
1023        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1024        my $temp = $lon - $span ;
1025        $string = $string . "left=" . $temp ;
1026        $temp = $lon + $span ;
1027        $string = $string . "&right=" . $temp ;
1028        $temp = $lat + $span ;
1029        $string = $string . "&top=" . $temp ;
1030        $temp = $lat - $span ;
1031        $string = $string . "&bottom=" . $temp ;
1032        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1033        return ($string) ;
1034}
1035
1036sub josmLinkSelectWay {
1037        my $lon = shift ;
1038        my $lat = shift ;
1039        my $span = shift ;
1040        my $way = shift ;
1041        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1042        my $temp = $lon - $span ;
1043        $string = $string . "left=" . $temp ;
1044        $temp = $lon + $span ;
1045        $string = $string . "&right=" . $temp ;
1046        $temp = $lat + $span ;
1047        $string = $string . "&top=" . $temp ;
1048        $temp = $lat - $span ;
1049        $string = $string . "&bottom=" . $temp ;
1050        $string = $string . "&select=way" . $way ;
1051        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1052        return ($string) ;
1053}
1054
1055sub josmLinkSelectWays {
1056        my ($lon, $lat, $span, @ways) = @_ ;
1057        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1058        my $temp = $lon - $span ;
1059        $string = $string . "left=" . $temp ;
1060        $temp = $lon + $span ;
1061        $string = $string . "&right=" . $temp ;
1062        $temp = $lat + $span ;
1063        $string = $string . "&top=" . $temp ;
1064        $temp = $lat - $span ;
1065        $string = $string . "&bottom=" . $temp ;
1066        $string = $string . "&select=way" . $ways[0] ;
1067        if (scalar @ways > 1) {
1068                my $i ;
1069                for ($i=1; $i < scalar @ways; $i++) {
1070                        $string = $string . ",way" . $ways[$i] ;
1071                }
1072        }
1073        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1074        return ($string) ;
1075}
1076
1077sub josmLinkSelectNode {
1078        my $lon = shift ;
1079        my $lat = shift ;
1080        my $span = shift ;
1081        my $node = shift ;
1082        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1083        my $temp = $lon - $span ;
1084        $string = $string . "left=" . $temp ;
1085        $temp = $lon + $span ;
1086        $string = $string . "&right=" . $temp ;
1087        $temp = $lat + $span ;
1088        $string = $string . "&top=" . $temp ;
1089        $temp = $lat - $span ;
1090        $string = $string . "&bottom=" . $temp ;
1091        $string = $string . "&select=node" . $node ;
1092        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1093        return ($string) ;
1094}
1095
1096sub josmLinkSelectNodes {
1097        my ($lon, $lat, $span, @nodes) = @_ ;
1098        my ($string) = "<A HREF=\"http://localhost:8111/load_and_zoom?" ;
1099        my $temp = $lon - $span ;
1100        $string = $string . "left=" . $temp ;
1101        $temp = $lon + $span ;
1102        $string = $string . "&right=" . $temp ;
1103        $temp = $lat + $span ;
1104        $string = $string . "&top=" . $temp ;
1105        $temp = $lat - $span ;
1106        $string = $string . "&bottom=" . $temp ;
1107        $string = $string . "&select=node" . $nodes[0] ;
1108        if (scalar @nodes > 1) {
1109                my $i ;
1110                for ($i=1; $i < scalar @nodes; $i++) {
1111                        $string = $string . ",node" . $nodes[$i] ;
1112                }
1113        }
1114        $string = $string . "\" target=\"hiddenIframe\">Local JOSM</a>" ;
1115        return ($string) ;
1116}
1117
1118
1119sub analyzerLink {
1120        my $id = shift ;
1121
1122        my $result = "<A HREF=\"http://betaplace.emaitie.de/webapps.relation-analyzer/analyze.jsp?relationId=" . $id . "\">" . $id . "</A>" ;
1123        return $result ;
1124}
1125
1126
1127#####
1128# GPX
1129#####
1130
1131sub printGPXHeader {
1132        my $file = shift ;
1133
1134        print $file "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?>\n" ;
1135        print $file "<gpx xmlns=\"http://www.topografix.com/GPX/1/1\" creator=\"Gary68script\" version=\"1.1\"\n" ;
1136        print $file "    xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n" ;
1137        print $file "    xsi:schemaLocation=\"http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd\">\n" ;
1138}
1139
1140
1141
1142
1143sub printGPXFoot {
1144        my $file = shift ;
1145
1146        print $file "</gpx>\n" ;
1147}
1148
1149
1150
1151
1152sub printGPXWaypoint {
1153        my ($file, $lon, $lat, $text) = @_ ;
1154
1155        print $file "<wpt lat=\"", $lat, "\" lon=\"", $lon, "\">" ;
1156        print $file "<desc>", $text, "</desc></wpt>\n" ;
1157}
1158
1159#######
1160# other
1161#######
1162
1163sub stringTimeSpent {
1164        my $timeSpent = shift ;
1165        my $string ;
1166        $string =  ($timeSpent/(60*60))%99 . " hours, " . ($timeSpent/60)%60 . " minutes and " . $timeSpent%60 . " seconds" ;
1167        return ($string) ;
1168}
1169
1170sub binSearch {
1171    my ($find, $aRef) = @_ ;       
1172
1173    my ($lower, $upper) = (0, @$aRef - 1) ;
1174
1175    my $result ;
1176
1177    while ($upper >= $lower) {
1178        $result = int( ($lower + $upper) / 2) ;
1179        if ($aRef->[$result] < $find) {
1180            $lower = $result + 1 ;
1181        }
1182        elsif ($aRef->[$result] > $find) {
1183            $upper = $result - 1 ;
1184        } 
1185        else {
1186            return ($result) ; 
1187        }
1188    }
1189    return (-1) ;         
1190}
1191
1192sub printProgress {
1193        my $program = shift ;
1194        my $osm = shift ;
1195        my $startTime = shift ;
1196        my $fullCount = shift ;
1197        my $actualCount = shift ;
1198
1199        my ($percent) = $actualCount / $fullCount * 100 ;
1200        my ($time_spent) = (time() - $startTime) / 3600 ;
1201        my ($tot_time) = $time_spent / $actualCount * $fullCount ; 
1202        my ($to_go) = $tot_time - $time_spent ;
1203        printf STDERR "$program - file: %s %d/100 Ttot=%2.1fhrs Ttogo=%2.1fhrs   \n", $osm, $percent, $tot_time, $to_go ; 
1204}
1205
1206
1207######
1208# html
1209######
1210
1211sub printHTMLiFrameHeader {
1212        my $file = shift ;
1213        my $title = shift ;
1214        print $file "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"";
1215        print $file "  \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">";
1216        print $file "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n";
1217        print $file "<head><title>", $title, "</title>\n";
1218        print $file "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n";
1219        print $file "</head>\n";
1220        print $file "<iframe style=\"display:none\" id=\"hiddenIframe\" name=\"hiddenIframe\"></iframe>\n" ;
1221        print $file "<body>\n";
1222        return (1) ;
1223}
1224
1225sub printHTMLHeader {
1226        my $file = shift ;
1227        my $title = shift ;
1228        print $file "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"";
1229        print $file "  \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">";
1230        print $file "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n";
1231        print $file "<head><title>", $title, "</title>\n";
1232        print $file "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n";
1233        print $file "</head>\n<body>\n";
1234        return (1) ;
1235}
1236
1237sub printHTMLFoot {
1238        my $file = shift ;
1239        print $file "</body>\n</html>\n" ;
1240        return (1) ;
1241}
1242
1243sub printWayList {
1244        my ($file, @list) = @_ ;
1245        print $file "<table border=\"1\">\n";
1246        print $file "<tr>\n" ;
1247        print $file "<th>Line</th>\n" ;
1248        print $file "<th>WayId</th>\n" ;
1249        print $file "</tr>\n" ;
1250
1251        my $i = 0 ;
1252        foreach (@list) {
1253                $i++ ;
1254                print $file "<tr><td>$i</td><td>", historyLink ("way", $_) , "</td></tr>\n" ;
1255        }
1256
1257        print $file "</table>\n";
1258}
1259
1260sub printNodeList {
1261        my ($file, @list) = @_ ;
1262        print $file "<table border=\"1\">\n";
1263        print $file "<tr>\n" ;
1264        print $file "<th>Line</th>\n" ;
1265        print $file "<th>NodeId</th>\n" ;
1266        print $file "</tr>\n" ;
1267
1268        my $i = 0 ;
1269        foreach (@list) {
1270                $i++ ;
1271                print $file "<tr><td>$i</td><td>", historyLink ("node", $_) , "</td></tr>\n" ;
1272        }
1273
1274        print $file "</table>\n";
1275}
1276
1277sub printHTMLTableHead {
1278        my ($file) = shift ;
1279        print $file "<table border=\"1\">\n" ;
1280}
1281
1282sub printHTMLTableFoot {
1283        my ($file) = shift ;
1284        print $file "</table>\n" ;
1285}
1286
1287sub printHTMLTableHeadings {
1288        my ($file, @list) = @_ ;
1289        print $file "<tr>\n" ; 
1290        foreach (@list) { print $file "<th>" . $_ . "</th>\n" ; }
1291        print $file "</tr>\n" ; 
1292}
1293
1294sub printHTMLTableRowLeft {
1295        my ($file, @list) = @_ ;
1296        print $file "<tr>\n" ; 
1297        foreach (@list) { print $file "<td align=\"left\">" . $_ . "</td>\n" ; }
1298        print $file "</tr>\n" ; 
1299}
1300
1301sub printHTMLTableRowRight {
1302        my ($file, @list) = @_ ;
1303        print $file "<tr>\n" ; 
1304        foreach (@list) { print $file "<td align=\"right\">" . $_ . "</td>\n" ; }
1305        print $file "</tr>\n" ; 
1306}
1307
1308sub printHTMLCellLeft {
1309        my ($file) = shift ;
1310        my ($value) = shift ;
1311        print $file "<td align=\"left\">" . $value . "</td>\n" ;
1312}
1313
1314sub printHTMLCellLeftEM {
1315        my ($file) = shift ;
1316        my ($value) = shift ;
1317        print $file "<td align=\"left\"><em>" . $value . "</em></td>\n" ;
1318}
1319
1320sub printHTMLCellLeftTwoValues {
1321        my ($file) = shift ;
1322        my ($value1) = shift ;
1323        my ($value2) = shift ;
1324        print $file "<td align=\"left\">" . $value1 . "<br><em>" . $value2 . "</em></td>\n" ;
1325}
1326
1327
1328
1329sub printHTMLCellCenter {
1330        my ($file) = shift ;
1331        my ($value) = shift ;
1332        print $file "<td align=\"center\">" . $value . "</td>\n" ;
1333}
1334
1335sub printHTMLCellRight {
1336        my ($file) = shift ;
1337        my ($value) = shift ;
1338        print $file "<td align=\"right\">" . $value . "</td>\n" ;
1339}
1340
1341sub printHTMLRowStart {
1342        my ($file) = shift ;
1343        print $file "<tr>\n" ;
1344}
1345
1346sub printHTMLRowEnd {
1347        my ($file) = shift ;
1348        print $file "</tr>\n" ;
1349}
1350
1351sub printHTMLiFrame {
1352        my ($file) = shift ;
1353        print $file "<iframe style=\"display:none\" id=\"hiddenIframe\" name=\"hiddenIframe\"></iframe>\n" ;
1354}
1355
1356sub getBugs {
1357        my ($lon, $lat, $bugsDownDist, $bugsMaxDist) = @_ ;
1358        my $resultString = "" ;
1359        my ($x1, $y1, $x2, $y2 ) ;
1360        my %lon = () ;
1361        my %lat = () ;
1362        my %text = () ;
1363        my %open = () ;
1364        my %user = () ;
1365
1366        $x1 = $lon - $bugsDownDist ;
1367        $x2 = $lon + $bugsDownDist ;
1368        $y1 = $lat - $bugsDownDist ;
1369        $y2 = $lat + $bugsDownDist ;
1370        #print "get bugs $x1, $y1, $x2, $y2...\n" ;
1371
1372        sleep 1.5 ;
1373        my ($url) = 'http://openstreetbugs.appspot.com/getBugs?b=' . $y1 . '&t=' . $y2 . '&l=' . $x1 . '&r=' . $x2 ;
1374        my ($content) = get $url ;
1375        if (!defined $content) {
1376                $resultString =  "bugs request error<br>" ;
1377        }
1378        else {
1379                # process string
1380                #print "CONTENT\n", $content, "\n\n" ;
1381                open my $sh, '<', \$content or die $!;
1382                while (<$sh>) {
1383                        my $line = $_ ;
1384                        #print "actual line: $line\n" ;
1385                        my ($id)   = ($line =~ /^putAJAXMarker\((\d+),/) ;
1386                        my ($text)   = ($line =~ /^.*\"([-\w\W\d\D\s\']+)\"/) ;
1387                        my ($user)   = ($line =~ /^.*\[([-\w\W\d\D\s\']+)\]/) ;
1388                        my ($lon, $lat) = ($line =~ /,([-]?[\d]+\.[\d]+),([-]?[\d]+\.[\d]+)/);
1389                        my ($open)   = ($line =~ /.*(\d)\);$/) ;
1390                        if (!$user) { $user = "-" ; }
1391                        #print "\nfields found: $id $text $user $lon $lat $open\n\n" ;
1392                        $text =~ s/<hr \/>/:::/g ;  # replace <HR /> horizontal rulers by ":::"
1393                        $lon{$id} = $lon;
1394                        $lat{$id} = $lat ;
1395                        $text{$id} = $text ;
1396                        if ($open == 0) { $open{$id} = "OPEN" ; } else { $open{$id} = "CLOSED" ; }
1397                        $user{$id} = $user ;
1398
1399                }
1400                close $sh or die $!;
1401                my $id ;
1402                foreach $id (keys %lon) {
1403                        my ($d) = distance ($lon, $lat, $lon{$id}, $lat{$id}) ;
1404                        #print "check id: $id, distance: $d", , "\n" ;
1405                        if ($d < $bugsMaxDist) {
1406                                $d = int ($d * 1000) ;
1407                                $resultString = $resultString . "<strong>" . $open{$id} . "</strong>" . " (" . $d . "m)<br>" ;
1408                                $resultString = $resultString . $text{$id} . "<br>" ;
1409                        }
1410                }
1411        }
1412
1413        #print "$resultString\n\n" ;
1414        return $resultString ;
1415}
1416
1417
1418sub APIgetWay {
1419#
1420# wayId == 0 returned if error
1421#
1422        my ($wayId) = shift ;
1423
1424        my $content ;
1425        my $url ;
1426        my $try = 0 ;
1427        my $wayUser = "" ;
1428        my @wayNodes = () ;
1429        my @wayTags = () ;
1430
1431        #print "\nAPI request for way $wayId\n" ;
1432
1433        while ( (!defined($content)) and ($try < 4) ) {
1434                $url = $apiUrl . "way/" . $wayId ;
1435                $content = get $url ;
1436                $try++ ;
1437        }
1438
1439        #print "API result:\n$content\n\n" ;
1440
1441        if (!defined $content) {
1442                print "ERROR: error receiving OSM query result for way $wayId\n" ;
1443                $wayId = 0 ;
1444                $content = "" ;
1445        }
1446        if (grep(/<error>/, $content)) {
1447                print "ERROR: invalid OSM query result for way $wayId\n" ;     
1448                $wayId = 0 ;
1449        }
1450       
1451        if (defined $content) {
1452                # parse $content
1453                if ($wayId != 0) {
1454                        my (@lines) = split /\n/, $content ;
1455                        foreach my $line (@lines) {
1456                                if (grep /<way id/, $line ) {
1457                                        my ($u) = ($line =~ /^.+user=[\'\"](.*)[\'\"]/) ;
1458                                        if (defined $u) { $wayUser = $u ; } 
1459                                }
1460                                if (grep /<nd ref/, $line ) {
1461                                        my ($node) = ($line =~ /^\s*\<nd ref=[\'\"](\d+)[\'\"]/) ;
1462                                        if (defined $node) { push @wayNodes, $node ; }
1463                                }
1464                                if (grep /<tag k=/, $line ) {
1465                                        my ($k, $v) = ($line =~ /^\s*\<tag k=[\'\"](.+)[\'\"]\s*v=[\'\"](.+)[\'\"]/) ;
1466                                        if ( (defined $k) and (defined $v) ) { push @wayTags, [$k, $v] ; }
1467                                }
1468                        }
1469                }
1470        }
1471
1472        #print "\nAPI result:\n$wayId\nNodes: @wayNodes\nTags: " ;
1473        #foreach my $t (@wayTags) { print "$t->[0]:$t->[1] \n" ; }
1474
1475        return ($wayId, $wayUser, \@wayNodes, \@wayTags) ;
1476}
1477
1478
14791 ;
1480
1481
Note: See TracBrowser for help on using the repository browser.