xml08.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:52 2012 from xml08.pl 2011/12/22 10.1 KB.

#!/usr/bin/perl
# xml08.pl
# AIM: To explore the XML:Simple interface ...
# use module
# 22/12/2011 - A fresh look, and seem to have got the jist now... the load is quite SLOW,
# but each item can be enumerated. Seems ForceArray does quite little, except force each 
# indent level to begin with an ARRAY
use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
open_log($outfile);
my $enumd3 = 0;

my $load_log = 1;
my $dump_data = 0;
my $show_type_text = 1;
my $use_force_array = 0;
# create object
my ($xml2, $data2); # file load

my $in_proj = 'C:\FGCVS\flightgear\data\materials.xml';
###my $in_proj = 'C:\FGCVS\flightgear\data\materials-dds.xml';
###my $in_proj = 'C:\DTEMP\osm-1153716.gpx';
###my $in_proj = 'C:\FG\27\FlightGear\flightgear.vcproj';
###my $in_proj =  'C:\Documents and Settings\Geoff McLane.PRO-1\My Documents\My Photo Albums\Photo Album 2006-11-24.album\studio.data\studio.plist';

my @xmlkeys = ();
my @srcfls = ();
my @hdrfls = ();
my $key_cnt = 0;

# 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,$dep,$path) = @_;
    my $cnt = 0;
    my $indent = '  ' x $dep;
    my ($key,$val,$num,$text,$icnt,$npath);
    foreach $key (keys %{$data}) {
        $val = ${$data}{$key};
        $num = get_type_number($val);
        $text = ($show_type_text ? get_type_text($num) : "");
        $cnt++;
        ###$npath = $path.'->'.'{"'.$key.'"}';
        $npath = $path.'{"'.$key.'"}';
        if ($num == $TYP_UNDEF) {
            prt( $indent."$cnt: $key = ".$val." $text $npath\n" );
        } elsif ($num == $TYP_HASH) {
            $icnt = scalar keys(%{$val});
            prt($indent."$cnt: $key $text $icnt $npath\n" );
            show_hash_type($val,($dep+1),$npath);
        } elsif ($num == $TYP_ARRAY) {
            $icnt = scalar @{$val};
            prt($indent."$cnt: $key $text $icnt $npath\n" );
            show_array_type($val,($dep+1),$npath);
        } else {
            prt($indent."$cnt: $key $text MISSED - CHECK ME!\n" );
        }
    }
}

sub show_array_type($$$) {
    my ($data,$dep,$path) = @_;
    my $cnt = 0;
    my $indent = '  ' x $dep;
    my ($key,$num,$text,$icnt,$npath);
    foreach $key (@{$data}) {
        $num = get_type_number($key);
        $text = ($show_type_text ? get_type_text($num) : "");
        $npath = $path.'['.$cnt.']';
        $cnt++;
        if ($num == $TYP_UNDEF) {
            prt( $indent."$cnt: $key $text $npath\n" );
        } elsif ($num == $TYP_HASH) {
            $icnt = scalar keys(%{$key});
            prt($indent."$cnt: HASH, with $icnt keys $npath\n" );
            show_hash_type($key,($dep+1),$npath);
        } elsif ($num == $TYP_ARRAY) {
            $icnt = scalar @{$key};
            prt($indent."$cnt: ARRAY, with $icnt items $npath\n" );
            show_array_type($key,($dep+1),$npath);
        } else {
            prt($indent."$cnt: $text MISSED - CHECK ME!\n" );
        }
    }
}

sub show_xml_keys($) {
    my ($path) = shift;
    my $cnt1 = 0;
    my (@arr,$cnt,$msg,$key,$val);
    foreach my $k (@xmlkeys) {
        $cnt1++;
        my $data = $data2->{$k};
        #my $npath = $path.'->'.'{"'.$k.'"}';
        my $npath = $path.'{"'.$k.'"}';
        my $num = get_type_number($data);
        my $text = get_type_text($num);
        if ($dump_data) {
            prt( "$cnt1 $k $text ($num)\n" );
            prt("=================================================\n");
            prt( Dumper($data) );
            prt("=================================================\n");
        }
        if ($num == $TYP_UNDEF) {
            # not scalar == TEXT
            prt( "$cnt1: $k = ".$data." $text $npath\n" );
        } elsif ($num == $TYP_HASH) {
            $cnt = scalar keys(%{$data});
            prt( "$cnt1: $k $text, with $cnt keys $npath\n" );
            show_hash_type($data,1,$npath);
        } elsif ($num == $TYP_ARRAY) {
            $cnt = scalar @{$data};
            prt( "$cnt1 $k $text, with $cnt items $npath\n" );
            show_array_type($data,1,$npath);
        } else {
            prt( "$cnt1 $k $text CHECK ME\n" );
        }
    }
}

