[ic] recursive perl subroutine

[interchange-users@icdevgroup.org (Bill Carr)]

On Tue, 2002-09-03 at 13:27, John Allman wrote:
> hi - i'm trying to trace through a reasonably shallow category tree to 
> find if a product fits into a particular category. i want a function to 
> return 0 if the products category, or it's category's category etc is 
> equal to the WCODE variable defined in catalog.cfg and 0 otherwise (0 
> being the root node of the tree).
> 
> the function below is an effort to do that. if i try calling 
> checktree(0) it returns 1 as requested and if i try calling 
> checktree(200) it returns 0 (the value of WCODE is 200). so far so good.
> 
> if i try checktree(201) it doesn't seem to return anything. the entry in 
> cattable with code 201 has pcode 200. checktree should recursively pass 
> the value of pcode until it hits 200 or 0 (it is guaranteed to hit one 
> or the other) i have gotten it to return $pcode instead of 
> checktree($pcode) and it returns 200 which is correct. but it doesn't 
> seem to like passing $pcode back into itself.
> 
> error.log contains no errors. checktree is defined inside a [perl] block 
>   in a page.
> 
> the tree looks something like this
> 			0
> 			|
> 		-----------------
> 		|		|
> 		200		other numbers
> 		|
> 	-----------------
> 	|		|
> 	201		other numbers
> 
> code is the identifier for the node and pcode is the identifier for its 
> parent node.
> 
> sub checktree {
>                          my ($catcode)=@_;
>                          if($catcode == 0)
>                          {
>                                  return 1;
>                          }
>                          elsif($catcode == $Variable->{WCODE})
>                          {
>                                  return 0;
>                          }
>                          else
>                          {
>                                  $db = $Db{cattable};
>                                  $sql = "select pcode from cattable 
> where pcode=".$catcode;
>                                  $parent = $db ->query({sql => "select 
> pcode from cattable where code=".$catcode});
>                                  $row = shift (@$parent);
>                                  ($pcode) = @$row;
>                                  return checktree($pcode);
>                          }
> }
> 
> is there something built into interchange to stop recursive calls? or is 
> there a syntax error in my code (i in no way claim to be a perl expert)?
> 
> thanks in advance!
Here is a user tag a made for doing something similar. It's a little
more complicated because I have a cat_item_index table so that an item
may be part of multiple categories.

UserTag incat Order itemid catid
UserTag incat Routine <<EOR
  sub {
        my ($itemid, $catid) = @_;
        unless ($itemid) {
      		&Log("No itemid given.");
      		return;
    	}
        unless ($catid) {
      		&Log("No catid given.");
      		return;
    	}
        my $dbh = # GET YOU DB HANDLE IN SOME WAY
        unless ($dbh) {
          &Log("Unable to get DB handle");
          return;
        }
    my $sql = qq{SELECT i.catid, cii.catid FROM items i LEFT JOIN
cat_item_index cii USING(itemid) WHERE i.itemid=$itemid};
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    while (my $row = $sth->fetch) {
      return 1 if $row->[0] == $catid || $row->[1] == $catid;
      push my @parents, &get_parents($row->[0]),
&get_parents($row->[1]);
      for (@parents) {
         return 1 if $catid == $_;
      }
    }
        return;

        sub get_parents {
          my $catid = shift;
          return unless $catid;
          my $sql = qq{SELECT parent FROM cat_parent_index WHERE
catid=$catid};
          my $sth = $dbh->prepare($sql);
          $sth->execute();
          my @out;
          while (my $row = $sth->fetch()) {
                push @out, $row->[0], &get_parents($row->[0]);
          }
          return @out;
        }
  }
EOR

-- 
Bill Carr
Worldwide Impact
bill@worldwideimpact.com
413-253-6700