xml-list.pl to HTML.

index -|- end

Generated: Sat Oct 24 16:35:32 2020 from xml-list.pl 2020/10/16 8.5 KB. text copy

#!/usr/bin/perl -w
# NAME: xml-list.pl
# AIM: Given an XML file, output a list of elements
# 2019-10-29 - review
# 08/04/2013 geoff mclane http://geoffair.net/mperl
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 2019-10-29";
#my $VERS = "0.0.1 2013-03-17";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $out_file = '';
my $data_dump = 0;
my $opt_force_array = 0;

# ### DEBUG ###
my $debug_on = 0;
#my $def_file = 'D:\Scenery\terrascenery\data\Scenery\Airports\7\0\V\70VA.threshold.xml';
my $def_file = 'C:\Users\user\Documents\FG\fgfp\kmia-katl.xml';

### 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);
}

# read XML file
my $TYP_HASH = 1;
my $TYP_ARRAY = 2;
my $TYP_CODE = 3;
my $TYP_GLOB = 4;
my $TYP_OTHER = 5;
my $TYP_UNDEF = 6;

my %type_text = (
    $TYP_HASH => 'HASH',
    $TYP_ARRAY => 'ARRAY',
    $TYP_CODE => 'CODE',
    $TYP_GLOB => 'GLOB',
    $TYP_OTHER => 'OTHER',
    $TYP_UNDEF => 'TEXT'
    );

sub get_type_number($) {
   my ($k) = shift;
   my $type = ref($k);
   if ($type) {
      if ($type eq 'HASH' ) {
            return $TYP_HASH;
      } elsif ($type eq 'ARRAY') {
            return $TYP_ARRAY;
      } elsif ($type eq 'CODE') {
         return $TYP_CODE;
      } elsif ($type eq 'GLOB') {
            return $TYP_GLOB;
      } else {
            return $TYP_OTHER;
      }
   }
    return $TYP_UNDEF;
}
sub get_type_text($) {
    my $num = shift;
    if (defined $type_text{$num}) {
        return $type_text{$num};
    }
    return 'Undefined $num';
}

sub is_text_type($) {
    my ($k) = shift;
    my $n = get_type_number($k);
    return 1 if ($n == $TYP_UNDEF);
    return 0;
}

sub show_hash_type($$$$);
sub show_array_type($$$$);

sub show_hash_type($$$$) {
    my ($data,$k,$lev,$path) = @_;
    my $ind = ' ' x $lev;
    my @arr = keys %{$data};
    my $acnt = scalar @arr;
    prt("$ind$lev:$k: Hash with $acnt keys [".join(" ",@arr)."]\n");
    my ($key,$val,$tn);
    foreach $key (@arr) {
        $val = ${$data}{$key};
        $tn = get_type_number($val);
        if ($tn == $TYP_HASH) {
            show_hash_type($val,$key,$lev+1,"$path/$key");
        } elsif ($tn == $TYP_ARRAY) {
            show_array_type($val,$key,$lev+1,"$path/$key");
        } elsif ($tn == $TYP_UNDEF) {
            prt("$ind$lev:$path/$key: = [$val]\n");
        }
    }
}

sub show_array_type($$$$) {
    my ($data,$k,$lev,$path) = @_;
    my $ind = ' ' x $lev;
    my $acnt = scalar @{$data};
    prt("$ind$lev:$k: Array with $acnt entries...\n");
    my ($val,$tn,$cnt);
    $cnt = 0;
    foreach $val (@{$data}) {
        $tn = get_type_number($val);
        if ($tn == $TYP_HASH) {
            show_hash_type($val,$k,$lev+1,"$path");
        } elsif ($tn == $TYP_ARRAY) {
            show_array_type($val,$k,$lev+1,"$path");
        } elsif ($tn == $TYP_UNDEF) {
            prt("$ind$lev:$k: Text [$val]\n");
        }
        $cnt++;
    }
}

sub process_in_file($) {
    my ($inf) = @_;
    if (! -f $inf) {
        prtw("WARNING: Can NOT locate file [$inf]!\n");
        return;
    }
    # from https://metacpan.org/pod/XML::Simple
    my ($xml);
    if ($opt_force_array) {
        $xml = new XML::Simple (ForceArray => 1, SuppressEmpty => 1);
        prt("Default XML::Simple->new(ForceArray => 1, SuppressEmpty => 1);\n");
    } else {
        $xml = XML::Simple->new();
        prt("Default XML::Simple->new();\$xml->XMLin($inf)...\n");
    }

    my $data = $xml->XMLin($inf);
    my $tn = get_type_number($data);
    if ($data_dump) {
        prt(Dumper($data));
        my $rt = ref($data);
        prt("type: $rt\n");
        $load_log = 1;
        return;
    }

    if ($tn == $TYP_HASH) {
        show_hash_type($data,"",1,"");
    } elsif ($tn == $TYP_ARRAY) {
        show_array_type($data,"",1,"");
    } elsif ($tn == $TYP_UNDEF) {
        prt("0:: Text [$data]\n");
    }
    #$load_log = 1;
}

#########################################
### MAIN ###
parse_args(@ARGV);
process_in_file($in_file);
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 =~ /^d/) {
                $data_dump = 1;
                prt("Set output a Data::Dumper only.\n") if (VERB1());
            } elsif ($sarg =~ /^f/) {
                $opt_force_array = 1;
                prt("Add 'ForceArray' XML option.\n") if (VERB1());
            } 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) && $debug_on) {
            $in_file = $def_file;
            prt("Set DEFAULT input to [$in_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(" --force       (-f) = Add 'ForceArray => 1, SuppressEmpty => 1' XML options.\n");
    prt(" --dump        (-d) = Output a Data::Dumper list, and exit.\n");
    prt("\n");
    prt(" Output XML::Simple parsing of the input file.\n");
}

# eof - template.pl

index -|- top