2
votes

i am trying to build a tree-like nested data structure from the dbix::class resultset. The problem is that when it comes to elements deeper than 1 level, i get the exception:

Can't use string ("") as a HASH ref while "strict refs" in use at /home/romel/apps/myapp/script/../lib/MyApp/Products.pm line 38

The code contains two subroutines:

sub _findparent {

my ($tree, $pid) = @_;

     if (my ($parent) = grep { $_->{'id'} == $pid } @$tree) {
         say "found parent $parent->{'id'} = $pid ($parent->{'name'})";
         $parent->{'children'} = [] if (ref $parent->{'children'} ne 'ARRAY');
         return $parent;
     } else {
         for my $i (@$tree) {
             say "traversing $i->{'name'} $i->{'id'}";
             _findparent($i->{'children'}, $pid) if (ref $i->{'children'} eq 'ARRAY');|
         }
     }
 }

sub index {
     my $self = shift;

     my @data = $self->db->resultset('Category')->search();

     my @tree;

     for my $i (@data) {
         my $i = $i->get_column_data;


         if (my $parent_id = $i->{'parent_id'}) {

             say "--- $i->{'name'} has parent (id $parent_id), searching";

             #if (my $parent = _findparent(\@tree, $parent_id)) { 
             #    push ($parent->{'children'}, $i);
             #}

             push (_findparent(\@tree, $parent_id)->{'children'}, $i);
         } else {
             $i->{'children'} = [];
             push (@tree, $i);
             say "adding \"$i->{name}\" to tree as root";
        }
    }

     $self->render(menudata => [@tree]);
}

The @tree dumped using Data::Printer:

[
    [0] {
        children      [
            [0] {
                children      [],
                created_on    undef,
                id            2,
                modified_on   undef,
                name          "children 1 level",
                parent_id     1,
                position      undef,
                user_id       undef
            }
        ],
        created_on    undef,
        id            1,
        modified_on   undef,
        name          "parent category one",
        parent_id     undef,
        position      undef,
        user_id       undef
    },
    [1] {
        children      [
            [0] {
                children      [],
                created_on    undef,
                id            4,
                modified_on   undef,
                name          "children 1 level 2",
                parent_id     3,
                position      undef,
                user_id       undef
            },
            [1] {
                children      [],
                created_on    undef,
                id            5,
                modified_on   undef,
                name          "children 1 level 3",
                parent_id     3,
                position      undef,
                user_id       undef
            },
            [2] {
                created_on    undef,
                id            12,
                modified_on   undef,
                name          "children 1 level 4",
                parent_id     3,
                position      undef,
                user_id       undef
            }
        ],
        created_on    undef,
        id            3,
        modified_on   undef,
        name          "parent category two",
        parent_id     undef,
        position      undef,
        user_id       undef
    }
]

And finally the table structure:

+-------------+-------------+------+-----+---------+----------------+
| Field       | Type        | Null | Key | Default | Extra          |
+-------------+-------------+------+-----+---------+----------------+
| id          | int(11)     | NO   | PRI | NULL    | auto_increment |
| name        | varchar(45) | YES  |     | NULL    |                |
| user_id     | int(11)     | YES  | MUL | NULL    |                |
| created_on  | datetime    | YES  |     | NULL    |                |
| modified_on | datetime    | YES  |     | NULL    |                |
| position    | varchar(45) | YES  |     | NULL    |                |
| parent_id   | varchar(45) | YES  |     | NULL    |                |
+-------------+-------------+------+-----+---------+----------------+

Line 38 is a

push (_findparent(\@tree, $parent_id)->{'children'}, $i);

So the _findparent doesn't return anything for nested elements deeper than one level.

1
You don't have an explicit return in the else branch of _findparent. Figure out what you actually want to return in that case, and make it explicit. - amon
Thanks. But what if i don't want to return anything there, just perform another search using grep one level deeper? - romel
Sure you do: You want to return the appropriate parent node. You also don't handle the case that the ID isn't present anywhere in the tree. Do you have prior experience working with tree data structures, and recursive functions? - amon
Okay, i revised the code and you're absolutely right. Thank you. - romel

1 Answers

3
votes

Your problem is that _findparent doesn't return a usable value if the ID isn't found in the 1st level. Let's take a look at the else branch:

sub _findparent {

    my ($tree, $pid) = @_;

     if (my ($parent) = grep { $_->{'id'} == $pid } @$tree) {
         ...
     } else {
         for my $i (@$tree) {
             say "traversing $i->{'name'} $i->{'id'}";
             _findparent($i->{'children'}, $pid) if (ref $i->{'children'} eq 'ARRAY');|
         }
     }
 }

If you don't use an explicit return, the value of the last statement is returned – here a loop. A loop does not have a useful return value, so you shouldn't use it.

Instead, pass on a useful return value from a lower level:

sub _findparent {

    my ($tree, $pid) = @_;

     if (my ($parent) = grep { $_->{'id'} == $pid } @$tree) {
         ...
     } else {
         for my $i (@$tree) {
             say "traversing $i->{'name'} $i->{'id'}";
             next if not ref $i->{children} eq 'ARRAY';
             my $parent = _findparent($i->{'children'}, $pid);
             return $parent if defined $result;
         }
         return;  # return undef if nothing was found
     }
 }

...
# put the return value in a variable
my $parent = _findparent(...);
# check if the operation was successful
if (not defined $parent) {
  die "Tried to find the parent for $id, but there was no matching parent";
}
# if so use the value
push @$parent, ...;

The check can be abbreviated to:

my $parent = _findparent(...) // die "...";

which uses the // defined-or operator.