source: subversion/applications/utils/gary68/checkrelation.pl @ 26199

Last change on this file since 26199 was 24405, checked in by gary68, 9 years ago

new checkrelation version, less memory

  • Property svn:executable set to *
File size: 44.2 KB
Line 
1#
2#
3# checkrelation.pl by gary68
4#
5#
6# Copyright (C) 2009, Gerhard Schwanz
7#
8# 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
9# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
12# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
15#
16#
17# format boder file (defining the border polygon of the checked area) - same format osmosis accepts for cut polygons
18#
19# name
20# 1
21# lon lat
22# lon lat
23# ...
24# END
25#
26# version 1.2
27# - analyzerLink definition removed from file. is defined in osm.pm
28#
29# version 1.3
30# - double way in relation check added. according output added to html
31#
32# version 1.4 removed ERROR message
33#
34# version 1.5 ignore list implemented
35#
36# version 2.0 memory optimization
37#
38
39
40use strict ;
41use warnings ;
42
43use File::stat ;
44use Time::localtime ; 
45#use String::Scanf ;
46
47use OSM::osm 4.0 ;
48use OSM::osmgraph 2.1 ;
49
50my $program = "checkrelation.pl" ;
51my $usage = $program . " <mode> file.osm baseDir baseName [borderName]\nmode=[M|Re|Ro|B|P]\nM=multipolygon, Re=restriction, Ro=route, B=boundary P=picture" ;
52my $version = "2.0" ;
53
54my @restrictions = qw (no_right_turn no_left_turn no_u_turn no_straight_on only_right_turn only_left_turn only_straight_on) ;
55my @typesChecked = qw (restriction multipolygon boundary route) ; 
56
57my $buffer = 0.15 ;
58my $picSize = 1024 ;
59my $borderThreshold = 1 ;
60
61my %typehash ;
62
63my $wayId ;
64my $wayUser ;
65my @wayNodes ;
66my @wayTags ;
67my $nodeId ;
68my $nodeUser ;
69my $nodeLat ;
70my $nodeLon ;
71my @nodeTags ;
72my $aRef1 ;
73my $aRef2 ;
74
75my $relationId ;
76my $relationUser ;
77my @relationMembers ;
78my @relationTags ;
79my $placeCount = 0 ;
80
81my $relationCount = 0 ;
82my $checkedRelationCount = 0 ;
83my $members = 0 ;
84my @member;
85my $wayCount = 0 ; my $invalidWayCount = 0 ; my %invalidWays ;
86my $nodeCount = 0 ;
87my $problems = 0 ;
88
89my @neededWays = () ;
90my @neededNodes = () ;
91
92my %lon ; my %lat ;
93my %lineMax = () ; my %lineMin = () ;
94my %wayNodesHash ;
95my %placeName ;
96my %ignoredRelations = () ;
97
98my @borderWay = () ;
99
100my $mode ;
101
102my $baseDirName ;
103my $baseName ;
104my $osmName ; 
105my $borderFileName = "" ; 
106my $htmlName ; my $html ;
107my $gpxName ; my $gpx ;
108
109my $time0 = time() ;
110my $totalBorderCheckTime = 0 ;
111my $maxBorderCheckTime = 0 ;
112my $totalSegmentsCheckTime = 0 ;
113my $maxSegmentsCheckTime = 0 ;
114
115
116$mode = shift||'';
117if (!$mode)
118{
119        $mode = "MRoReB" ; # all
120}
121
122$osmName = shift||'';
123if (!$osmName)
124{
125        die (print $usage, "\n");
126}
127
128$baseDirName = shift||'';
129if (!$baseDirName)
130{
131        die (print $usage, "\n");
132}
133
134$baseName = shift||'';
135if (!$baseName)
136{
137        die (print $usage, "\n");
138}
139
140$borderFileName = shift||'';
141if (!$borderFileName)
142{
143        $borderFileName = "" ;
144}
145
146
147my %neededTypes = () ;
148if (grep /Re/, $mode) { $neededTypes{"restriction"} = 1 ; }
149if (grep /Ro/, $mode) { $neededTypes{"route"} = 1 ; }
150if (grep /B/, $mode) { $neededTypes{"boundary"} = 1 ; }
151if (grep /M/, $mode) { $neededTypes{"multipolygon"} = 1 ; }
152
153
154$htmlName = $baseDirName . "/" . $baseName . ".htm" ;
155$gpxName = $baseDirName . "/" . $baseName . ".gpx" ;
156
157print "\n$program $version \nfor file $osmName\nmode = $mode\nborder threshold = $borderThreshold km\n\n" ;
158
159if ($borderFileName ne "") {
160        readBorder ($borderFileName) ;
161}
162
163readIgnoreFile() ;
164
165print "parsing relations...\n" ;
166openOsmFile ($osmName) ;
167print "- skipping nodes...\n" ;
168skipNodes() ;
169print "- skipping ways...\n" ;
170skipWays() ;
171print "- checking...\n" ;
172
173
174($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
175if ($relationId != -1) {
176        @relationMembers = @$aRef1 ;
177        @relationTags = @$aRef2 ;
178}
179
180while ($relationId != -1) {
181
182        # type ?
183        my $type = "" ;
184        foreach my $t (@relationTags) {
185                if ($t->[0] eq "type") { $type = $t->[1] ; }
186                if ($t->[0] eq "restriction") { $type = "restriction" ; }
187        }
188
189        if (defined $neededTypes{$type}) {
190
191                $relationCount++ ;     
192                $members += scalar (@relationMembers) ;
193
194                my $i ;
195                for ($i=0; $i<scalar (@relationMembers); $i++) {
196                        #print "${$relationMembers[$i]}[0] ${$relationMembers[$i]}[1] ${$relationMembers[$i]}[2]\n" ; # type, id, role
197                        if (${$relationMembers[$i]}[0] eq "way") { push @neededWays, ${$relationMembers[$i]}[1] ; }
198                        if (${$relationMembers[$i]}[0] eq "node") { push @neededNodes, ${$relationMembers[$i]}[1] ; }
199                }
200
201                if (scalar (@relationTags) > 0) {
202                        for ($i=0; $i<scalar (@relationTags); $i++) {
203                                #print "${$relationTags[$i]}[0] = ${$relationTags[$i]}[1]\n" ;
204                                if ( ${$relationTags[$i]}[0] eq "type") { $typehash{   ${$relationTags[$i]}[1]     } = 1 ; }
205                        }
206                }
207
208        }
209
210        #next
211        ($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
212        if ($relationId != -1) {
213                @relationMembers = @$aRef1 ;
214                @relationTags = @$aRef2 ;
215        }
216}
217
218print "relation count: $relationCount\n" ;
219my $nw = scalar @neededWays ;
220print "needed ways: $nw\n" ;
221
222closeOsmFile () ;
223
224# parse ways for nodes
225print "parsing ways...\n" ;
226openOsmFile ($osmName) ;
227print "- skipping nodes...\n" ;
228skipNodes() ;
229print "- checking...\n" ;
230
231@neededWays = sort { $a <=> $b } @neededWays ;
232
233($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
234if ($wayId != -1) {
235        @wayNodes = @$aRef1 ;
236        @wayTags = @$aRef2 ;
237}
238while ($wayId != -1) { 
239        my $needed = 0 ;
240        $needed = binSearch ($wayId, \@neededWays ) ;
241        if (scalar (@wayNodes) >= 2) {
242                if ($needed >= 0) {
243                        $wayCount++ ;
244                        @{$wayNodesHash{$wayId}} = @wayNodes ;
245                        push @neededNodes, @wayNodes ;
246                }
247        }
248        else {
249                #print "invalid way (one node only): ", $wayId, "\n" ;
250                $invalidWayCount++ ;
251                $invalidWays{$wayId} = 1 ;
252        }
253
254        # next way
255        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
256        if ($wayId != -1) {
257                @wayNodes = @$aRef1 ;
258                @wayTags = @$aRef2 ;
259        }
260}
261
262closeOsmFile () ;
263
264my $nn = scalar @neededNodes ;
265print "needed nodes: $nn\n" ;
266
267
268# parse nodes for position and places
269print "parsing nodes...\n" ;
270openOsmFile ($osmName) ;
271
272@neededNodes = sort { $a <=> $b } @neededNodes ;
273
274($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
275if ($nodeId != -1) {
276        @nodeTags = @$aRef1 ;
277}
278
279while ($nodeId != -1) {
280        my $needed = 0 ;
281
282        my $Name = "" ; my $place = 0 ; my $tag ;
283        foreach $tag (@nodeTags) {
284                if ( (grep /^place:city/, $tag) and ( ($tag =~ s/://g ) == 1 ) ) { $place = 1 ; }
285                if (grep /^place:town/, $tag) { $place = 1 ; }
286                if (grep /^place_name:/, $tag) { $tag =~ s/^place_name:// ; $Name = $tag ; }
287                my $tag2 = $tag ;
288                if ( (grep /^name:/, $tag) and ( ($tag2 =~ s/://g ) == 1 ) ) { $tag =~ s/^name:// ; $Name = $tag ; }
289        }
290        if ( ($place == 1) and ($Name ne "") ) { $placeName{$nodeId} = $Name ; $placeCount++ ; }
291
292        $needed = binSearch ($nodeId, \@neededNodes ) ;
293        if ( ($needed >= 0) or ($place == 1) ) { $nodeCount++ ; $lon{$nodeId} = $nodeLon ; $lat{$nodeId} = $nodeLat }
294
295        # lineExtr
296        my $latKey = int ($nodeLat*100) / 100 ;
297        if (defined $lineMax{$latKey}) {
298                if ($nodeLon > $lineMax{$latKey}) {
299                        $lineMax{$latKey} = $nodeLon ;
300                }
301                if ($nodeLon < $lineMin{$latKey}) {
302                        $lineMin{$latKey} = $nodeLon ;
303                }
304        }
305        else {
306                $lineMax{$latKey} = $nodeLon ;
307                $lineMin{$latKey} = $nodeLon ;
308        }
309
310        # next
311        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
312        if ($nodeId != -1) {
313                @nodeTags = @$aRef1 ;
314        }
315}
316
317open ($html, ">", $htmlName) || die ("Can't open html output file") ;
318open ($gpx, ">", $gpxName) || die ("Can't open gpx output file") ;
319
320my $line = 0 ;
321printHTMLHeader ($html, "Relation Check by Gary68") ;
322printGPXHeader ($gpx) ;
323
324print $html "<H1>Relation Check by Gary68</H1>\n" ;
325print $html "<p>Version ", $version, "</p>\n" ;
326print $html "<H2>Info</H2>\n" ;
327print $html "<p>", stringFileInfo ($osmName), "<br>\n" ;
328print $html "<p>Mode: $mode</p>\n" ;
329
330# print $html "<p>Checked relation types: @typesChecked</p>\n" ; # see mode !!!
331print $html "<p>Valid restrictions: @restrictions</p>\n" ;
332print $html "<p>Border threshold: $borderThreshold km</p>\n" ;
333print $html "<p>Ignored relation Ids: " ;
334foreach my $id (sort keys %ignoredRelations) { print $html "$id " ; }
335print $html "</p>\n" ;
336
337
338print "parsing relations 2...\n" ;
339print "- skipping ways...\n" ;
340skipWays() ;
341print "- checking...\n" ;
342
343print "\nnumber relations found: $relationCount\n" ;
344
345printHTMLTableHead ($html) ;
346printHTMLTableHeadings ($html, "Line", "RelationId", "Tags", "Issues", "Links") ;
347
348($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
349if ($relationId != -1) {
350        @relationMembers = @$aRef1 ;
351        @relationTags = @$aRef2 ;
352}
353
354my $work = 0 ;
355while ($relationId != -1) {
356        my $i ;
357        my $type = "" ; my $tagText = "" ; my $double = 0 ;
358        my $from = 0 ; my $via = 0  ; my $to = 0  ; my $restrictionType = "" ; my $viaNode = 0 ; my $viaWay = 0 ;
359        my @openEnds ;
360
361        $work++ ;
362        # print "checking relation $relationId\n" ;
363        if (($work % 1000) == 0) { print "...$work relations checked.\n" ; }
364
365        if (scalar (@relationTags) > 0) {
366                for ($i=0; $i<scalar (@relationTags); $i++) {
367                        if ( ${$relationTags[$i]}[0] eq "type") { $type = ${$relationTags[$i]}[1] ; }
368                        if ( ${$relationTags[$i]}[0] eq "restriction") { $restrictionType= ${$relationTags[$i]}[1] ; }
369                        if (grep /^type/, ${$relationTags[$i]}[0]) {
370                                $tagText = $tagText . "<strong>" . ${$relationTags[$i]}[0] . " : " . ${$relationTags[$i]}[1] . "</strong><br>\n" ;
371                        }
372                        else {
373                                $tagText = $tagText . ${$relationTags[$i]}[0] . " : " . ${$relationTags[$i]}[1] . "<br>\n" ;
374                        }
375                }
376        }
377
378        my %count = () ;
379        my @doubleWays = () ;
380        foreach my $member (@relationMembers) {
381                if ($member->[0] eq "way") {
382                        if (defined ($count{$member->[1]})) {
383                                $count{$member->[1]}++ ;
384                        }
385                        else {
386                                $count{$member->[1]} = 1 ;
387                        }
388                }
389        }
390
391        foreach my $way (keys %count) {
392                if ( $count{$way} > 1 ) {
393                        # print "ERROR: relation $relationId contains way $way at least TWICE\n" ;
394                        $double = 1 ;
395                        push @doubleWays, $way ;
396                }
397        }
398
399        ##############
400        # RESTRICTIONS
401        ##############
402
403        if ( ($type eq "restriction") and (grep /Re/, $mode) ) {
404                $checkedRelationCount++ ;
405                for ($i=0; $i<scalar (@relationMembers); $i++) {
406                        #print "${$relationMembers[$i]}[0] ${$relationMembers[$i]}[1] ${$relationMembers[$i]}[2]\n" ; # type, id, role
407                        if ( (${$relationMembers[$i]}[0] eq "node") and (${$relationMembers[$i]}[2] eq "via") ) { $via++ ; $viaNode = ${$relationMembers[$i]}[1] ; }
408                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "via") ) { $via++ ; $viaWay = ${$relationMembers[$i]}[1] ; }
409                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "from") ) { $from++ ; }
410                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "to") ) { $to++ ; }
411                }
412                my $validRestriction = 0 ;
413                foreach (@restrictions) {
414                        if ($_ eq $restrictionType) { $validRestriction = 1 ; }
415                }
416                if ( ( (!$validRestriction) or ($via != 1) or ($from != 1) or ($from != 1) )
417                        and (!defined $ignoredRelations{$relationId}) ) {
418                        $problems++ ;
419                        $line++ ;
420                        my $problemText = "" ;
421                        if (!$validRestriction) { $problemText = $problemText . "<strong>invalid restriction string: $restrictionType</strong> * " ; }
422                        if ($via == 0) { $problemText = $problemText . "<strong>no \"via\" specified</strong> * " ; }
423                        if ($via > 1) { $problemText = $problemText . "<strong>more than one \"via\" specified</strong> * " ; }
424                        if ($from !=1) { $problemText = $problemText . "<strong>number \"from\" ways != 1</strong> * " ; }
425                        if ($to !=1) { $problemText = $problemText . "<strong>number \"to\" ways != 1</strong> * " ; }
426                        printHTMLRowStart ($html) ;
427                        printHTMLCellLeft ($html, $line ) ;
428                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
429                        printHTMLCellLeft ($html, $tagText ) ;
430                        printHTMLCellLeft ($html, $problemText ) ;
431                        if ($viaNode != 0) {
432                                my $temp = "\"via\" node " . historyLink("node", $viaNode) . " in " ;
433                                $temp = $temp . josmLinkSelectNode ($lon{$viaNode}, $lat{$viaNode}, 0.003, $viaNode) . " * " ;
434                                $temp = $temp . osmLink ($lon{$viaNode}, $lat{$viaNode}, 16) . " * " ;
435                                $temp = $temp . osbLink ($lon{$viaNode}, $lat{$viaNode}, 16) ;
436                                printGPXWaypoint ($gpx, $lon{$viaNode}, $lat{$viaNode}, "restriction relation with problem(s)") ;
437                                printHTMLCellLeft ($html, $temp) ;
438                        }
439                        else {
440                                printHTMLCellLeft ($html, "") ;
441                        }
442                        printHTMLRowEnd ($html) ;
443                }
444        } # restriction
445
446
447        ##############
448        # MULTIPOLYGON
449        ##############
450        if ( ($type eq "multipolygon")  and (grep /M/, $mode) ) {
451                $checkedRelationCount++ ;
452                my $text = "" ; my $textInner = "" ; my $textOuter = "" ; my $textBoundary = "" ;
453                my $inner = 0 ; my $outer = 0 ; my @innerWays = () ; my @outerWays = () ; my @noRoleWays = () ;
454                my $check = 1 ; # 0 = contains invalid ways ;
455                my $firstWay = 0 ;
456
457                # parse members
458                for ($i=0; $i<scalar (@relationMembers); $i++) {
459
460                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "inner") ) { 
461                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
462                                $inner++ ; push @innerWays, ${$relationMembers[$i]}[1] ; 
463                                if ($firstWay == 0) { $firstWay = ${$relationMembers[$i]}[1] ;}
464                        }
465                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "outer") ) { 
466                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
467                                $outer++ ; push @outerWays, ${$relationMembers[$i]}[1] ; 
468                                if ($firstWay == 0) { $firstWay = ${$relationMembers[$i]}[1] ;}
469                        }
470                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "none") ) { 
471                                if ($firstWay == 0) { $firstWay = ${$relationMembers[$i]}[1] ;}
472                                push @noRoleWays, ${$relationMembers[$i]}[1] ;
473                                $text = "<strong>at least one way given without role</strong><br>" ;
474                        }
475                }
476
477                if ( ($check) and ($double == 0) ) {
478                        my $openTextInner = "" ; my $openTextOuter = "" ; my $noOuterText = "" ; 
479       
480                        # CHECK OPEN WAYS/SEGMENTS
481                        my $segCount ; my $segOpenCount ; my @openEndsList = () ;
482       
483                        if (scalar @innerWays > 0) {
484                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@innerWays) ;
485                                $textInner = "#inner segs: " . $segCount . " #open segs: " . $segOpenCount . "<br>" ;
486                                if ($segOpenCount != 0) {
487                                        $text = $text . "<strong>at least one open inner segment</strong><br>\n" ;
488                                        #$openTextInner = "<strong>JOSM links open ends inner ways:</strong><br> " . listEnds (@openEndsList) ;
489                                        $openTextInner = "<strong>JOSM links open ends inner ways:</strong><br> " . listEnds (@openEnds) ;
490                                        push @openEndsList, @openEnds ;
491                                }
492                        }
493       
494                        if (scalar @outerWays > 0) {
495                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@outerWays) ;
496                                $textOuter = "#outer segs: " . $segCount . " #open segs: " . $segOpenCount . "<br>" ;
497                                if ($segOpenCount > 0) {
498                                        $text = $text . "<strong>at least one open outer segment</strong><br>\n" ;
499                                        #$openTextOuter = "<strong>JOSM links open ends outer ways:</strong><br> " . listEnds (@openEndsList) ;
500                                        $openTextOuter = "<strong>JOSM links open ends outer ways:</strong><br> " . listEnds (@openEnds) ;
501                                        push @openEndsList, @openEnds ;
502                                }
503                        }
504                        else {
505                                $text = $text . "<strong>no outer way</strong><br>\n" ;
506                                if ($firstWay != 0) {
507                                        $noOuterText = "Link to first given way: " . 
508                                                josmLinkSelectWay ($lon{$wayNodesHash{$firstWay}[0]}, $lat{$wayNodesHash{$firstWay}[0]}, 0.003, $firstWay) ;
509                                }
510                        }
511                        if ( ( ($text ne "") and (minDistToBorderOK (@openEndsList) ) )
512                                and (!defined $ignoredRelations{$relationId}) ) {
513                                $line++ ;
514                                $problems++ ;
515                                #print "relation: $relationId distance: ", minDistToBorder(@innerWays, @outerWays), "\n" ;
516                                printHTMLRowStart ($html) ;
517                                printHTMLCellLeft ($html, $line ) ;
518                                if (grep /P/, $mode) {
519                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) . "<br>" . linkLocal ($relationId) ) ;
520                                }
521                                else {
522                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
523                                }
524                                printHTMLCellLeft ($html, $tagText ) ;
525                                printHTMLCellLeft ($html, $textOuter . $textInner . $text ) ;
526                                printHTMLCellLeft ($html, $openTextInner . "<br>" . $openTextOuter  . "<br>" . $noOuterText) ;
527                                printHTMLRowEnd ($html) ;
528
529                                my $node ;
530                                foreach $node (@openEndsList) {
531                                        printGPXWaypoint ($gpx, $lon{$node}, $lat{$node}, "open end from multypolygon relation id=" . $relationId ) ;
532                                }
533
534                                if (grep /P/, $mode) {
535                                        my @initWays ; 
536                                        push @initWays, @innerWays, @outerWays, @noRoleWays ;
537                                        if (scalar @initWays > 0) {
538                                                my ($lonMin, $latMin, $lonMax, $latMax) = calcRange (@initWays) ;
539                                                my $way ; my $node ;
540                                                initGraph ($picSize, $lonMin, $latMin, $lonMax, $latMax) ;
541                                                drawPlaces() ;
542                                                drawBorder2 (@borderWay) ;
543                                                foreach $way (@innerWays) {
544                                                        drawWay ("blue", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
545                                                }
546                                                foreach $way (@outerWays) {
547                                                        drawWay ("black", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
548                                                }
549                                                foreach $way (@noRoleWays) {
550                                                        drawWay ("gray", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
551                                                }
552                                                foreach $node (@openEndsList) {
553                                                        drawNodeCircle ($lon{$node}, $lat{$node}, "red", 7) ; # / size (1..5)
554                                                        drawTextPos ($lon{$node}, $lat{$node}, 3, 3, $node, "red", 2)
555                                                }
556                                                drawHead ($program . " ". $version . " by Gary68 for Id: " . $relationId . ", " . $type, "black", 3) ;
557                                                drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
558                                                drawLegend (3, "Border of file", "green", "Open end", "red", "Inner way", "blue", "No role (defaults to outer)", "gray", "Outer way", "black") ;
559                                                drawRuler ("black") ;
560                                                writeGraph ($baseDirName . "/" . $baseName . $relationId . ".png") ;
561                                        }
562                                }
563                        }
564                }
565                else {
566                        if ($double == 1) {
567                                $line++ ;
568                                $problems++ ;
569                                printHTMLRowStart ($html) ;
570                                printHTMLCellLeft ($html, $line ) ;
571                                printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
572                                printHTMLCellLeft ($html, $tagText ) ;
573                                printHTMLCellLeft ($html, "Relation contains ways twice: @doubleWays\n" ) ;
574                                printHTMLCellLeft ($html, "" ) ;
575                                printHTMLRowEnd ($html) ;
576                        }
577                }
578        } # multipolygon
579
580
581        ##########
582        # BOUNDARY
583        ##########
584        if ( ($type eq "boundary") and (grep /B/, $mode) ) {
585                $checkedRelationCount++ ;
586                my $text = "" ;
587                my $textInner = "" ; my $textOuter = "" ; my $textBoundary = "" ;
588                my $inner = 0 ; my $outer = 0 ; my $boundary = 0 ; my @innerWays = () ; my @outerWays = () ; my @boundaryWays = () ; 
589                my @openEndsList = () ;
590                my $check = 1 ; # 0 = contains invalid ways ;
591
592                # parse members
593                for ($i=0; $i<scalar (@relationMembers); $i++) {
594                        if ( (${$relationMembers[$i]}[0] eq "way") and ((${$relationMembers[$i]}[2] eq "inner") or (${$relationMembers[$i]}[2] eq "enclave") ) ) { 
595                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
596                                $inner++ ; push @innerWays, ${$relationMembers[$i]}[1] ; 
597                        }
598                        if ( (${$relationMembers[$i]}[0] eq "way") and ((${$relationMembers[$i]}[2] eq "outer") or (${$relationMembers[$i]}[2] eq "exclave") ) ) { 
599                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
600                                $outer++ ; push @outerWays, ${$relationMembers[$i]}[1] ; 
601                        }
602                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "none") ) { 
603                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
604                                $boundary++ ; push @boundaryWays, ${$relationMembers[$i]}[1] ; 
605                        }
606
607                        # RELATION?
608                        if  (${$relationMembers[$i]}[0] eq "relation") { 
609                                $check = 0 ; # TODO
610                        }
611                }
612
613                if ( ($check) and ($double == 0) ) {
614                        my $segCount ; my $segOpenCount ;
615                        my $openTextInner = "" ; my $openTextOuter = "" ; my $openTextBoundary = "" ;
616
617                        #boundary
618                        if (scalar @boundaryWays > 0) {
619                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@boundaryWays) ;
620                                $textBoundary = "#boundary segs: " . $segCount . " #open segs: " . $segOpenCount . "<br>" ;
621                                if ($segOpenCount != 0) {
622                                        $text = "<strong>at least one open boundary segment</strong><br>\n" ;
623                                        $openTextBoundary = "<strong>JOSM links open ends boundary ways:</strong><br> " . listEnds (@openEnds) ;
624                                        push @openEndsList, @openEnds ;
625                                }
626                        }
627                        else {
628                                $text = $text . "<strong>no boundary ways</strong><br>" ;
629                        }
630
631                        #enclave
632                        if (scalar @innerWays > 0) {
633                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@innerWays) ;
634                                $textInner = "#inner segs: " . $segCount . " #open segs: " . $segOpenCount . "<br>" ;
635                                if ($segOpenCount != 0) {
636                                        $text = "<strong>at least one open inner (enclave) segment</strong><br>\n" ;
637                                        $openTextInner = "<strong>JOSM links open ends inner/enclave ways:</strong><br> " . listEnds (@openEnds) ;
638                                        push @openEndsList, @openEnds ;
639                                }
640                        }
641
642                        #exclave
643                        if (scalar @outerWays > 0) {
644                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@outerWays) ;
645                                $textOuter = "#outer segs: " . $segCount . " #open segs: " . $segOpenCount . "<br>" ;
646                                if ($segOpenCount != 0) {
647                                        $text = "<strong>at least one open outer (exclave) segment</strong><br>\n" ;
648                                        $openTextOuter = "<strong>JOSM links open ends outer/exclave ways:</strong><br> " . listEnds (@openEnds) ;
649                                        push @openEndsList, @openEnds ;
650                                }
651                        }
652                        if (    ($text ne "") and 
653                                ( minDistToBorderOK (@openEndsList) ) and 
654                                (!defined $ignoredRelations{$relationId}) ) {
655                                $line++ ;
656                                $problems++ ;
657                                printHTMLRowStart ($html) ;
658                                printHTMLCellLeft ($html, $line ) ;
659                                if (grep /P/, $mode) {
660                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) . "<br>" . linkLocal ($relationId) ) ;
661                                }
662                                else {
663                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
664                                }
665                                printHTMLCellLeft ($html, $tagText ) ;
666                                printHTMLCellLeft ($html, $textBoundary . $textOuter . $textInner . $text ) ;
667                                printHTMLCellLeft ($html, $openTextBoundary . "<br>" . $openTextInner . "<br>" . $openTextOuter ) ;
668                                printHTMLRowEnd ($html) ;
669
670                                my $node ;
671                                foreach $node (@openEndsList) {
672                                        printGPXWaypoint ($gpx, $lon{$node}, $lat{$node}, "open end from boundary relation id=" . $relationId ) ;
673                                }
674
675                                if (grep /P/, $mode) {
676                                        my @initWays ; 
677                                        push @initWays, @innerWays, @outerWays, @boundaryWays ;
678                                        if (scalar @initWays > 0) {
679                                                my ($lonMin, $latMin, $lonMax, $latMax) = calcRange (@initWays) ;
680                                                my $way ; my $node ;
681                                                initGraph ($picSize, $lonMin, $latMin, $lonMax, $latMax) ;
682                                                drawPlaces() ;
683                                                drawBorder2 (@borderWay) ;
684                                                foreach $way (@innerWays) {
685                                                        drawWay ("blue", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
686                                                }
687                                                foreach $way (@outerWays) {
688                                                        drawWay ("red", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
689                                                }
690                                                foreach $way (@boundaryWays) {
691                                                        drawWay ("black", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
692                                                }
693                                                foreach $node (@openEndsList) {
694                                                        drawNodeCircle ($lon{$node}, $lat{$node}, "red", 7) ; # / size (1..5)
695                                                        drawTextPos ($lon{$node}, $lat{$node}, 3, 3, $node, "red", 2)
696                                                }
697                                                drawHead ($program . " ". $version . " by Gary68 for Id: " . $relationId . ", " . $type, "black", 3) ;
698                                                drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
699                                                drawLegend (3, "Border of file", "green", "Open end", "red", "Inner way", "blue", "Outer way", "red", "Boundary way", "black") ;
700                                                drawRuler ("black") ;
701                                                writeGraph ($baseDirName . "/" . $baseName . $relationId . ".png") ;
702                                        }
703                                }
704
705                        }
706                }
707                else {
708                        if ($double == 1) {
709                                $line++ ;
710                                $problems++ ;
711                                printHTMLRowStart ($html) ;
712                                printHTMLCellLeft ($html, $line ) ;
713                                printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
714                                printHTMLCellLeft ($html, $tagText ) ;
715                                printHTMLCellLeft ($html, "Relation contains ways twice: @doubleWays\n" ) ;
716                                printHTMLCellLeft ($html, "" ) ;
717                                printHTMLRowEnd ($html) ;
718                        }
719                }
720        } # boundary
721
722        #######
723        # ROUTE
724        #######
725        if ( ($type eq "route") and (grep /Ro/, $mode) ) {
726                $checkedRelationCount++ ;
727                my $text = "" ;
728                my $textForward = "" ; my $textBackward = "" ;
729                my $route = 0 ; my @forwardWays = () ; my @backwardWays = () ; 
730                my $openTextForward = "" ; my $openTextBackward = "" ; 
731                my @normalWaysDraw = () ; my @forwardWaysDraw = () ; my @backwardWaysDraw = () ; my @openEndsList = () ; my @otherWaysDraw = () ;
732                my $check = 1 ; # 0 = contains invalid ways ;
733
734                # parse members
735                for ($i=0; $i<scalar (@relationMembers); $i++) {
736                        my ($role) = ${$relationMembers[$i]}[2] ;
737                        #print "${$relationMembers[$i]}[0] ${$relationMembers[$i]}[1] ROLE: ${$relationMembers[$i]}[2]\n" ; # type, id, role
738                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "none") ) { 
739                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
740                                $route++ ; 
741                                push @forwardWays, ${$relationMembers[$i]}[1] ; 
742                                push @backwardWays, ${$relationMembers[$i]}[1] ; 
743                                push @normalWaysDraw, ${$relationMembers[$i]}[1] ;
744                        }
745                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "forward") ) { 
746                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
747                                $route++ ; 
748                                push @forwardWays, ${$relationMembers[$i]}[1] ; 
749                                push @forwardWaysDraw, ${$relationMembers[$i]}[1] ; 
750                        }
751                        if ( (${$relationMembers[$i]}[0] eq "way") and (${$relationMembers[$i]}[2] eq "backward") ) { 
752                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
753                                $route++ ; 
754                                push @backwardWays, ${$relationMembers[$i]}[1] ; 
755                                push @backwardWaysDraw, ${$relationMembers[$i]}[1] ; 
756                        }
757                        if ( (${$relationMembers[$i]}[0] eq "way") and 
758                                ( ($role eq "shortcut") or ($role eq "variation") or ($role eq "excursion") ) ) { 
759                                if (defined ($invalidWays{${$relationMembers[$i]}[1]})) { $check = 0 ; }
760                                $route++ ; 
761                                push @otherWaysDraw, ${$relationMembers[$i]}[1] ; 
762                        }
763                }
764
765                if ( ($check) and ($double == 0) ) {
766                        my $segCount ; my $segOpenCount ;
767
768                        # forward
769                        if (scalar (@forwardWays) > 0) {
770                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@forwardWays) ;
771                                $textForward = "#fw segs: " . $segCount . "<br>" ;
772                                if ($segCount > 1) {
773                                        $text = $text . "<strong>forward route segmented</strong><br>\n" ;
774                                        $openTextForward = "<strong>JOSM links open ends forward ways:</strong><br> " . listEnds (@openEnds) ;
775                                        push @openEndsList, @openEnds ;
776                                }
777                        }
778                        else {
779                                $text = $text . "<strong>no forward ways</strong><br>" ;
780                        }
781
782                        # backward
783                        if (scalar (@backwardWays) > 0) {
784                                ($segCount, $segOpenCount, @openEnds) = checkSegments2 (@backwardWays) ;
785                                $textBackward = "#bw segs: " . $segCount . "<br>" ;
786                                if ($segCount > 1) {
787                                        $text = $text . "<strong>backward route segmented</strong><br>\n" ;
788                                        $openTextBackward = "<strong>JOSM links open ends backward ways:</strong><br> " . listEnds (@openEnds) ;
789                                        push @openEndsList, @openEnds ;
790                                }
791                        }
792                        else {
793                                $text = $text . "<strong>no backward ways</strong><br>" ;
794                        }
795
796                        if (    ($text ne "") and 
797                                ( minDistToBorderOK (@openEndsList) ) and 
798                                ( !defined $ignoredRelations{$relationId}) ) {
799                                $line++ ;
800                                $problems++ ;
801
802                                printHTMLRowStart ($html) ;
803                                printHTMLCellLeft ($html, $line ) ;
804                                if (grep /P/, $mode) {
805                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) . "<br>" . linkLocal ($relationId) ) ;
806                                }
807                                else {
808                                        printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
809                                }
810                                printHTMLCellLeft ($html, $tagText ) ;
811                                printHTMLCellLeft ($html, $textForward . $textBackward . $text ) ;
812                                printHTMLCellLeft ($html, $openTextForward . "<br>" . $openTextBackward ) ;
813                                printHTMLRowEnd ($html) ;
814
815                                if (grep /P/, $mode) {
816                                        my @initWays ; 
817                                        push @initWays, @forwardWaysDraw, @backwardWaysDraw, @normalWaysDraw, @otherWaysDraw ;
818                                        if (scalar @initWays > 0) {
819                                                my ($lonMin, $latMin, $lonMax, $latMax) = calcRange (@initWays) ;
820                                                my $way ; my $node ;
821                                                initGraph ($picSize, $lonMin, $latMin, $lonMax, $latMax) ;
822                                                drawPlaces() ;
823                                                drawBorder2 (@borderWay) ;
824                                                foreach $way (@normalWaysDraw) {
825                                                        drawWay ("black", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
826                                                }
827                                                foreach $way (@forwardWaysDraw) {
828                                                        drawWay ("blue", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
829                                                }
830                                                foreach $way (@backwardWaysDraw) {
831                                                        drawWay ("red", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
832                                                }
833                                                foreach $way (@otherWaysDraw) {
834                                                        drawWay ("gray", 2, nodes2Coordinates (@{$wayNodesHash{$way}}) ) ;
835                                                }
836                                                foreach $node (@openEndsList) {
837                                                        drawNodeCircle ($lon{$node}, $lat{$node}, "red", 7) ; # / size (1..5)
838                                                        drawTextPos ($lon{$node}, $lat{$node}, 3, 3, $node, "red", 2)
839                                                }
840                                                drawHead ($program . " ". $version . " by Gary68 for Id: " . $relationId . ", " . $type, "black", 3) ;
841                                                drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
842                                                drawLegend (3, "Border of file", "green", "Open end", "red", "Other way", "gray", "Forward way", "blue", "Backward way", "red", "Normal way", "black") ;
843                                                drawRuler ("black") ;
844                                                writeGraph ($baseDirName . "/" . $baseName . $relationId . ".png") ;
845                                        }
846                                }
847
848                        }
849                }
850                else {
851                        if ($double == 1) {
852                                $line++ ;
853                                $problems++ ;
854                                printHTMLRowStart ($html) ;
855                                printHTMLCellLeft ($html, $line ) ;
856                                printHTMLCellLeft ($html, historyLink ("relation", $relationId) . "(OSM)<br>" . analyzerLink ($relationId) ) ;
857                                printHTMLCellLeft ($html, $tagText ) ;
858                                printHTMLCellLeft ($html, "Relation contains ways twice: @doubleWays\n" ) ;
859                                printHTMLCellLeft ($html, "" ) ;
860                                printHTMLRowEnd ($html) ;
861                        }
862                }
863        } # route
864
865        #next
866        ($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
867        if ($relationId != -1) {
868                @relationMembers = @$aRef1 ;
869                @relationTags = @$aRef2 ;
870        }
871}
872
873closeOsmFile () ;
874
875print "\nTYPES FOUND\n" ;
876foreach (sort keys %typehash) { print "- ", $_, "\n" ; }
877print "\n" ;
878
879print "STATISTICS\n" ;
880print "number problems $problems\n" ;
881print "number relations $relationCount\n" ;
882print "number checked relations $checkedRelationCount\n" ;
883print "number members $members\n" ;
884print "number member ways $wayCount\n" ;
885print "number member ways invalid $invalidWayCount\n" ;
886print "number related nodes $nodeCount\n" ;
887print "number places $placeCount\n" ;
888print "total segments check time $totalSegmentsCheckTime\n" ;
889print "max segments check time $maxSegmentsCheckTime\n" ;
890print "total border check time $totalBorderCheckTime\n" ;
891print "max border check time $maxBorderCheckTime\n" ;
892
893
894
895printHTMLTableFoot ($html) ;
896
897
898print $html "<H2>Stats and counts</H2>\n" ;
899
900print $html "<H3>TYPES FOUND</H3>\n" ;
901print $html "<p>" ;
902foreach (sort keys %typehash) { print $html "- ", $_, "<br>\n" ; }
903print $html "</p>\n" ;
904
905print $html "<H3>STATISTICS</H3>\n" ;
906print $html "<p>number problems $problems<br>\n" ;
907print $html "number relations $relationCount<br>\n" ;
908print $html "number checked relations $checkedRelationCount<br>\n" ;
909print $html "number members $members<br>\n" ;
910print $html "number member ways $wayCount<br>\n" ;
911print $html "number member ways invalid $invalidWayCount<br>\n" ;
912print $html "number related nodes $nodeCount<br></p>\n" ;
913print $html "number places $placeCount<br></p>\n" ;
914print $html  "<p>total segments check time $totalSegmentsCheckTime<br>\n" ;
915print $html  "max segments check time $maxSegmentsCheckTime<br>\n" ;
916print $html  "total border check time $totalBorderCheckTime<br>\n" ;
917print $html  "max border check time $maxBorderCheckTime</p>\n" ;
918
919my $time1 = time() ;
920
921print $html "<p>", stringTimeSpent ($time1-$time0), "</p>\n" ;
922printHTMLFoot ($html) ;
923printGPXFoot ($gpx) ;
924
925close ($html) ;
926close ($gpx) ;
927
928statistics ( ctime(stat($osmName)->mtime),  $program,  $baseName, $osmName,  $checkedRelationCount,  $problems) ;
929
930print "\n$program finished after ", stringTimeSpent ($time1-$time0), "\n\n" ;
931
932sub listEnds {
933        my (@ends) = @_ ;
934        my $text = "" ;
935        my $node ;
936        if (scalar (@ends) > 0) {
937                foreach $node (@ends) {
938                        $text = $text . "(" . historyLink ("node", $node) . " " . josmLinkSelectNode ($lon{$node}, $lat{$node}, 0.003, $node) . ") " ;
939                }
940        }
941        return $text ;
942}
943
944
945sub calcRange {
946        my (@ways) = @_ ;
947        my $lonMin = 999 ;
948        my $latMin = 999 ;
949        my $lonMax = -999 ; 
950        my $latMax = -999 ; 
951        my $way ; my $node ;
952        #print "ways: @ways\n" ;
953        foreach $way (@ways) {
954                #print "  way: $way\n" ;
955                foreach $node (@{$wayNodesHash{$way}}) {
956                        #print "    node: $node\n" ;
957                        if ($lon{$node} > $lonMax) { $lonMax = $lon{$node} ; }
958                        if ($lat{$node} > $latMax) { $latMax = $lat{$node} ; }
959                        if ($lon{$node} < $lonMin) { $lonMin = $lon{$node} ; }
960                        if ($lat{$node} < $latMin) { $latMin = $lat{$node} ; }
961                }
962        }
963        $lonMin = $lonMin - ($buffer * ($lonMax - $lonMin)) ;
964        $latMin = $latMin - ($buffer * ($latMax - $latMin)) ;
965        $lonMax = $lonMax + ($buffer * ($lonMax - $lonMin)) ;
966        $latMax = $latMax + ($buffer * ($latMax - $latMin)) ;
967        return ($lonMin, $latMin, $lonMax, $latMax) ;
968}
969
970sub nodes2Coordinates {
971# transform list of nodeIds to list of lons/lats
972
973        my @nodes = @_ ;
974        my $i ;
975        my @result = () ;
976
977        for ($i=0; $i<=$#nodes; $i++) {
978                push @result, $lon{$nodes[$i]} ;
979                push @result, $lat{$nodes[$i]} ;
980        }
981        return @result ;
982}
983
984sub linkLocal {
985        my ($id) = shift ;
986        my $result = "<A HREF=\"./" . $baseName . $id . ".png\">Picture</A>" ;
987        return $result ;
988}
989
990sub drawPlaces {
991        my $place ; my $count = 0 ;
992        foreach $place (keys %placeName) {
993                drawNodeDot ($lon{$place}, $lat{$place}, "black", 2) ;
994                drawTextPos ($lon{$place}, $lat{$place}, 0, 0, $placeName{$place}, "black", 2) ;
995        }
996}
997
998sub drawBorder2 {
999        my (@way) = @_ ;
1000        drawWay ("green", 2, nodes2Coordinates (@way) ) ;
1001}
1002
1003sub statistics {
1004        my ($date, $program, $def, $area, $total, $errors) = @_ ;
1005        my $statfile ; my ($statfileName) = "statistics.csv" ;
1006
1007        if (grep /\.bz2/, $area) { $area =~ s/\.bz2// ; }
1008        if (grep /\.osm/, $area) { $area =~ s/\.osm// ; }
1009        my ($area2) = ($area =~ /.+\/([\w\-]+)$/ ) ;
1010        if (! defined ($area2) ) { $area2 = "unknown" ; }
1011
1012        my ($def2) = $baseName ;
1013
1014        my ($success) = open ($statfile, "<", $statfileName) ;
1015
1016        if ($success) {
1017                print "statfile found. writing stats...\n" ;
1018                close $statfile ;
1019                open $statfile, ">>", $statfileName ;
1020                printf $statfile "%02d.%02d.%4d;", localtime->mday(), localtime->mon()+1, localtime->year() + 1900 ;
1021                printf $statfile "%02d/%02d/%4d;", localtime->mon()+1, localtime->mday(), localtime->year() + 1900 ;
1022                print $statfile $date, ";" ;
1023                print $statfile $program, ";" ;
1024                print $statfile $def2, ";" ;
1025                print $statfile $area2, ";" ;
1026                print $statfile $total, ";" ;
1027                print $statfile $errors ;
1028                print $statfile "\n" ;
1029                close $statfile ;
1030        }
1031        return ;
1032}
1033
1034sub readBorder {
1035        my ($borderFileName) = shift ;
1036        my $borderFile ;
1037        my $line ;
1038        my $id = 0 ;
1039        my $dist ;
1040        my $lastLon = 0 ; my $lastLat = 0 ; my $maxDist = 0 ;
1041       
1042        open ($borderFile, "<", $borderFileName) || die ("couldn't open border file");
1043        print "parsing border file...\n" ;     
1044        $line = <$borderFile> ;
1045        $line = <$borderFile> ;
1046        $line = <$borderFile> ;
1047        while (! (grep /END/, $line) ) {
1048                $id-- ; # negative ids for border nodes
1049                #($lo, $la) = sscanf ("%g %g", $line) ;
1050                #print "line: $line\n" ;
1051                my ($lo, $la)   = ($line =~ /^\s*([\-\+\d\.Ee]+)\s+([\-\+\d\.Ee]+)+/ ) ;       
1052                if (!defined ($lo))  { print "id: $id line: $line\n" ; }
1053                $lon{$id} = $lo ; $lat{$id} = $la ;
1054                if ($lastLon == 0) {
1055                        $lastLon = $lo ;
1056                        $lastLat = $la ;
1057                }
1058                push @borderWay, $id ;
1059                $line = <$borderFile> ;
1060                $dist = distance ($lo, $la, $lastLon, $lastLat) ;
1061                if ($dist > $maxDist) { $maxDist = $dist ; }
1062                #printf "%3d \n", distance ($lo, $la, $lastLon, $lastLat) ;
1063                $lastLon = $lo ;
1064                $lastLat = $la ;
1065        }
1066        close ($borderFile) ;
1067        print $id*(-1), " border nodes read.\nmax distance between border nodes: $maxDist\n\n" ;
1068}
1069
1070sub minDistToBorderOK {
1071        my (@nodes) = @_ ;
1072        my $way ; my $node ; my $borderNode ;
1073        my $ok = 1 ;
1074        #print "checking distance...\n" ;
1075
1076
1077        my ($startTime) = time() ;
1078        loopA:
1079        foreach $node (@nodes) {
1080                foreach $borderNode (@borderWay) {
1081                        my ($dist) = distance ($lon{$borderNode}, $lat{$borderNode}, $lon{$node}, $lat{$node}) ;
1082                        if ($dist < $borderThreshold) { 
1083                                $ok = 0 ; 
1084                                last loopA ; 
1085                        }
1086                }
1087        }
1088
1089        my ($secs) = time() - $startTime ;
1090        #print "done extensive border check in $secs seconds...\n" ;
1091        $totalBorderCheckTime += $secs ;
1092        if ( $secs > $maxBorderCheckTime ) {
1093                $maxBorderCheckTime = $secs ;
1094                print "max border check now $maxBorderCheckTime secs\n" ;
1095        }
1096
1097        return $ok ;
1098}
1099
1100sub checkSegments2 {
1101        my (@ways) = @_ ;
1102        my $way ; my $node ;
1103        my @openEnds = () ;
1104        my $segments = 0 ; my $openSegments = 0 ;
1105        my $found = 1 ;
1106        my $way1 ; my $way2 ;
1107        my $endNodeWay2 ;       my $startNodeWay2 ;
1108        my %starts = () ; my %ends = () ;
1109        my %wayStart = () ; my %wayEnd = () ;
1110
1111        my $time1  = time() ;
1112
1113        #init
1114        foreach $way (@ways) {
1115                push @{$starts{$wayNodesHash{$way}[0]}}, $way ;
1116                push @{$ends{$wayNodesHash{$way}[-1]}}, $way ;
1117                $wayStart{$way} = $wayNodesHash{$way}[0] ;
1118                $wayEnd{$way} = $wayNodesHash{$way}[-1] ;
1119        }
1120
1121        while ($found == 1) {
1122                $found = 0 ;
1123
1124                # check start/start
1125                loop1:
1126                foreach $node (keys %starts) {
1127
1128                        # if node with more than 1 connecting way...
1129                        if (scalar (@{$starts{$node}}) > 1) {
1130                                $way1 = ${$starts{$node}}[0] ; $way2 = ${$starts{$node}}[1] ;
1131                                #print "merge start/start $way1 and $way2 at node $node\n" ;
1132
1133                                $endNodeWay2 = $wayEnd{$way2} ;
1134                                #print "end node way2 = $endNodeWay2\n" ;
1135
1136                                # way1 gets new start: end way2
1137                                push @{$starts{ $endNodeWay2 }}, $way1 ;
1138                                $wayStart{$way1} = $endNodeWay2 ;
1139
1140                                # remove end way2
1141                                if (scalar (@{$ends{$endNodeWay2}}) == 1) {
1142                                        delete $ends{$endNodeWay2} ;
1143                                        #print "$endNodeWay2 removed from end hash\n" ;
1144                                }
1145                                else {
1146                                        @{$ends{$endNodeWay2}} = removeElement ($way2, @{$ends{$endNodeWay2}}) ;
1147                                        #print "way $way2 removed from node $endNodeWay2 from end hash\n" ;
1148                                }
1149                               
1150                                # remove way2
1151                                delete $wayEnd{$way2} ;
1152                                delete $wayStart{$way2} ;
1153
1154                                # remove connecting starts
1155                                if (scalar @{$starts{$node}} == 2) {
1156                                        delete $starts{$node} ;
1157                                        #print "$node removed from start hash\n" ;
1158                                }
1159                                else {
1160                                        @{$starts{$node}} = @{$starts{$node}}[2..$#{$starts{$node}}] ;
1161                                        #print "first two elements removed from start hash node = $node\n" ;
1162                                }
1163                                #print "\n" ;
1164                                $found = 1 ; 
1165                                last loop1 ;
1166                        }
1167                }
1168
1169                # check end/end
1170                if (!$found) {
1171                        loop2:
1172                        foreach $node (keys %ends) {
1173
1174                                # if node with more than 1 connecting way...
1175                                if (scalar @{$ends{$node}} > 1) {
1176                                        $way1 = ${$ends{$node}}[0] ; $way2 = ${$ends{$node}}[1] ;
1177                                        #print "merge end/end $way1 and $way2 at node $node\n" ;
1178       
1179                                        $startNodeWay2 = $wayStart{$way2} ;
1180                                        #print "start node way2 = $startNodeWay2\n" ;
1181       
1182                                        # way1 gets new end: start way2
1183                                        push @{$ends{ $startNodeWay2 }}, $way1 ;
1184                                        $wayEnd{$way1} = $startNodeWay2 ;
1185       
1186                                        # remove start way2
1187                                        if (scalar (@{$starts{$startNodeWay2}}) == 1) {
1188                                                delete $starts{$startNodeWay2} ;
1189                                                #print "$startNodeWay2 removed from start hash\n" ;
1190                                        }
1191                                        else {
1192                                                @{$starts{$startNodeWay2}} = removeElement ($way2, @{$starts{$startNodeWay2}}) ;
1193                                                #print "way $way2 removed from node $startNodeWay2 from start hash\n" ;
1194                                        }
1195                               
1196                                        # remove way2
1197                                        delete $wayEnd{$way2} ;
1198                                        delete $wayStart{$way2} ;
1199
1200                                        # remove connecting ends
1201                                        if (scalar @{$ends{$node}} == 2) {
1202                                                delete $ends{$node} ;
1203                                                #print "$node removed from end hash\n" ;
1204                                        }
1205                                        else {
1206                                                @{$ends{$node}} = @{$ends{$node}}[2..$#{$ends{$node}}] ;
1207                                                #print "first two elements removed from end hash node = $node\n" ;
1208                                        }
1209                                        #print "\n" ;
1210                                        $found = 1 ; 
1211                                        last loop2 ;
1212                                }
1213                        }
1214                }
1215
1216
1217                # check start/end
1218                if (!$found) {
1219                        my $wayFound = 0 ;
1220                        loop3:
1221                        foreach $node (keys %starts) {
1222                                if (exists ($ends{$node})) {
1223                                        #look for different! ways
1224                                        my (@startingWays) = @{$starts{$node}} ;
1225                                        my (@endingWays) = @{$ends{$node}} ;
1226                                        my $w1 ; my $w2 ;
1227                                        loop4:
1228                                        foreach $w1 (@startingWays) {
1229                                                foreach $w2 (@endingWays) {
1230                                                        if ($w1 != $w2) {
1231                                                                $wayFound = 1 ;
1232                                                                $way1 = $w1 ; 
1233                                                                $way2 = $w2 ; # merge w1 and w2
1234                                                                #print "start/end: merge ways $way1 and $way2 connected at node $node\n" ;
1235                                                                last loop4 ;
1236                                                        }
1237                                                }
1238                                        } # look for ways
1239                                        if ($wayFound) {
1240                                                #print "way $way1 start $wayStart{$way1} end $wayEnd{$way1}\n" ;
1241                                                #print "way $way2 start $wayStart{$way2} end $wayEnd{$way2}\n" ;
1242
1243                                                # way1 gets new start: start way2
1244                                                $wayStart{$way1} = $wayStart{$way2} ;
1245                                                my ($way2StartNode) = $wayStart{$way2} ;
1246
1247                                                push @{$starts{$way2StartNode}}, $way1 ;
1248                                                #print "way $way1 added to starts for node $way2StartNode\n" ;
1249
1250                                                # remove start way1
1251                                                if (scalar (@{$starts{$node}}) == 1) {
1252                                                        delete $starts{$node} ;
1253                                                        #print "$way1 removed from start hash for node $node\n" ;
1254                                                }
1255                                                else {
1256                                                        @{$starts{$node}} = removeElement ($way1, @{$starts{$node}}) ;
1257                                                        #print "$way1 removed from start hash for node $node\n" ;
1258                                                }
1259
1260                                                #remove end way2
1261                                                if (scalar (@{$ends{$node}}) == 1) {
1262                                                        delete $ends{$node} ;
1263                                                        #print "$way2 removed from end hash for node $node\n" ;
1264                                                }
1265                                                else {
1266                                                        @{$ends{$node}} = removeElement ($way2, @{$ends{$node}}) ;
1267                                                        #print "$way2 removed from end hash for node $node\n" ;
1268                                                }
1269                                                #remove start way2
1270                                                if (scalar (@{$starts{$way2StartNode}}) == 1) {
1271                                                        delete $starts{$way2StartNode} ;
1272                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
1273                                                }
1274                                                else {
1275                                                        @{$starts{$way2StartNode}} = removeElement ($way2, @{$starts{$way2StartNode}}) ;
1276                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
1277                                                }
1278
1279                                                # remove way2
1280                                                delete $wayEnd{$way2} ;
1281                                                delete $wayStart{$way2} ;
1282                                                #print "way $way2 removed from waystart and wayend hashes\n" ;
1283
1284                                                #print "\n" ;
1285                                                $found = 1 ; 
1286                                                last loop3 ;
1287                                        }
1288                                }
1289                        }
1290                }
1291        }
1292
1293        # evaluation
1294
1295
1296        #print "\nSUB RESULT\n" ;
1297        foreach $way (keys %wayStart) {
1298                #print "way $way start $wayStart{$way} end $wayEnd{$way}\n" ;
1299                if ($wayStart{$way} != $wayEnd{$way}) {
1300                        $openSegments++ ;
1301                        #print "   open!\n" ;
1302                        push @openEnds, $wayStart{$way}, $wayEnd{$way} ;
1303                }
1304        }
1305        #print "SUB RESULT END\n" ;
1306
1307        #print "check segments took ", time() - $time1, "seconds\n" ;
1308        $totalSegmentsCheckTime += time() - $time1 ;
1309        if ( (time () - $time1) > $maxSegmentsCheckTime ) {
1310                $maxSegmentsCheckTime = time () - $time1 ;
1311                print "max segment check now $maxSegmentsCheckTime secs\n" ;
1312        }
1313
1314        return (scalar (keys %wayStart), $openSegments, @openEnds) ;
1315}
1316
1317sub removeElement {
1318        my ($element, @array) = @_ ;
1319        my @arrayNew = () ;
1320        my $pos = -1 ; my $i ;
1321        for ($i=0; $i<=$#array; $i++) { if ($array[$i] == $element) { $pos = $i ; } }
1322        if ($pos != -1) {
1323                if ($pos == 0) {
1324                        @arrayNew = @array[1..$#array] ;
1325                }
1326                if ($pos == $#array) {
1327                        @arrayNew = @array[0..$#array-1] ;
1328                }
1329                if ( ($pos > 0) and ($pos < $#array) ) {
1330                        @arrayNew = @array[0..$pos-1, $pos+1..$#array] ;
1331                }
1332        }
1333        return @arrayNew ;
1334}
1335sub readIgnoreFile {
1336        my $ignoreFile ;
1337        my ($success) = open ($ignoreFile, "<", "./ignoredrelations.txt") ;
1338        if ($success) {
1339                print "ignore file found.\n" ;
1340                while ($line = <$ignoreFile>) {
1341                        my ($relationId) = ($line =~ /([\d]+)/) ;
1342                        if (defined $relationId) { 
1343                                $ignoredRelations{$relationId} = 1 ;
1344                                print "will ignore relation id $relationId\n" ;
1345                        }
1346                }
1347                close ($ignoreFile) ;
1348        } 
1349}
Note: See TracBrowser for help on using the repository browser.