Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re: Unwinding multidimensional HASH (path, xpath, json)

by Anonymous Monk
on Jan 16, 2013 at 11:44 UTC ( #1013562=note: print w/ replies, xml ) Need Help??


in reply to Unwinding multidimensional HASH

you could adapt

#!/usr/bin/perl -- use strict; use warnings; my %hoh = ( a => { b => { c => 4 }, }, d => { e => { f => 5, g => 6 }, }, h => { i => { i => { 2..5 }, j => { 0..3 }, k => { 7..10 }, }, j => { 0..3 }, k => { 7..10 }, }, ); rehoh( \%hoh ); sub rehoh { my( $hoh, $depth, $path, $callback ) = @_; $depth ||= 0; $path ||= ''; while( my( $key, $val ) = each %$hoh ){ if( ref $val ){ rehoh( $val , $depth + 1, "$path/$key" ); } else { if( $callback ){ $callback->($val, "$path/$key" ); } else { print "($depth)", " " x $depth, "$val\n"; print " " x ( length( "($depth)" ) + $depth ), "\@ $path/$key\ +n"; } } } } __END__ (2) 8 @ /h/k/7 (2) 10 @ /h/k/9 (2) 1 @ /h/j/0 (2) 3 @ /h/j/2 (3) 8 @ /h/i/k/7 (3) 10 @ /h/i/k/9 (3) 1 @ /h/i/j/0 (3) 3 @ /h/i/j/2 (3) 5 @ /h/i/i/4 (3) 3 @ /h/i/i/2 (2) 4 @ /a/b/c (2) 6 @ /d/e/g (2) 5 @ /d/e/f

or maybe JSON::Path#paths

read Tutorials Data Types and Variables,the basic datatypes, three, keys, values, ref

It seems a mistake to return a multidimensional structure when all you want is a bunch of xpath's, anyway :)


Comment on Re: Unwinding multidimensional HASH (path, xpath, json)
Download Code
Replies are listed 'Best First'.
Re^2: Unwinding multidimensional HASH (path, xpath, json)
by Anonymous Monk on Jan 16, 2013 at 11:58 UTC
    ugly :)
    #!/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; #~ $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 ; use Data::Diver qw' Dive '; sub fudge { my $ref = shift; my @paths; if( my $orders = Dive $ref, 'Orders' ){ while( my( $key, $value ) = each %$orders ){ if( ref $value ){ my( $type ) = keys %$value; push @paths, [ $key, join '/', 'Orders', $key, $type, +'@'.$type ]; } else { push @paths, [ $key, join '/', 'Orders', $key ]; } } } return @paths; } __END__ { Orders => { GeneralDescription => "General Instruction Section", order1 => { type => "print" }, order2 => { 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", }

      uglier

      #!/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", }
Re^2: Unwinding multidimensional HASH (path, xpath, json)
by prassrin (Initiate) on Jan 17, 2013 at 06:04 UTC
    Thank you very much! It works perfectly for me. I will work out this and get back. Once again thanks!! Thank you everyone!! Cheers:)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1013562]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2015-07-08 02:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls