Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Generating a Hash of Hashes Recursively to Display Database Hierarchy

by c4onastick (Friar)
on Jun 22, 2009 at 21:19 UTC ( #773768=perlquestion: print w/ replies, xml ) Need Help??
c4onastick has asked for the wisdom of the Perl Monks concerning the following question:

I've been trying to write a recursive function to generate a hash of hashes with little luck. (Recursive functions seem to be my nemesis as of late...) I'm parsing some hierarchical data from a database and trying to display it in a Win32::GUI::Treeview.

I've written a recursive function to populate the TreeView given input that looks like this:

Item1 => { SubItem1 => { SubSubItem1 => 1, SubSubItem2 => 1, SubSubItem3 => 1, }, SubItem2 => { SubSubItem1 => 1, SubSubItem2 => 1, SubSubItem3 => 1, }, }, Item2 => { ...

Which works great and looks like this:

sub hashref_to_treeview { my $hashref = shift; my $treeview = shift; # Win32::GUI::Treeview object my $parent_node = shift || 0; return unless ref($hashref) eq 'HASH'; for my $node ( sort keys %$hashref ) { my $new_node = $treeview->InsertItem(-text => $node, -parent = +> $parent_node); hashref_to_treeview($$hashref{$node}, $treeview, $new_node); } }

However, I'm having trouble getting the data out of the database to look like the input up there to feed into hashref_to_treeview. I was able to replicate the behavior I would like with a nasty set of nested foreach loops, but after finishing it looked terrible to maintain and decidedly un-perl-ish. I've summarized the flow below in pseudo-perl.

my $id = 1; my $data = {}; my $table1_results = $dbh->selectall_arrayref('SELECT field1 FROM tabl +e1 WHERE id = ?', {Slice => {}}, $id); foreach my $field1 (@$table1_results) { $data->{$id}->{$table1_results->{field_of_interest}} = undef; my $table2_results = $dbh->selectall_arrayref('SELECT field2 FROM +table2 WHERE field1 = ?', {Slice => {}}, $field1->{field1}); foreach my $field2 (@$table2_results) { $data->{$id}->{$table1_results->{field_of_interest}}->{$table2 +_results->{field_of_interest}} = undef; ... } }

I set up a slightly less ugly set of joins on the tables in question to return the values like this:

parent child1 child2 child3 -------- -------- -------- -------- value1 value2 value3 value4 value1 value2a value3 (null) ...

This seems a bit easier since the SQL changes for each level of recursion which I'd have to deal with in the function. The join's output could be returned with DBI's selectall_arrayref and then I can just recurse through each array. But I've gotten stuck on how to make that data look like the structure above. My most recent attempt looked something like this:

sub recursion_test { my $array = shift; my @results; while(@$array > 1){ push @results, recursion_test($array); } return [$$array[0], undef]; }

Which doesn't work as well as I'd hoped and leads me to my question: How can I return data structures through recursion so I can build the hash above? Also, any other suggestions for a more painless way to do this would be welcomed!

Thanks in advance for your help!

Comment on Generating a Hash of Hashes Recursively to Display Database Hierarchy
Select or Download Code
Re: Generating a Hash of Hashes Recursively to Display Database Hierarchy
by ikegami (Pope) on Jun 22, 2009 at 22:14 UTC

    If you're ok with changing

    return unless ref($hashref) eq 'HASH';

    to

    return unless keys %$hashref;

    then you can use the following:

    sub treeify { my ($sth) = @_; my %root; my %children; while (my $row = $sth->fetch()) { my ($id, $parent_id) = @$row; my $parent = ( defined($parent_id) ? $children{$parent_id} ||= {} : \%root ); $parent->{$id} = $children{$id} ||= {}; } return \%root; }

    Test:

    { my $sponge = DBI->connect( 'dbi:Sponge:', '', '', { RaiseError => 1 } ); my $sth = $sponge->prepare( 'SELECT id, parent_id FROM Table', { NAME => [qw( id parent_id )], rows => [ [ a => undef ], [ b => 'a' ], [ d => 'c' ], [ c => 'b' ], [ e => 'a' ], ], } ); my $tree = treeify($sth); use Data::Dumper; print Dumper $tree; }

    Output:

    $VAR1 = { 'a' => { 'e' => {}, 'b' => { 'c' => { 'd' => {} } } } };

      Thanks ikegami! Unfortunately the database I'm dealing with doesn't quite let me simplify down to just parent-child IDs. The join I mentioned above is between about 10 tables, all with distinct sets of IDs, so the result of the join, as retrieved by selectall_arrayref looks like:

      my $data = [ [ 'parent1', 'child1a', 'child2a', undef, ], [ 'parent1', 'child1b', 'child2b', 'child3b',], [ 'parent1', 'child1c', undef, undef,], ];

      While playing with your solution, I got really close to what I need:

      my @results; foreach my $row (@$data) { push @results, treeify(@$row); } print Dumper @results; sub treeify { my @list = @_; my $node = shift @list; return {} unless $node; return {$node => treeify(@list)}; }

      Which yields:

      $VAR1 = { 'parent1' => { 'child1a' => { 'child2a' => {} } } }; $VAR2 = { 'parent1' => { 'child1b' => { 'child2b' => { 'child3b' => {} } } } }; $VAR3 = { 'parent1' => { 'child1c' => {} } };

      Which sort of brings me back to my original query, figuring out how to merge those three hashes.

      Any thoughts?

        I dare say your join is broken and that's what should be fixed. But it's easy to work with it anyway.

        You have:

        my $data = [ [ 'parent1', 'child1a', 'child2a', undef, ], [ 'parent1', 'child1b', 'child2b', 'child3b',], [ 'parent1', 'child1c', undef, undef,], ];

        You want:

        my $data = [ [ 'parent1', 'child1a' ], [ 'parent1', 'child2a' ], [ 'parent1', 'child1b' ], [ 'parent1', 'child2b' ], [ 'parent1', 'child3b' ], [ 'parent1', 'child1c' ], ];

        Easy! Change

        while (my $row = $sth->fetch()) { my ($id, $parent_id) = @$row; ... }

        to

        while (my $row = $sth->fetch()) { my ($parent_id, @children_ids) = @$row; for my $id (grep defined, @children_ids) { ... } }

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (6)
As of 2014-11-24 01:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (135 votes), past polls