sub test_path($) {
    my ($dat) = @_;
    my ($h,$n,$t,$cnt,$msg,$i,$i2,$lat,$lon,$ele);
    #$h = ${$dat}->{"trk"}->{"trkseg"}->{"trkpt"};
    $h = ${$dat}{"trk"}{"trkseg"}{"trkpt"};
    $n = get_type_number($h);
    $t = get_type_text($n);
    if ($n == $TYP_UNDEF) {
        $msg = "TEXT [$h]";
    } elsif ($n == $TYP_HASH) {
        $cnt = scalar keys(%{$h});
        $msg = "with $cnt keys";
    } elsif ($n == $TYP_ARRAY) {
        $cnt = scalar @{$h};
        $msg = "with $cnt items";
        for ($i = 0; $i < $cnt; $i++) {
            $lat = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"lat"};
            $lon = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"lon"};
            $ele = ${$dat}{"trk"}{"trkseg"}{"trkpt"}[$i]{"ele"};
            $i2 = $i + 1;
            prt("$i2: $lat,$lon,$ele\n");
        }
    } else {
        $msg = "CHECK ME!";
    }
    prt("test_path $t $msg\n");
}

sub test_path2() {
    # 2 material ARRAY, with 188 items ${$data2}{"material"}
    my ($n,$t,$i,$cnt,$i2,$name,$j,$txtr);
    my ($acnt,$tmp,$val);
    my $array = ${$data2}{"material"};
    $n = get_type_number($array);
    $t = get_type_text($n);
    if ($n == $TYP_ARRAY) {
        $cnt = scalar @{$array};
        prt("test_path $t, with $cnt elements\n");
        for ($i = 0; $i < $cnt; $i++) {
            $i2 = $i + 1;
            # 1: HASH, with 9 keys ${$data2}{"material"}[0]
            my $hash = ${$array}[$i];
            $n = get_type_number($hash);
            $t = get_type_text($n);
            if ($n == $TYP_HASH) {
                my $hcnt = scalar keys(%{$hash});
                #prt("test_path $t, with $hcnt keys.\n");
                # 4: name = grass_rwy TEXT ${$data2}{"material"}[0]{"name"}
                $name = "'name' NOT found";
                if (defined ${$hash}{"name"}) {
                    $name = ${$hash}{"name"};
                    $n = get_type_number($name);
                    $t = get_type_text($n);
                    if ($n == $TYP_ARRAY) {
                        $acnt = scalar @{$name};
                        $tmp = '';
                        for ($j = 0; $j < $acnt; $j++) {
                            $val = ${$name}[$j];
                            $tmp .= ' ' if (length($tmp));
                            if (is_text_type($val)) {
                                $tmp .= "$val";
                            } else {
                                $tmp .= "NTT ".get_type_text(get_type_number($val));
                            }
                        }
                        $name = $tmp;
                    } elsif ($n != $TYP_UNDEF) {
                        $name = "Is type $t";
                    }
                }
                $txtr = "'texture' NOT defined";
                if (defined ${$hash}{"texture"}) {
                    $txtr = ${$hash}{"texture"};
                    $n = get_type_number($txtr);
                    $t = get_type_text($n);
                    if ($n == $TYP_ARRAY) {
                        $acnt = scalar @{$txtr};
                        $tmp = '';
                        for ($j = 0; $j < $acnt; $j++) {
                            $val = ${$txtr}[$j];
                            $tmp .= ' ' if (length($tmp));
                            if (is_text_type($val)) {
                                $tmp .= "$val";
                            } else {
                                $tmp .= "NTT ".get_type_text(get_type_number($val));
                            }
                        }
                        $txtr = $tmp;
                    } elsif ($n != $TYP_UNDEF) {
                        $txtr = "Is type $t";
                    }
                }

                prt("$i2:, name = [$name], texture [$txtr]\n");
            } else {
                prt("test_path $t NOT HASH\n");
                last;
            }

        }

    } else {
        prt("test_path $t NOT ARRAY\n");
    }
}

#### MAIN ####
#############################
if (! -f $in_proj) {
   mydie( "ERROR: Can NOT locate [$in_proj] ...\n" );
}

prt( "Loading [$in_proj] ...\n" );

if ($use_force_array) {
    $xml2 = new XML::Simple (ForceArray => 1);
    prt("Using (ForceArray => 1) ...\n");
} else {
    $xml2 = new XML::Simple;
    prt("NOT using (ForceArray => 1) ...\n");
}
#$data2 = $xml2->XMLin($raw2);
$data2 = $xml2->XMLin($in_proj);
# access XML data
# prt( "Output of [$in_proj]...\nNOT using (ForceArray => 1) ...\n" );
prt( "Output of [$in_proj]...\n");

###prt( Dumper($data2) );
$key_cnt = 0;
foreach my $key (keys %{$data2}) {
   $key_cnt++;
   ##prt( "$key_cnt $key\n" );
   push(@xmlkeys, $key);
}
#test_path($data2);  #'${data2}->{"trk"}->{"trkseg"}->{"trkpt"}
test_path2();
prt("Got $key_cnt primary keys...\n");
show_xml_keys("\${\$data2}");

close_log($outfile,$load_log);
exit(0);

# eof - 

index -|- top

checked by tidy  Valid HTML 4.01 Transitional