perl的建树算法

=pod
=item

  @result=();
  $ldap_root="NTA::ou1";
  push @result,"NTA::ou1::ou2::ou3";
  push @result,"NTA::ou1::ou2::ou4";

  push @result,"NTA::ou1::ou5::ou6";
  push @result,"NTA::ou1::ou5::ou6::o8";
  push @result,"NTA::ou1::ou5::ou6::o9";
 
  push @result,"NTA::ou1::ou5::ou7";
  push @result,"NTA::ou1::ou5::ou7::t";
  push @result,"NTA::ou1::ou5::ou7::t::y";
  push @result,"NTA::ou1::ou5::ou7::t::y::u";

  push @result,"NTA::ou1::ou6::ou8";
  push @result,"NTA::ou1::ou6::ou8::ji";
  push @result,"NTA::ou1::ou6::ou8::ji::jk";
  push @result,"NTA::ou1::ou6::ou9::j";
  push @result,"NTA::ou1::ou6::ou9::g";
=cut

########################################################
sub recusive_ldap{
 my %param=@_;
 my $left_list =$param{left_list}; # a array to put the left string in,use @$ to use it
 my $left =$param{left};
 my $right =$param{right},
 my $r_ldap_array=$param{r_ldap_array}; # use $$ to use this ref
 my $r_rid =$param{r_rid}; #use $$ to use it
 my $prefix =$param{prefix};

 FIND_DIFF:

 my @found=();

 my $current_group;

 my @merge_list=();
 
 my $diff_group_idx=-1;
 
 my $found_new_group=0;#begin a new match
 my $matched_new_group=0;
 my $begin_match=0;
 my ($left_idx,$right_idx);

 my $blank_item=0;

CURR: for(my $i=$left;$i<$right;$i++){

  if( @$left_list[$i] ne ''){
  @$left_list[$i]=~/::/;
  $current_group=$';

   if($current_group=~/::/){
    $current_group=$`;

   }

  }
  
  else{#last node  impossible to be a father nodwa
  $current_group=undef;
  $blank_item++;

  next CURR; # get next item
  }

  
  if (scalar @found== 0){ #first item

   if(defined $current_group){
    $begin_match=1;
    push @found ,$current_group  ;
    $diff_group_idx++;
    $left_idx=$i ;

    if(  (scalar @found ==1)  &&   ($i==$right-1)  ){
     my $merge={};
     $merge->{left}=$left+$blank_item;
     $merge->{right}=$i+1;
     push @merge_list,$merge;#storage the merge of the current node
    }

   }
   next CURR;

  }
  
  else { #matched a group and meet a new grp

   if($current_group ne $found[$diff_group_idx]){# a new node
    
    push @found ,$current_group;

    $left_idx=$i if $begin_match;

    $begin_match=0;
    $diff_group_idx++;
    $right_idx=$i;
    
    
    if(scalar @found==2){

     my $merge={};
     $merge->{left}=$left+$blank_item;
     $merge->{right}=$i;
     push @merge_list,$merge;#storage the merge of the current node

    }
    else{
     my $merge={};
     $merge->{left}=$left_idx;
     $merge->{right}=$i;
     push @merge_list,$merge;#storage the merge of the current node

      
    }

    if ($i==$right-1){ #last match
     my $merge={};
     if(scalar @found >1){
     $merge->{left}=$right_idx;
     }
     else {
      $merge->{left}=$left+$blank_item;
     
     }
     $merge->{right}=$i+1;
     push @merge_list,$merge;#storage the merge of the current node

    }

 

    $left_idx=$i;

   }

   else{ # continue to match the same father node
    if ($i==$right-1){ #last matcha
     my $merge={};
     
     if(scalar @found ==1){
      $merge->{left}=$left+$blank_item;
     }
     else{
      $merge->{left}=$right_idx;
     }
     
     $merge->{right}=$i+1;
     push @merge_list,$merge;#storage the merge of the current node
     
    }
   }

 

 

  }
 }# find all grps(different)
 

 return if scalar @found==0;
 my $rid=0;
 my $blank=[];
 my $current;
 my @g_array;

# print Dumper $left_list;
# print Dumper /@merge_list;

CREATE_NODE: 
 for(my $diff_grp=0;$diff_grp<scalar  @found; $diff_grp++){ #every different node

  my @ldgArray=();

  my $cur_grp=$found[$diff_grp];

   my $reg="::".$cur_grp;

   $reg=reg_encode($reg);

  for(my  $gidx=$merge_list[$diff_grp]->{left};
   $gidx<$merge_list[$diff_grp]->{right}; $gidx++){
   
   @$left_list[$gidx] =~s/^$reg//;# stript out this item
  }

  my $new_prefix= $prefix.$cur_grp."::";

  my $new_cap= $prefix.$cur_grp;

  if( $merge_list[$diff_grp]->{left}== $merge_list[$diff_grp]->{right}){
   my $item=_creat_node('gx_l'.$$r_rid,$cur_grp,0,1,'','edit_group.cgi?name='.$new_cap."&m_i=gxl_$$r_rid");
   $$r_rid++;

   push @$r_ldap_array,$item; # put the new node to the container

  }
  else{
  
   &recusive_ldap(
   left_list =>$left_list,
   left  =>$merge_list[$diff_grp]->{left} ,
   right  =>$merge_list[$diff_grp]->{right},
   r_ldap_array =>/@ldgArray,
   r_rid  =>$r_rid,
   prefix  =>$new_prefix
   );

   my $item=_creat_node('gx_l'.$$r_rid,$cur_grp,1,1,/@ldgArray,'edit_group.cgi?name='.$new_cap."&m_i=gxl_$$r_rid");
   
   $$r_rid++;

   push @$r_ldap_array,$item; # put the new node to the container
  }

 }  

};

 

############################################################################################
sub _creat_node{ #create a node of a menu tree
 my $node={};
 
# print "add";
#essential field

#$node->{'name'}=Translate shift;
 $node->{'name'}=shift;
 $node->{'info'}->{'text'}=shift;

#info field
 $node->{'info'}->{'isparent'}=shift;
 $node->{'info'}->{'linkout'}=shift;

#extra field

#if  is parent this field shouldn't be ''

# this parameter can be a single node or an array of node
 $node->{'children'}=shift;# default a ref to array

#if  the menu linkout this field shouldn't be blank
 $node->{'info'}->{'url'}=shift;

 if ($node->{'children'} ne ''){

  if((ref $node->{'children'}) ne "ARRAY"){ # it's a hash ref
  my @ar;
  push @ar, $node->{'children'};
  $node->{'children'}=/@ar;
  }
  else{
  }
 }
 else{ #if a blank is pass to a 'children' field delete this field
 delete $node->{'children'};
 }

 return $node;
}

1;