Generated: Sat Oct 24 16:35:32 2020 from xmlsimple03.pl 2017/01/16 31.1 KB. text copy
#!/usr/bin/perl -w # NAME: xmlsimple03.pl # AIM: Further experiments with XML::Simple # 2017-01-16 - Try to remove 'some' warnings... # 28/02/2014 - Another try... quite successful... creates a good perl reference # See xmlsax.pl for resolving a problem "could not find ParserDetails.ini in C:/Perl/site/lib/XML/SAX" # 01/03/2014 - After LOTS of effort, which got very close to completion # decide to abandon the conversion to JSON # The module remains a good XML parser, and value viewer # # 08/10/2013 - Initial cut use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use XML::Simple; use Data::Dumper; use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.2 2017-01-16"; ##my $VERS = "0.0.1 2013-10-08"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_file = ''; my $indent = 1; # ### DEBUG ### my $debug_on = 0; my $def_file = 'X:\fgdata\Aircraft\c172p\c172p-set.xml'; ### my $def_file = 'C:\Users\user\Downloads\LDS767\KSFO.xml'; my $def_out = $temp_dir.$PATH_SEP."tempxml2.json"; my $def_file2 = 'C:\Program Files (x86)\Airline Project 0.3.7\Data\addons\airports\africa.xml'; my $in_dir = 'C:\Program Files (x86)\Airline Project 0.3.7\Data\addons\airports'; my @air_files = ("africa.xml", "asia.xml", "australia oceania.xml", "europe.xml", "north america.xml", "south america.xml"); my %airports = (); my $air_count = 0; my $air_files = 0; ### program variables my @warnings = (); my $cwd = cwd(); 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" ) if (VERB9()); } } 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); } sub simpout2() { my $txt = <<EOF; \$VAR1 = { 'Airport' => { 'Star' => [ { 'Name' => 'BSR2', 'Star_Waypoint' => [ { 'Longitude' => '-121.642111', 'ID' => '1', 'AltitudeCons' => '0', 'Latitude' => '36.181294', 'Type' => 'Normal', 'Altitude' => '0', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Name' => 'BSR' }, { 'Longitude' => '-121.879714', 'ID' => '2', 'AltitudeCons' => '0', 'Latitude' => '36.455183', 'Type' => 'Normal', 'Altitude' => '0', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Name' => 'CARME' }, ................ 'Name' => 'VECTORS' } ] }, { 'Star_Transition' => [ { 'StarTr_Waypoint' => { 'Longitude' => '-124.234531', 'ID' => '1', 'AltitudeCons' => '0', 'Latitude' => '40.671267', 'Type' => 'Normal', 'Altitude' => '0', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Name' => 'FOT' }, 'Name' => 'FOT' }, { 'StarTr_Waypoint' => { 'Longitude' => '-123.352236', 'ID' => '1', 'AltitudeCons' => '0', 'Latitude' => '43.182422', 'Type' => 'Normal', 'Altitude' => '0', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Name' => 'RBG' }, 'Approach' => [ { 'App_Waypoint' => [ { 'Longitude' => '-122.211678', 'ID' => '1', 'AltitudeCons' => '0', 'Latitude' => '37.860861', 'Type' => 'Normal', 'Altitude' => '5000', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Name' => 'BERKS' }, { 'Longitude' => '-122.280322', 'ID' => '2', 'AltitudeCons' => '0', 'Latitude' => '37.757928', 'Type' => 'Normal', 'Altitude' => '2900', 'Speed' => '170', 'AltitudeRestriction' => 'at', 'Name' => 'SHAKE' }, ], ........................................................ 'Name' => 'VOR19L' } ], 'ICAOcode' => 'KSFO', 'Sid' => { 'Sid_Waypoint' => [ { 'Longitude' => '-122.373892', 'ID' => '1', 'DMEtoIntercept' => '04.0', 'Hdg_Crs' => '1', 'AltitudeCons' => '0', 'Latitude' => '37.619483', 'Type' => 'DmeIntc', 'Altitude' => '1600', 'Hdg_Crs_value' => '350', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Sp_Turn' => 'Right', 'Name' => 'SFO' }, { 'Longitude' => '-122.522714', 'ID' => '2', 'Hdg_Crs' => '1', 'AltitudeCons' => '0', 'RadialtoIntercept' => '168', 'Latitude' => '37.855303', 'Type' => 'Intc', 'Altitude' => '0', 'Hdg_Crs_value' => '200', 'Speed' => '0', 'AltitudeRestriction' => 'at', 'Sp_Turn' => 'Right', 'Name' => '(INTC)' }, EOF return $txt; } sub clean_ll($) { my $txt = shift; my $len = length($txt); my $cll = ''; my ($i,$ch); my $innum = 0; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); if ($ch =~ /(N|S|E|W)/) { $innum = 0; $cll .= ' ' if (length($cll)); $cll .= $ch; next; } if ($innum) { if ($ch =~ /\d/) { $cll .= $ch; } else { $innum = 0; } } else { if ($ch =~ /\d/) { $cll .= ' ' if (length($cll)); $cll .= $ch; $innum = 1; } } } return $cll; } #============================================================== ###my $json = "{\n"; ###my $jline = 1; sub is_a_double($) { my $val = shift; return 1 if ($val =~ /^-?\d+\.?\d*$/); # { print "is a real number\n" } return 1 if ($val =~ /^\d+$/); # { print "is a whole number\n" } return 1 if ($val =~ /^-?\d+$/); # { print "is an integer\n" } return 1 if ($val =~ /^[+-]?\d+$/); # { print "is a +/- integer\n" } return 1 if ($val =~ /^-?(?:\d+(?:\.\d*)?|\.\d+)$/); # { print "is a decimal number\n" } return 1 if ($val =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # { print "a C float\n" } return 0 if ($val =~ /\D/); # { print "has nondigits\n" } return 0; } sub fix_json_decimal($) { my $val = shift; $val = substr($val,1) if ($val =~ /^\+/); # remove any redundant leading '+' my $len = length($val); return $val if ($len == 1); my $nval = ''; my ($i,$pp,$cp,$np,$i2,$hd,$hm,$hv); $cp = ''; $hd = 0; $hm = 0; $hv = 0; for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pp = $cp; $cp = substr($val,$i,1); $np = ($i2 < $len) ? substr($val,$i2,1) : ''; if ($cp eq '.') { $hd = 1; } elsif ($cp eq '-') { $hm = 1; } elsif ($cp eq '0') { if (!$hd && !$hv) { if ($np =~ /\d/) { $cp = ''; # kill this } } } elsif ($cp =~ /\d/) { $hv = 1; } $nval .= $cp; } return $nval; } sub is_comma_term($) { my $txt = shift; $txt = trim_tailing($txt); my $ch = substr($txt,length($txt)-1,1); return 1 if ($ch eq ','); return 0; } sub show_hash($$); sub show_array($$); sub get_indent($) { my $lev = shift; my $sp = ' ' x $indent; my $ind = $sp x $lev; return $ind; } sub show_hash($$) { my ($rh,$lev) = @_; my @arr = keys %{$rh}; my $cnt = scalar @arr; my $ind = get_indent($lev); prt($ind."$cnt keys - ".join(" ",@arr)."\n") if (VERB2()); my ($key,$val,$ref,$add,$jadd,$tmp); $add = 0; foreach $key (@arr) { $add++; $val = ${$rh}{$key}; $ref = ref($val); if ($ref && length($ref)) { if ($ref eq 'HASH') { $cnt = scalar keys %{$val}; prt($ind."$key is $ref - with $cnt keys\n") if (VERB5()); # $json .= $ind."\"$key\":{\n"; # $jline++; # $jadd = $jline.": \"$key\":{".'\n HASH }'; show_hash($val,$lev+1); # # UGLY FIX1! # if ($json =~ /,\n$/) { # $json =~ s/,\n$/\n/; # $jadd .= " *UF1* " # } # $json .= $ind."}"; # $json .= ',' if ($add < $cnt); # $json .= "\n"; # $jline++; # $jadd .= ','." ($add<$cnt)" if ($add < $cnt); # $jadd .= '\n'; # prt("JSON: $jadd - $jline\n") if (VERB9()); } elsif ($ref eq 'ARRAY') { $cnt = scalar @{$val}; prt($ind."$key is $ref - with $cnt items\n") if (VERB5()); # # UGLY FIX2!!! # $tmp = ''; # if (! $json =~ /,\n$/) { # $json =~ s/\n$/,\n/; # $tmp = " *UF2* "; # } # $json .= $ind."\"$key\":[\n"; # $jline++; # $jadd = $jline.": \"$key\":[".'\n ARRAY ]'.$tmp; show_array($val,$lev+1); # $json .= $ind."]"; # $json .= ',' if ($add < $cnt); # $json .= "\n"; # $jline++; # $jadd .= ','." ($add<$cnt)" if ($add < $cnt); # $jadd .= '\n'; # prt("JSON: $jadd - $jline\n") if (VERB9()); } else { prtw("WARNING: $ref NOT HANDLED! *** FIX ME ***\n"); } } else { prt($ind."$key=$val\n"); # # UGLY FIX4!!! # $tmp = ''; # if ($json =~ /\{\n$/) { # $tmp = " *NUF4[* "; # } elsif ($json =~ /\[\n$/) { # $tmp = " *NUF4{* "; # } elsif (is_comma_term($json)) { # $tmp = " *NUF4,* "; # } else { # $json =~ s/\n$/,\n/; # $tmp = " *UF4* "; # } # $json .= $ind; # $json .= "\"$key\":"; # if (is_a_double($val)) { # $json .= fix_json_decimal($val); # } else { # $json .= "\"$val\""; # } # $json .= ',' if ($add < $cnt); # $json .= "\n"; # $jline++; # # # DEBUG ONLY # $jadd = $jline.": \"$key\":"; # if (is_a_double($val)) { # $jadd .= fix_json_decimal($val); # } else { # $jadd .= "\"$val\""; # } # $jadd .= ','." ($add<$cnt)" if ($add < $cnt); # $jadd .= '\n'.$tmp; # prt("JSON: $jadd\n") if (VERB9()); } } } sub show_array($$) { my ($ra,$lev) = @_; my ($itm,$ref,$i,$max,$cnt,$i2,$jadd); $max = scalar @{$ra}; my $ind = get_indent($lev); for ($i = 0; $i < $max; $i++) { $i2 = $i + 1; $itm = ${$ra}[$i]; $ref = ref($itm); if ($ref && length($ref)) { if ($ref eq 'HASH') { $cnt = scalar keys %{$itm}; prt($ind."$i2: $ref - with $cnt keys\n") if (VERB5()); # $json .= $ind."{\n"; # $jline++; # $jadd = $jline.': {\n HASH }'; show_hash($itm,$lev+1); # # UGLY FIX3! # if ($json =~ /,\n$/) { # $json =~ s/,\n$/\n/; # $jadd .= " *UF3* "; # } # $json .= $ind."}"; # $json .= ',' if ($i2 < $max); # $json .= "\n"; # $jline++; # $jadd .= ','." ($i2<$max)" if ($i2 < $max); # $jadd .= '\n'; # prt("JSON: $jadd - $jline\n") if (VERB9()); } elsif ($ref eq 'ARRAY') { $cnt = scalar @{$itm}; prt($ind."$i2: $ref - with $cnt items\n") if (VERB5()); # $json .= $ind."[\n"; # $jline++; # $jadd = $jline.': [\n ARRAY ]'; show_array($itm,$lev+1); # $json .= $ind."]"; # $json .= ',' if ($i2 < $max); # $json .= "\n"; # $jline++; # $jadd .= ','." ($i2<$max)" if ($i2 < $max); # $jadd .= '\n'; # prt("JSON: $jadd - $jline\n") if (VERB9()); } else { prtw("WARNING: $ref NOT HANDLED! *** FIX ME ***\n"); } } else { prt($ind."$i2: txt $itm\n"); # prtw("WARNING: ".$ind."$i2: txt $itm *** FIX ME ***\n"); } } } sub process_in_file($) { my ($inf) = @_; my $xref = XMLin($inf); my ($ref,@arr,$cnt,$val,$key); $ref = ref($xref); prt("XMLin(file) created a $ref\n") if (VERB1()); if ($ref eq 'HASH') { @arr = keys %{$xref}; $cnt = scalar @arr; prt("$ref - $cnt keys - ".join(" ",@arr)."\n") if (VERB1()); show_hash($xref,1); } elsif ($ref eq 'ARRAY') { $cnt = scalar @{$xref}; prt("$ref - $cnt items\n") if (VERB1()); show_array($xref,1); } else { prt("txt $xref\n"); prt("Does not feel like XML!\n"); return; } ###$load_log = 1; # $json .= "}\n"; # if (length($out_file)) { # write2file($json,$out_file); # prt("JSON written to $out_file\n"); # } else { # prt("JSON output -\n"); # prt("$json"); # prt("JSON written to stdout due no -o <out_file>\n"); # } } sub process_in_file_OK_but_specific($) { my ($inf) = @_; my $xref = XMLin($inf); my ($ref,@arr,$cnt,$val,$key); $ref = ref($xref); prt("XMLin(file) created a $ref\n"); if ($ref eq 'HASH') { @arr = keys %{$xref}; $cnt = scalar @arr; prt(" HASH has $cnt keys - ".join(" ",@arr)."\n"); } if (defined ${$xref}{Airport}) { my $rap = ${$xref}{Airport}; $ref = ref($rap); prt("Got 'Airport' ref $ref\n"); if ($ref eq 'HASH') { @arr = keys %{$rap}; $cnt = scalar @arr; prt(" HASH has $cnt keys - ".join(" ",@arr)."\n"); ###prt(" "); foreach $key (@arr) { $val = ${$rap}{$key}; $ref = ref($val); if ($ref && length($ref)) { prt(" $key is $ref\n"); if ($ref eq 'ARRAY') { show_array($val,1); } elsif ($ref eq 'HASH') { show_hash($val,1); } } else { prt(" $key=$val\n"); } } ##prt("\n"); } if (defined ${$rap}{Sid}) { my $rsid = ${$rap}{Sid}; $ref = ref($rsid); prt("Got 'Airport-Sid' ref $ref\n"); if ($ref eq 'HASH') { @arr = keys %{$rsid}; $cnt = scalar @arr; prt(" HASH has $cnt keys - ".join(" ",@arr)."\n"); ##prt(" "); foreach $key (@arr) { $val = ${$rsid}{$key}; $ref = ref($val); if ($ref && length($ref)) { prt(" $key is $ref\n"); if ($ref eq 'ARRAY') { show_array($val,1); } elsif ($ref eq 'HASH') { show_hash($val,1); } } else { prt(" $key=$val\n"); } } ##prt("\n"); } } if (defined ${$rap}{Star}) { my $rsid = ${$rap}{Star}; $ref = ref($rsid); prt("Got 'Airport-Star' ref $ref\n"); if ($ref eq 'ARRAY') { $cnt = scalar @{$rsid}; prt(" ARRAY has $cnt items\n"); @arr = @{$rsid}; show_array(\@arr,1); } } if (defined ${$rap}{Approach}) { my $rapp = ${$rap}{Approach}; $ref = ref($rapp); prt("Got 'Airport-Approach' ref $ref\n"); if ($ref eq 'ARRAY') { $cnt = scalar @{$rapp}; prt(" ARRAY has $cnt items\n"); @arr = @{$rapp}; show_array(\@arr,1); } } } #prt(Dumper($ref)); ###$load_log = 1; } sub process_in_file_MAYBE_but_specific($) { my ($inf) = @_; my $ref = XMLin($inf); #prt(Dumper($ref)); $air_files++; my ($key,$icao,$min,$len); my ($lons,$lon,$lats,$lat); if (defined ${$ref}{'airport'}) { my $rh = ${$ref}{'airport'}; my @arr = keys %{$rh}; #prt(join("\n",@arr)."\n"); $min = 0; foreach $key (@arr) { $len = length($key); $min = $len if ($len > $min); } foreach $key (@arr) { my $rh2 = ${$rh}{$key}; $icao = ' '; $icao = ${$rh2}{'icao'} if (defined ${$rh2}{'icao'}); # 016\x{b0}56'50''E $lons = ' '; $lats = ' '; if (defined ${$rh2}{'coordinates'}{'longitude'}{'value'}) { $lons = ${$rh2}{'coordinates'}{'longitude'}{'value'}; $lons = clean_ll($lons); } if (defined ${$rh2}{'coordinates'}{'latitude'}{'value'}) { $lats = ${$rh2}{'coordinates'}{'latitude'}{'value'}; $lats = clean_ll($lats); } if (defined $airports{$icao}) { my $rah = $airports{$icao}; my $key2 = ${$rah}{name}; my $lats2 = ${$rah}{lat}; my $lons2 = ${$rah}{lon}; prtw("WARNING: ICAO [$icao] repeated $key $lats $lons\nof $key2 $lats2 $lons2\nfile: $inf\n"); } else { my %h = (); $h{name} = $key; $h{lat} = $lats; $h{lon} = $lons; $airports{$icao} = \%h; $air_count++; } $key .= ' ' while (length($key) < $min); $icao .= ' ' while (length($icao) < 4); prt("$icao $key $lats $lons\n"); } } $load_log = 1; } sub process_files() { my ($file,$ff); foreach $file (@air_files) { $ff = $in_dir.$PATH_SEP.$file; if (-f $ff) { process_in_file($ff); } else { prtw("WARNING: Can NOT locate [$ff]\n"); } } prt("Found $air_count airports, in $air_files processed...\n"); } ######################################### ### MAIN ### parse_args(@ARGV); process_in_file($in_file); ###process_files(); pgm_exit(0,""); ######################################## sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); 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 =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } elsif ($sarg =~ /^i/) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg =~ /^\d+$/) { $indent = $sarg; prt("Set indent to [$indent].\n") if (VERB1()); } else { pgm_exit(1,"Expected integer following $arg, NOT [$sarg]\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n") if (VERB1()); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_file) == 0) { $in_file = $def_file; prt("Set DEFAULT input to [$in_file]\n"); #$load_log = 1; } if (length($out_file) == 0) { $out_file = $def_out; prt("Set DEFAULT output to [$out_file]\n"); } } if (length($in_file) == 0) { 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"); } } 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(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out <file> (-o) = Write output to this file.\n"); prt(" --indent <num> (-i) = Number of indent spaces. (def=$indent)\n"); } sub simpout() { my $txt = <<EOF; Set DEFAULT input to [C:\\Program Files (x86)\\Airline Project 0.3.7\\Data\\addons\\airports\\africa.xml] \$VAR1 = { 'airport' => { 'Kuito Airport' => { 'coordinates' => { 'longitude' => { 'value' => "016\\x{b0}56'50''E" }, 'latitude' => { 'value' => "012\\x{b0}24'16''S" } }, 'town' => { 'country' => '224', 'DST' => '01:00:00', 'town' => 'Kuito', 'GMT' => '01:00:00' }, 'size' => { 'cargo' => 'Smallest', 'value' => 'Smallest', 'cargovolume' => '0', 'pax' => '24' }, 'icao' => 'FNKU', 'runways' => { 'runway' => { 'surface' => 'Asphalt', 'length' => '2500', 'name' => '08/26' } }, 'terminals' => { 'terminal' => { 'gates' => '2', 'name' => 'Terminal A' } }, 'iata' => 'SVP', 'type' => 'Domestic', 'season' => 'All_Year' }, 'Es Senia Airport' => { 'coordinates' => { ... The XML for this entry <airport name="Kuito Airport" icao="FNKU" iata="SVP" type="Domestic" season="All_Year"> <town town="Kuito" country="224" GMT="01:00:00" DST="01:00:00" /> <coordinates> <latitude value="012°24'16''S" /> <longitude value="016°56'50''E" /> </coordinates> <size value="Smallest" pax="24" cargo="Smallest" cargovolume="0"/> <terminals> <terminal name="Terminal A" gates="2" /> </terminals> <runways> <runway name="08/26" length="2500" surface="Asphalt" /> </runways> </airport> EOF return $txt; } # eof - xmlsimple03.pl