Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Unwinding multidimensional HASH

by prassrin (Initiate)
on Jan 16, 2013 at 09:44 UTC ( #1013543=perlquestion: print w/ replies, xml ) Need Help??
prassrin has asked for the wisdom of the Perl Monks concerning the following question:

I have a JSON which is multidimensional.

$json='{"Orders":{"GeneralDescription":"General Instruction Section"," +order1":{"type":"print"},"order2":{"type":"print"}}}';
I convert it in to HASH value. I simply ignore values and want search XML by forming tags with the variable names. Like the below one.
$xmlrecord{GeneralDescription}=$root->findvalue('/Orders/GeneralDescri +ption); $xmlrecord{order1}= $root->findvalue('/Orders/order1/type/@type'); $xmlrecord{order2}= $root->findvalue('/Orders/order2/type/@type');

Please provide me some clue or the way I can go head.

Comment on Unwinding multidimensional HASH
Select or Download Code
Re: Unwinding multidimensional HASH (path, xpath, json)
by Anonymous Monk on Jan 16, 2013 at 11:44 UTC

    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 :)

      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", }
      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: perlquestion [id://1013543]
Approved by vinoth.ree
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (10)
As of 2014-12-26 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (171 votes), past polls