Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
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
Replies are listed 'Best First'.
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 romping around the Monastery: (12)
As of 2015-07-28 07:14 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 (252 votes), past polls