perl的建树算法
发表于:2007-06-11来源:作者:点击数:
标签:
=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 @resu
=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;