#!/usr/bin/perl --
use strict; use warnings;
my $fudge = {
"Orders" => {
"GeneralDescription" => "General Instruction Section",
"order1" => { "type" => "print" },
"order2" => { "type" => "print" }
}
};
use Data::Dump qw' dd ';
dd $fudge;
rehoh( $fudge );
#~ $xmlrecord
#~ ...{GeneralDescription} = ...('/Orders/GeneralDescription');
#~ ...{order1} = ...('/Orders/order1/type/@type');
#~ ...{order2} = ...('/Orders/order2/type/@type');
my @paths = fudge( $fudge );
dd \@paths;
my %xmlrecord = map { $$_[0] => ( $$_[1] ) } @paths;
dd \%xmlrecord ;
sub fudge {
my @paths;
rehoh( shift, 0, '', sub {
my( $key, $val, $depth, $path ) = @_;
my $spath = join '/', @$path;;
print "$depth $spath ### $val\n";
if( 1 == $depth and not @paths ) {
push @paths, [ $path->[-1], $spath ];
}elsif( 2 == $depth ){
push @paths, [ $path->[-2], "$spath/\@$key" ];
}
});
@paths;
}
sub rehoh {
my( $hoh, $depth, $path, $callback ) = @_;
$depth ||= 0;
$path ||= [''];
while( my( $key, $val ) = each %$hoh ){
if( ref $val ){
$callback and $callback->( $key, $val, $depth, [ @$path, $key ]
+);
rehoh( $val , $depth + 1, [ @$path, $key ], $callback );
} else {
if( $callback ){
$callback->($key, $val, $depth, [ @$path, $key ] );
} else {
print "($depth)", " " x $depth, "$val\n";
my $path = '@' . join '/', @$path, $key;
print " " x ( length( "($depth)" ) + $depth ), "$path\n";
}
}
}
}
__END__
{
Orders => {
GeneralDescription => "General Instruction Section",
order1 => { type => "print" },
order2 => { type => "print" },
},
}
(1) General Instruction Section
@/Orders/GeneralDescription
(2) print
@/Orders/order2/type
(2) print
@/Orders/order1/type
0 /Orders ### HASH(0x99b5dc)
1 /Orders/GeneralDescription ### General Instruction Section
1 /Orders/order2 ### HASH(0x3f9bbc)
2 /Orders/order2/type ### print
1 /Orders/order1 ### HASH(0x3f9abc)
2 /Orders/order1/type ### print
[
["GeneralDescription", "/Orders/GeneralDescription"],
["order2", "/Orders/order2/type/\@type"],
["order1", "/Orders/order1/type/\@type"],
]
{
GeneralDescription => "/Orders/GeneralDescription",
order1 => "/Orders/order1/type/\@type",
order2 => "/Orders/order2/type/\@type",
}
|