关于Perl递归遍历目录的文章其实很多,但是大多数都是针对本地机器磁盘间的操作,如将C盘根目录下的A文件夹整个拷贝到D盘根目录下的A文件夹。但是,对于将一个局域网内其他机器开放的文件共享目录递归遍历或者拷贝到本机上,又该怎么做呢?

     在解决这个问题之初,笔者也认为和一般的递归遍历程序没什么区别,从网上随便搜份源码即可。但是,在实际解决过程中,发现一个关键问题。

     首先看下一般的Perl目录递归程序是怎么做的:     



use 
    strict;

 
   sub 
    RecurTraversal{
    
   # 
   获取递归的目录 
   
 
       
   my 
     
   $root 
   = 
   $_ 
   [ 
   0 
   ]; 
    
   opendir 
    DH 
   , 
   $root 
    or  
   die 
     
   " 
   Can't open directory,information:$!!\n 
   " 
   ;
    
   my 
     
   @dirs 
   = 
   readdir 
    DH;
    
   foreach 
   ( 
   @dirs 
   ){
       
   if 
   ( 
   - 
   d){   
   # 
   if directory 
   
 
             
   print 
     
   $_ 
   . 
   " 
    is directory!\n 
   " 
   ;
         RecurTraversal( 
   $root 
   . 
   " 
   \\ 
   " 
   . 
   $_ 
   )  
   if 
   (not  
   /^ 
   ( 
   \.|\.\. 
   )$ 
   / 
   );
      }
       
   else 
   {     
   # 
   if file 
   
 
             
   print 
     
   $_ 
   . 
   " 
   is file!\n 
   " 
   ;
      }
   }      
    
   closedir 
    DH;
}



 

     从上述代码可以看出,在递归遍历的时候,一般在Perl中会通过-d检测选项来判断是否为目录(如if -d "C:\\Windows")。但是,对于通过文件共享出来的目录列表,这个检测选项则失去其往日的魅力,对于文件夹检测不出来(除了每个目录下隐藏的.和..,前者表示当前目录,后者表示上一级目录),一律当做文件处理!!!这个其实也能够理解,本地文件或者目录可以读取相应的信息,但是对于其他机器上开放的目录列表,出于安全考虑,我们想要获取更多的信息估计就会受到诸多的限制甚至获取不到。

     怎么办?上网可以发现貌似使用一些第三方模块如Win32::AdminMisc或者File::Find之类提供的递归遍历,但是你使用过会发现,这些模块其实都是针对本地磁盘间文件或文件夹传输的。所以,想解决这个问题,一种方法就是自己去判断是否为目录,添加一个自己的目录检测函数即可,如下:      



sub 
    CheckIfFolder{
   
   my 
     
   $name 
   = 
   $_ 
   [ 
   0 
   ];
   
   
   if 
   (  
   opendir 
    DH 
   , 
   $name 
   ){
      
   closedir 
    DH;
      
   return 
     
   1 
   ;
  }
   
   return 
     
   0 
   ;



 

     函数原理很简单,就是对于尝试以目录的形式打开,成功的话即为目录。

     呵呵,代码虽然简单,但是相信对于一些遇到类似问题的朋友会帮上一定的忙,至少省去了找第三方库或者一遍遍的检查是否是代码的问题。好,下面附上作者自己写的一个简单的目录拷贝的程序,希望对一些朋友能有所帮助:     



use 
    strict;

 
   my 
     
   $tool_server 
   = 
   " 
   \\\\10.204.16.2\\home\\Royen 
   " 
   ;

ReplacePerlFolder( 
   $tool_server 
   . 
   " 
   \\ 
   " 
   . 
   " 
   Perl 
   " 
   , 
   " 
   D:\\Perl 
   " 
   );

 
   sub 
    checkIfFolder{
   
   my 
     
   $name 
   = 
   $_ 
   [ 
   0 
   ];
   
   
   if 
   (  
   opendir 
    DH 
   , 
   $name 
   ){
      
   closedir 
    DH;
      
   return 
     
   1 
   ;
  }
   
   return 
     
   0 
   ;  
}

 
   # 
   to replace Perl Folder 
   
 
   sub 
    ReplacePerlFolder{   
    
   my 
     
   $src 
   = 
   $_ 
   [ 
   0 
   ];       
   # 
   source folder  
   
 
       
   my 
     
   $target 
   = 
   $_ 
   [ 
   1 
   ];    
   # 
   target folder  
   
 
       
    
   mkdir 
     
   $target 
     
   if 
   (not  
   - 
   e  
   $target 
   );   
    
   opendir 
    DH 
   , 
   $src 
    or  
   die 
     
   " 
   Can't Open $src,Information:$!!\n 
   " 
   ; 
   
    
   my 
     
   @dirs 
   = 
   readdir 
    DH;   
    
   foreach 
     
   my 
   $fd 
   ( 
   @dirs 
   ){      
         
   if 
   (checkIfFolder( 
   $src 
   . 
   " 
   \\ 
   " 
   . 
   $fd 
   )){   
   # 
   directory 
   
 
                   ReplacePerlFolder( 
   $src 
   . 
   " 
   \\ 
   " 
   . 
   $fd 
   , 
   $target 
   . 
   " 
   \\ 
   " 
   . 
   $fd 
   )  
   if 
   ( 
   $fd 
     
   !~ 
     
   /^ 
   ( 
   \.|\.\. 
   )$ 
   / 
   );
                
      }      
       
   else 
   {         
   # 
   file,copy directly 
   
 
            
   print 
     
   " 
   Copy $src\\$fd to $target\\$fd...\n 
   " 
   ;
        copy( 
   $src 
   . 
   " 
   \\ 
   " 
   . 
   $fd 
   , 
   $target 
   . 
   " 
   \\ 
   " 
   . 
   $fd 
   ); 
      }      
   }
    
   closedir 
    DH;  
  
}