osm-load.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:50 2016 from osm-load.pl 2016/06/18 34 KB. text copy

#!/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 = <INF>;
    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]);
                #  <bounds minlat="-31.7130540" minlon="148.6136050" maxlat="-31.6947200" maxlon="148.6567780"/>
                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') {
            #  <way id="37623654" user="nm7s9" uid="12434" visible="true" version="1" changeset="1812676" timestamp="2009-07-13T00:57:47Z">
            @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)) {
            # <node id="441007981" lat="-31.7088281" lon="148.6651552" user="nm7s9" uid="12434" visible="true" version="1" changeset="1812676" timestamp="2009-07-13T00:57:45Z"/>
            # <node id="441013712" lat="-31.7020985" lon="148.6473310" user="nm7s9" uid="12434" visible="true" version="1" changeset="1812736" timestamp="2009-07-13T01:35:23Z">
            # <tag k="railway" v="level_crossing"/>
            # </node>
            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') {
            #  <way id="30215921" user="VK1RE" uid="69499" visible="true" version="2" changeset="808028" timestamp="2009-01-18T11:05:50Z">
            #   <nd ref="332988044"/>
            #   <nd ref="332988046"/>
            #  <tag k="created_by" v="Potlatch 0.10f"/>
            #  <tag k="highway" v="residential"/>
            # </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') {
            #  <bounds minlat="-31.7130540" minlon="148.6136050" maxlat="-31.6947200" maxlon="148.6567780"/>
            $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 <file>  (-o) = Write XG output to this file. (def=$out_xg_file)\n");
    prt(" --bbox <stg>  (-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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional