#!/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", }