遍历目录树 - Unicode 模式

Posted 2020-10-24 catgatp

1. =info
2.     遍历目录树 支持 Unicode
3.     Code by [e-mail]
4.     2017-03
5.    
6.     V0.5 使用Win32API判断目录硬链接
7. =cut
8.  
9. use utf8;
10. use Encode;
11. use Win32API::File qw(GetFileAttributesW FILE_ATTRIBUTE_REPARSE_POINT);
12. use Win32::Unicode;
13. use IO::Handle;
14. STDOUT->autoflush(1);
15. binmode(STDOUT, ‘:encoding(gbk)‘);
16.  
17. our $n_files = 0;
18. our $n_dirs = 0;
19.  
20. my $path = "D:/Extra";
21. func($path, 0);
22.  
23. print $n_files ,"\n";
24. print $n_dirs;
25.  
26. sub func
27. {
28.     my ($path, $lv) = (shift, shift);
29.     my $wdir = Win32::Unicode::Dir->new;
30.     my $code;
31.     my $next_path;
32.  
33.     $wdir->open( $path );
34.     if ( $wdir->error() =~ /找不到/ )
35.     {
36.         print $wdir->error();
37.         exit;
38.     }
39.  
40.     while ( my $f = $wdir->read() )
41.     {
42.         if ( file_type(‘f‘, $path. "/" .$f ) )
43.         {
44.             print "    "x$lv . "$f\n";
45.             $n_files++;
46.         }
47.  
48.         next if ($f eq ".");
49.         next if ($f eq "..");
50.  
51.         $next_path = $path. "/" .$f;
52.  
53.         if ( file_type(‘d‘, $next_path ) )
54.         {
55.             $n_dirs++;
56.             print "    "x$lv . "$f\n";
57.             $code = GetFileAttributesW( encode(‘utf16-le‘, $next_path) ."\x00\x00" );
58.  
59.             if ( isLink( $code ) ) { print "skip symbolic link: $f\n"; }
60.             else                   { func( $next_path,  $lv+1 );       }
61.         }
62.  
63.     }
64. }
65.  
66. sub isLink
67. {
68.     return ($_[0] & FILE_ATTRIBUTE_REPARSE_POINT) == FILE_ATTRIBUTE_REPARSE_POINT ?
69.             1 : 0;
70. }