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

Last change on this file since 17684 was 17266, checked in by gary68, 10 years ago

-

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