动网论坛,站长建站首选,国内使用量最多的论坛软件 动网论坛官方技术讨论区 站长工具 申请属于您自己的免费论坛
首页 | 新闻资讯 | 网站运营 | 网络编程 | 数据库 | 服务器 | 网页设计 | 图像媒体 | 网络应用 | 搜索优化 | 资源下载 | 动网主机
    本站内  互联网 ASP论坛  ASP.Net论坛  PHP论坛
   Cgi/Perl → 阅读文章

 perl的建树算法

作者来源: 
阅读 1727 人次 , 2006-4-19 17:59:00 

=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;
  
 本文Tags算法  
 收藏本文  打印本文  论坛讨论  关闭窗口
· 上一篇:mod_perl 编程的简单介绍
· 下一篇:用 Perl 进行 GNOME 编程
· Cgi入门教程之:8 脚本解释
· Cgi入门教程之:10 email子过程
· 跟我学Perl(7)
· CGI 中常用文件数据运算符
· Cgi入门教程之:1 Unix环境


关于本站 | 联系我们 | 业务合作 | 客户案例 | 诚聘英才 | 广告合作 | 收藏本站
海口动网先锋网络科技有限公司版权所有
Copyright © 2000 - 2006 Cndw.Com
中华人民共和国电信与信息服务业务经营许可证编号 琼 ICP 020077