#!/usr/bin/perl -w # NAME: osm-load.pl # AIM: Load an XML OSM file # 17/06/2016 - Revisit, and expand UI - TODO: Add a BBOX to limit the output use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); #require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n"; require 'fg_wsg84.pl' or die "Unable to load fg_wsg84.pl ...\n"; ### require "Bucket2.pm" or die "Unable to load Bucket2.pm ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.2 2016-06-18"; ##my $VERS = "0.0.1 2010-09-11"; my $load_log = 0; my $in_file = ''; my $SG_METER_TO_NM = 0.0005399568034557235; my $temp_poly = $perl_dir."\\temppoly."; my $poly_count = 0; my $verbosity = 0; my $write_tmp_poly = 0; my $out_xg_file = $perl_dir."\\temposm.xg"; my (@g_bbox); my $got_bbox = 0; my $got_usr_bbox = 0; # standard fields to poulate in Tags my @standardFields = ('highway','junction','cycleway','tracktype','waterway','railway', 'aeroway','aerialway','power','man_made','leisure', 'amenity','shop','tourism','historic','landuse', 'military','natural','route','boundary','sport', 'abutters','fenced','lit','width','lanes', 'bridge','tunnel','cutting','embankment','layer', 'surface','name','int_name','nat_name','reg_name', 'loc_name','old_name','ref','int_ref','nat_ref', 'reg_ref','loc_ref','old_ref','ncn_ref','place', 'place_name','place_numbers','postal_code','is_in','note','class'); my %new_tag_fields = ( 'access' => 1, 'addr' => 1, 'alt_name' => 1, 'area' => 1, 'barrier' => 1, 'bicycle' => 1, 'building' => 1, 'building' => 1, 'bus' => 1, 'colour' => 1, 'construction' => 1, 'covered' => 1, 'crossing' => 1, 'direction' => 1, 'electrified' => 1, 'fee' => 1, 'foot' => 1, 'frequency' => 1, 'gauge' => 1, 'hoops' => 1, 'horse' => 1, 'maxlength' => 1, 'maxspeed' => 1, 'motor_vehicle' => 1, 'network' => 1, 'office' => 1, 'official_name' => 1, 'oneway' => 1, 'operator' => 1, 'park_ride' => 1, 'parking' => 1, 'platforms' => 1, 'public_transport' => 1, 'religion' => 1, 'restriction' => 1, 'route_master' => 1, 'route_ref' => 1, 'service' => 1, 'shelter' => 1, 'sidewalk' => 1, 'source' => 1, 'start_date' => 1, 'station' => 1, 'subway' => 1, 'toilets' => 1, 'toilets' => 1, 'type' => 1, 'usage' => 1, 'voltage' => 1, 'water' => 1, 'wheelchair' => 1, 'wikipedia' => 1 ); ########################################################################## # maybe # landuse=brownfield cemetery construction farmland grass military railway recreation_ground retail # amenity=clinic community_centre dentist fire_station fuel parking toilets # building=church garage house industrial office residential school train_station yes # leisure=garden park pitch playground sports_centre swimming_pool # and... ############################################################################ # ALL AERO airport stuff # aeroway=apron hangar runway taxiway my $airport = 'aeroway'; sub is_an_airport($$) { my ($v,$k) = @_; return 1 if ($v eq $airport); } # Certainly most highways - highway= # motorway motorway_link primary secondary tertiary # residential service steps track unclassified # footway path pedestrian my $roads = 'highway'; sub is_a_road($$) { my ($v,$k) = @_; if ($v eq $roads) { ## prt("Check road type $v=$k\n"); return 5 if ($k =~ /motorway/); return 4 if ($k eq 'tertiary'); return 3 if ($k eq 'primary'); return 2 if ($k eq 'secondary'); return 0; } return 0; } # water=pond # waterway=ditch drain stream # bridge=viaduct yes sub is_a_river($$) { my ($v,$k) = @_; return 1 if ($v =~ /^water/); ### return 1 if ($v =~ /^bridge/); return 1 if (($k eq 'swimming_pool') && ($v eq 'leasure')); return 0; } # note - tags can have subscript sub in_standard($) { my $tag = shift; my @arr = split(":",$tag); my $traw = $arr[0]; return 1 if (defined $new_tag_fields{$traw}); my ($tt); foreach $tt (@standardFields) { return 1 if ($tt eq $tag); return 2 if ($tt eq $traw); } return 0; } #Tags with these keys will not be loaded, features with *only* these keys will not be loaded my @ignoreFields = ('created_by','source','converted_by'); #this flag controls whether features with only non standard tags are loaded. my $loadNonstandardTags = 1; ################################################################ ### DEBUG ONLY my $debug_on = 0; my $def_file = 'C:\Users\Public\Documents\JOSM\vhsk.osm'; # # bbox 86.6777058675,27.5585931498,86.7291034105,27.6882296297 # my $def_file = 'C:\Documents and Settings\Geoff McLane\My Documents\FG\OSM\YGIL-map.osm'; my $add_def_bbox = 1; ################################################################ ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $g_minlat = 200; my $g_maxlat = -200; my $g_minlon = 200; my $g_maxlon = -200; my ($g_center_lat,$g_center_lon); my ($g_lat_span,$g_lon_span); my ($g_width,$g_height); my $g_lnn = 0; my ($g_in_file); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { # prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } #--------------------------------------------------------------------------- #Gets the XML element name from the string passed in #an end of element tag is /element #--------------------------------------------------------------------------- sub getElement($) { my $line = shift; my $el = ''; my $s = index($line,'<'); if ($s > 0) { my $e = index($line,' ',$s); if ($e > 0) { $el = substr($line,$s+1,$e-$s-1); } else { $e = index($line,'>',$s); if ($e > 0) { $el = substr($line,$s+1,$e-$s-1); $el =~ s/\/$//; } else { prtw("WARNING:$g_lnn: NO ELEMENT [$line]?\n"); } } } return $el; } #--------------------------------------------------------------------------- #Gets the value of the named attribute from the string #--------------------------------------------------------------------------- sub getAttributeValue($$) { my ($name,$line) = @_; my $attr = ''; # check for double quote =" " my $sa = index($line,' '.$name.'="'); if ($sa > 0) { #prt("Begin = $sa, "); $sa += length($name) + 3; # past the first '"' my $ea = index($line,'"',$sa); if ($ea > 0) { #prt("Begin = $sa, End = $ea\n"); $attr = substr($line,$sa,$ea - $sa); return $attr; } } # check for single quote =' ' $sa = index($line,' '.$name."='"); if ($sa > 0) { #prt("Begin = $sa, "); $sa += length($name) + 3; # past the first '"' my $ea = index($line,"'",$sa); if ($ea > 0) { #prt("Begin = $sa, End = $ea\n"); $attr = substr($line,$sa,$ea - $sa); return $attr; } } prtw("WARNING:$g_lnn: NO attrib '$name' in [$line]?\n"); return $attr; } #--------------------------------------------------------------------------- #--------------------------------------------------------------------------- #Extract Node attribute details from a line of xml text #--------------------------------------------------------------------------- sub returnNode($) { my $line = shift; my $nid = getAttributeValue('id',$line); my $nx = getAttributeValue('lon',$line); my $ny = getAttributeValue('lat',$line); return($nid,$nx,$ny); } #--------------------------------------------------------------------------- #--------------------------------------------------------------------------- #extract segment attributes from a line of xml text #--------------------------------------------------------------------------- sub returnSegment($) { my $line = shift; my $sid = getAttributeValue('id',$line); my $sn = getAttributeValue('from',$line); my $en = getAttributeValue('to',$line); return($sid,$sn,$en); } #--------------------------------------------------------------------------- #get the id attribute from a line of xml text #used for ways and its segs, as id is only attribute needed sub returnID($) { my $line = shift; return getAttributeValue('id',$line); } sub returnTags($) { my $line = shift; my $k = getAttributeValue('k',$line); # .lstrip().encode("Latin-1","replace")[:29] my $v = getAttributeValue('v',$line); # .encode("Latin-1","replace")[:254] return ($k,$v); } #--------------------------------------------------------------------------- my $f_min_lon = 200; my $f_max_lon = -200; my $f_min_lat = 200; my $f_max_lat = -200; my $got_file_bbox = 0; sub in_world_range($$) { my ($lat,$lon) = @_; return 0 if ($lat < -90); return 0 if ($lat > 90); return 0 if ($lon < -180); return 0 if ($lon > 180); return 1; } sub add_to_file_bbox($$) { my ($lat,$lon) = @_; #if (in_world_range($lat,$lon)) { $f_min_lon = $lon if ($lon < $f_min_lon); $f_max_lon = $lon if ($lon > $f_max_lon); $f_min_lat = $lat if ($lat < $f_min_lat); $f_max_lat = $lat if ($lat > $f_max_lat); $got_file_bbox = 1; #} } sub get_file_bbox() { my $xg = "# no BBOX\n"; if ($got_file_bbox) { $xg = "# $g_in_file bbox $f_min_lon,$f_min_lat,$f_max_lon,$f_max_lat\n"; $xg .= "color gray\n"; $xg .= "$f_min_lon $f_min_lat\n"; $xg .= "$f_min_lon $f_max_lat\n"; $xg .= "$f_max_lon $f_max_lat\n"; $xg .= "$f_max_lon $f_min_lat\n"; $xg .= "$f_min_lon $f_min_lat\n"; $xg .= "NEXT\n"; } return $xg; } my ($g_min_lon,$g_min_lat,$g_max_lon,$g_max_lat); sub is_in_bbox_debug($$) { my ($lat,$lon) = @_; if ($got_bbox) { if ($lat < $g_min_lat) { prt("lat LTT min $lat $g_min_lat\n"); return 0; } if ($lat > $g_max_lat) { prt("lat GTT max $lat $g_max_lat\n"); return 0; } if ($lon < $g_min_lon) { prt("lon LTT min $lon $g_min_lon\n"); return 0; } if ($lon > $g_max_lon) { prt("lon GTT max $lon $g_max_lon\n"); return 0; } prt("lat,lon $lat,$lon is in BBOX.\n"); } else { prt("No BBOX!\n"); } return 1; } sub is_in_bbox($$) { my ($lat,$lon) = @_; if ($got_bbox) { return 0 if ($lat < $g_min_lat); return 0 if ($lat > $g_max_lat); return 0 if ($lon < $g_min_lon); return 0 if ($lon > $g_max_lon); } return 1; } # NOTE: Sets my $got_usr_bbox = 0; sub verify_bbox($) { my $ra = shift; my $cnt = scalar @{$ra}; return 0 if ($cnt != 4); my $min_lon = ${$ra}[0]; my $min_lat = ${$ra}[1]; my $max_lon = ${$ra}[2]; my $max_lat = ${$ra}[3]; if (($min_lon < $max_lon) && ($min_lat < $max_lat) ) { if ( in_world_range($min_lat,$min_lon) && in_world_range($max_lat,$max_lon) ) { $g_min_lon = $min_lon; $g_min_lat = $min_lat; $g_max_lon = $max_lon; $g_max_lat = $max_lat; $got_usr_bbox = 1; return 1; } } return 0; } sub get_user_bbox() { my $xg = "# No USER BBOX\n"; if ($got_usr_bbox) { $xg = "# USER bbox $g_min_lon,$g_min_lat,$g_max_lon,$g_max_lat\n"; $xg .= "color gray\n"; $xg .= "$g_min_lon $g_min_lat\n"; $xg .= "$g_min_lon $g_max_lat\n"; $xg .= "$g_max_lon $g_max_lat\n"; $xg .= "$g_max_lon $g_min_lat\n"; $xg .= "$g_min_lon $g_min_lat\n"; $xg .= "NEXT\n"; } return $xg; } # load file, and build refernce hash #node=('ID','x','y') #segment=('id','start','end') #way=('id','seg1 seg2') #tag=('key','value') my %non_std_tags = (); sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; my ($n,$d) = fileparse($inf); $g_in_file = $n; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); my ($element,$ftype,$id,$lon,$lat,$v,$k,$val,$tag1); my ($minlat,$minlon,$maxlat,$maxlon,$hadbounds,$msg); my ($rh); my %nodes = (); my %node_tags = (); my %way_tags = (); my %way_nd = (); my @NODES = (); my @ftags = (); my @unbuiltways = (); my @ways = (); my @nd_array = (); $lnn = 0; $ftype = -1; $hadbounds = 0; my $hasvalidtags = 0; my $nodecount = 0; my $waycount = 0; my $way = 0; my $waytagcount = 0; my $nodetagcount = 0; my $taggednodecount = 0; foreach $line (@lines) { chomp $line; $lnn++; $g_lnn = $lnn; $element = getElement($line); next if (length($element) == 0); if ($element eq 'node') { $ftype = -1; @ftags = (); ($id,$lon,$lat) = returnNode($line); #if float(node[1])>=-180 and float(node[1])<=180 and float(node[2])>=-90 and float(node[2])<=90: #if ( ($lon >= -180) && ($lon <= 180) && ($lat >= -90) && ($lat <= 90) && ($id > 0)) { if (in_world_range($lat,$lon)) { $ftype = 0; # set a VALID 'node' #nodefile.write(str(node[0])+':'+str(node[1])+':'+str(node[2])+'\n') push(@NODES, [$lon,$lat]); # if (defined $nodes{$id}) { prtw("WARNING:$lnn: Node ID [$id] REPEATED\n"); } else { $nodes{$id} = [$lon,$lat]; } # oops, found items CAN be out of this range - so no range check #if ($hadbounds && (($lat < $minlat)||($lat > $maxlat)||($lon < $minlon)||($lon > $maxlon))) { # $msg = "lat,lon $lat,$lon OUT OF BOUNDS "; # prtw("WARNING:$lnn: $msg\n"); #} # but keep the NEW ranges $g_minlat = $lat if ($lat < $g_minlat); $g_maxlat = $lat if ($lat > $g_maxlat); $g_minlon = $lon if ($lon < $g_minlon); $g_maxlon = $lon if ($lon > $g_maxlon); $nodecount++; } else { prtw("WARNING:$lnn: Line $id,$lon,$lat [".substr($line,0,70)."...] FAILED!\n"); } } elsif ($element eq 'way') { # @ftags = (); $ftype = 2; $waycount++; $way = returnID($line); # set the way if (length($way)) { push(@ways,$way); } else { prtw("WARNING:$lnn: way element without ID [$way] line [$line]\n"); } # unbuiltways.write('\n'+str(way[0])+'#') } elsif ($element eq 'nd') { $val = getAttributeValue('ref',$line); if (length($val)) { push(@nd_array,$val); $hasvalidtags = 1; } else { prtw("WARNING:$lnn: nd element without REF [$val] line [$line]\n"); } # unbuiltways.write(str(getAttributeValue('ref',line))+':') } elsif ($element eq 'tag' ) { ($v,$k) = returnTags($line); # prt("tag element: v=$v k=$k ftype=$ftype\n"); if ($ftype == 0) { # tagged node #ignore less useful tags, and if not a standard tag #remove tags with blank values too. lots of wierd keys have blank values if ((length($v) == 0)||(length($k) == 0)) { prtw("WARNING:$lnn:1: ftype=$ftype v=$v, k=$k\n"); }else { #if tag[0] in standardFields and tag[1] !='': if (in_standard($v)) { #ftags.append((tag[0],tag[1])) push(@ftags, [$v,$k]); $hasvalidtags = 1; $nodetagcount++; } elsif ($loadNonstandardTags) { if (! defined $non_std_tags{$v}) { $non_std_tags{$v} = {}; prtw("WARNING:1:$lnn: Non-stand tag $v=$k - $line\n"); } $rh = $non_std_tags{$v}; ${$rh}{$k} = 1; } } } elsif ($ftype == 2) { #way tags, loading all these except ignorefields and blank valued ones. if ((length($v) == 0)||(length($k) == 0)) { prtw("WARNING:$lnn:2: ftype=$ftype v=$v, k=$k\n"); } else { # if tag[0] in standardFields and tag[1] !='': if ( in_standard($v) ) { push(@ftags, [$v,$k]); #ftags.append((tag[0],tag[1])) $hasvalidtags = 1; $waytagcount++; } elsif ($loadNonstandardTags) { if (! defined $non_std_tags{$v}) { $non_std_tags{$v} = {}; prtw("WARNING:2:$lnn: Non-stand tag $v=$k - $line\n"); } $rh = $non_std_tags{$v}; ${$rh}{$k} = 1; } } } else { prtw("WARNING:$lnn:3: ftype=$ftype v=$v, k=$k\n"); } } elsif (($element eq '/node') && $hasvalidtags && ($ftype == 0)) { # # # # if (defined $node_tags{$id}) { prtw("WARNING:$lnn: Duplicated ID in node_tags [$id]\n"); } my @a1 = @ftags; $node_tags{$id} = \@a1; @ftags = (); #done with node lets load its shape # frow = nodecursor.newrow() #nodepnt.x=float(node[1]) #nodepnt.y=float(node[2]) # frow.setValue("Node_ID",node[0].encode("Latin-1","replace")) # for f in standardFields: # frow.setValue(f,'') # for sTag in ftags: # frow.setValue(sTag[0],str(sTag[1])) # frow.SetValue('shape', nodepnt) #Load the shape # nodecursor.insertrow(frow) $taggednodecount++; $hasvalidtags = 0; #$ftype = -1; } elsif ($element eq '/way') { # # # # # # #done with way lets load attributes, shape comes later my @a2 = @ftags; if (defined $way_tags{$way}) { prtw("WARNING:$lnn: Duplicated ID in way_tags [$way]\n"); } if (!$hasvalidtags) { prtw("WARNING:$lnn: way $way, with no valid tags!\n"); } $way_tags{$way} = \@a2; if (defined $way_nd{$way}) { prtw("WARNING:$lnn: Duplicated ID in way_nd [$way]\n"); } my @a3 = @nd_array; $way_nd{$way} = \@a3; @nd_array = (); @ftags = (); $hasvalidtags = 0; #$ftype = -1; } elsif ($element eq 'member') { # } elsif ($element eq 'bounds') { # $hadbounds = 1; $minlat = getAttributeValue('minlat',$line); $minlon = getAttributeValue('minlon',$line); $maxlat = getAttributeValue('maxlat',$line); $maxlon = getAttributeValue('maxlon',$line); prt("bounds $minlat,$minlon $maxlat,$maxlon\n"); } elsif ($element eq 'relation') { # } elsif ($element eq '/relation') { # } else { prtw("WARNING:$lnn: Element [$element] NOT dealt with\n"); } } my @arr = sort keys %non_std_tags; $ftype = scalar @arr; if ($ftype) { prt("Found $ftype suggested NEW fields to add...\n"); $msg = "my \%new_fields = (\n"; foreach $v (@arr) { my @a = split(":",$v); $rh = $non_std_tags{$v}; $v = $a[0]; $msg .= " '$v' => 1,\n"; } $msg =~ s/,\n$//; $msg .= "\n );\n"; prt($msg); } prt("Verticies=$nodecount, ntc=$nodetagcount, way=$waycount, waytc=$waytagcount, tnc=$taggednodecount\n"); prt("tag bounds $minlat,$minlon $maxlat,$maxlon\n"); $g_center_lat = ($g_minlat + $g_maxlat) / 2; $g_center_lon = ($g_minlon + $g_maxlon) / 2; $g_lat_span = abs($g_maxlat - $g_minlat); $g_lon_span = abs($g_maxlon - $g_minlon); $g_width = int($g_lon_span * 1000)+1; $g_height = int($g_lat_span * 1000)+1; prt("glob bounds $g_minlat,$g_minlon $g_maxlat,$g_maxlon\n"); prt("Center $g_center_lat,$g_center_lon, span $g_lat_span,$g_lon_span h=$g_height w=$g_width\n"); my %hash = (); $hash{'nodes_h'} = \%nodes; $hash{'node_tags_h'} = \%node_tags; $hash{'way_tags_h'} = \%way_tags; $hash{'way_nd_h'} = \%way_nd; $hash{'NODE_a'} = \@NODES; $hash{'unbuiltways_a'} = \@unbuiltways; $hash{'ways_a'} = \@ways; return \%hash; } sub set_decimal1_stg($) { my $r = shift; ${$r} = int((${$r} + 0.05) * 10) / 10; ${$r} = "0.0" if (${$r} == 0); ${$r} .= ".0" if !(${$r} =~ /\./); } sub set_decimal2_stg($) { my $r = shift; ${$r} = int((${$r} + 0.005) * 100) / 100; ${$r} = "0.00" if (${$r} == 0); ${$r} .= ".00" if !(${$r} =~ /\./); } sub set_decimal3_stg($) { my $r = shift; ${$r} = int((${$r} + 0.0005) * 1000) / 1000; ${$r} = "0.000" if (${$r} == 0); ${$r} .= ".000" if !(${$r} =~ /\./); } sub set_int_stg($) { my $r = shift; ${$r} = int(${$r} + 0.5); } sub get_dist_stg_nm($) { my ($dist) = @_; my $nm = $dist * $SG_METER_TO_NM; if ($nm < 1) { set_decimal3_stg(\$nm); } elsif ($nm < 10) { set_decimal2_stg(\$nm); } else { set_decimal1_stg(\$nm); } $nm .= "nm"; return $nm; } sub is_name_tag($) { my $v = shift; return 1 if ($v eq 'name'); return 0; } sub show_ref_hash($) { my ($rh) = @_; my ($key,$val,$way); my ($rtags,$rnds); my ($tcnt,$ncnt,$i,$v,$k,$id); my ($lat,$lon,$msg,$rll,$cnt,$poly,$tmp); my ($vh); prt("show_ref_hash: keys: "); foreach $key (keys %{$rh}) { $val = ${$rh}{$key}; prt("$key "); } prt("\n"); my $rnodes_h = ${$rh}{'nodes_h'}; my $rnode_tags_h = ${$rh}{'node_tags_h'}; my $rway_tags_h = ${$rh}{'way_tags_h'}; my $rway_nd_h = ${$rh}{'way_nd_h'}; my $rnode_a = ${$rh}{'NODE_a'}; my $rubw_a = ${$rh}{'unbuiltways_a'}; my $ways_a = ${$rh}{'ways_a'}; my $ref_points = scalar keys(%{$rnodes_h}); prt("Got $ref_points reference points...\n"); my %used_tags = (); my $xg = ''; my $name = ''; my $is_road = 0; my $is_air = 0; my $is_water = 0; my $xg_points = 0; my @msg_stack = (); my @xg_stack = (); foreach $way (keys %{$rway_tags_h}) { if (defined ${$rway_nd_h}{$way}) { $poly = "#2D\n"; # is 2D vector $rtags = ${$rway_tags_h}{$way}; $rnds = ${$rway_nd_h}{$way}; $tcnt = scalar @{$rtags}; $ncnt = scalar @{$rnds}; prt("\n") if (VERB9()); $msg = "way $way "; $name = ''; # clear the name $is_road = 0; # clear if my type of road (highway) $is_air = 0; $is_water = 0; for ($i = 0; $i < $tcnt; $i++) { $v = ${$rtags}[$i][0]; $k = ${$rtags}[$i][1]; $msg .= "$v=$k "; $poly .= "$v\n" if ($i == 0); # add TYPE $used_tags{$v} = {} if (!defined $used_tags{$v}); $vh = $used_tags{$v}; if (defined ${$vh}{$k}) { ${$vh}{$k}++; } else { ${$vh}{$k} = 1; } $name = $k if (is_name_tag($v)); $is_road += is_a_road($v,$k); $is_air += is_an_airport($v,$k); $is_water += is_a_river($v,$k); } $poly .= "1\n"; # add only 1 per file $poly .= "$ncnt\n"; # number of entries $poly .= "0\n"; # whole flag $msg .= "$ncnt nd points"; prt("$msg\n") if (VERB5()); $msg .= " a/w/r $is_air/$is_water/$is_road $name"; push(@msg_stack,$msg); # $nodes{$id} = [$lon,$lat]; $msg = ''; $cnt = 0; $i = 0; my ($llat,$llon,$az1,$az2,$dist); my $tot_dist = 0; # is this feature of interest? my $add_xg = $is_road + $is_air + $is_water; my $in_bbox = 0; foreach $id (@{$rnds}) { $i++; if (defined ${$rnodes_h}{$id}) { $rll = ${$rnodes_h}{$id}; $lon = ${$rll}[0]; $lat = ${$rll}[1]; $poly .= sprintf("%.15f %.15f\n", $lon, $lat); if ($i > 1) { fg_geo_inverse_wgs_84 ($llat,$llon,$lat,$lon,\$az1,\$az2,\$dist); $tot_dist += $dist; } $llat = $lat; $llon = $lon; $in_bbox += is_in_bbox($lat,$lon); $lon -= $g_center_lon; $lat -= $g_center_lat; $msg .= "$lat,$lon "; if ($add_xg) { if ($i == 1) { $xg .= "anno $llon $llat $name\n" if (length($name)); if ($is_air) { $xg .= "color red\n"; } elsif ($is_road) { $xg .= "color brown\n"; } elsif ($is_water) { $xg .= "color blue\n"; } else { $xg .= "color pink\n"; } } $xg .= "$llon $llat\n"; add_to_file_bbox($llat,$llon); } $cnt++; if (($cnt == 3)&&($i < $ncnt)) { $msg .= "\n"; $cnt = 0; } } else { prtw("WARNING: No REFERNCE point for ID [$id]\n"); } } if ($add_xg && $in_bbox) { $xg_points += $ncnt; $xg .= "NEXT\n"; $msg = $msg_stack[-1]; push(@xg_stack,$msg); } $dist = get_dist_stg_nm($tot_dist); prt("Points: $msg $dist\n") if (VERB9()); $poly_count++; if ($write_tmp_poly) { $tmp = $temp_poly.$poly_count; write2file($poly,$tmp); } } else { prtw("WARNING: ID $way in way tags, NOT in way_nd\n"); } } $xg = get_file_bbox().get_user_bbox().$xg; write2file($xg,$out_xg_file); prt("Written $xg_points of $ref_points XG ouput to $out_xg_file\n"); if (VERB5()) { $cnt = scalar @xg_stack; prt("Features include in XG, $cnt ways...\n"); prt(join("\n",@xg_stack)."\n"); } my @arr = sort keys %used_tags; $cnt = scalar @arr; if ($cnt) { prt("Found $cnt tags...\n"); $msg = ''; foreach $v (@arr) { $msg .= "$v="; $vh = $used_tags{$v}; my @a = sort keys %{$vh}; $msg .= join(" ",@a); $msg .= "\n"; } prt("$msg\n") if (VERB2()); } } ######################################### ### MAIN ### parse_args(@ARGV); ###prt( "$pgmname: in [$cwd]: Hello, World...\n" ); show_ref_hash(process_in_file($in_file)); pgm_exit(0,""); ######################################## sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write XG output to this file. (def=$out_xg_file)\n"); prt(" --bbox (-b) = Set BBOX. stg='min_lon,min_lat,max_lon,max_lat' \n"); # TODO: More control over the features included, presently airports,roads,water,... } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg,@arr,$cnt); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^b/) { need_arg(@av); shift @av; $sarg = $av[0]; @arr = split(",",$sarg); $cnt = scalar @arr; if ($cnt == 4) { @g_bbox = @arr; if (verify_bbox(\@g_bbox)) { $got_bbox = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Try -?\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Try -?\n"); } } elsif ($sarg =~ /^l/) { $load_log = 1; } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_xg_file = $sarg; prt("Set out file to [$out_xg_file].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; prtw("WARNING: Set DEFAULT file $in_file\n"); # # VNLK bbox 86.6777058675,27.5585931498,86.7291034105,27.6882296297 # # VHSK bbox 114.0552019893,22.4344392604,114.0999895101,22.4560101762 if (!$got_bbox && $add_def_bbox) { #$sarg = "86.6777058675,27.5585931498,86.7291034105,27.6882296297"; $sarg = "114.0552019893,22.4344392604,114.0999895101,22.4560101762"; @arr = split(",",$sarg); $cnt = scalar @arr; if ($cnt == 4) { @g_bbox = @arr; if (verify_bbox(\@g_bbox)) { $got_bbox = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Try -?\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Try -?\n"); } } #$verbosity = 5; $load_log = 1; } if (length($in_file) == 0) { give_help(); pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } } # eof - template.pl