[Perl]全盘查找重复的目录

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 333
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 29 times
Been thanked: 22 times
联系:

[Perl]全盘查找重复的目录

帖子 #1 523066680 » 2017年01月19日 15:10

占用

头像
523066680
Administrator
Administrator
帖子: 333
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 29 times
Been thanked: 22 times
联系:

将目录树结构转为 Perl 哈希(键值对)结构

帖子 #2 523066680 » 2017年01月19日 15:12

思路,将文件夹目录结构转为哈希结构,借用 Perl 的 dump 函数直接输出某一节点下的所有"子节点"信息。
然后将 Dump 出来的信息转为 MD5 校验值,这样无需做大量的存储也能进行对比。

d69c12204cb2ec0313843e44c3990420 C:\MinGW
c538d379fc40d593e988477c1cc325d5 C:\NVIDIA
b1705da1f745931c29e722d5418bb104 C:\Perl
3b17d11edd2df48e306076c13c04ba91 C:\Perl\html\lib\YAML
f1f6a1e9ec6ea63004fd66233b15b778 C:\Perl\html\lib\ActivePerl\DocTools


Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. =info
  2.     Code by 523066680@163.com
  3.     2017-01
  4. =cut
  5.  
  6. # 备注,可能遇到 Unicode 文件名路径,
  7. # 暂时使用系统 cmd /U /c dir 生成路径列表
  8.  
  9. use Encode;
  10. use IO::Handle;
  11. use Data::Dump qw/dump dd/;
  12.  
  13. our $hash = {};
  14. my $gstr;
  15.  
  16. {
  17.     local $/ = "\x0d\x00\x0a\x00";
  18.  
  19.     print "getting file lists ...\n";
  20.     @files = `cmd /U /c dir /s /b C:\\MinGW`;
  21.  
  22.     print "Deal ...\n";
  23.     for my $n ( 0 .. $#files )
  24.     {
  25.         $files[$n] =~s/\x0d\x00\x0a\x00//;
  26.         $gstr = encode('gbk', decode('utf16-le', $files[$n]));
  27.         toStruct( $gstr );
  28.     }
  29. }
  30.  
  31. #举个栗子
  32. dd( $hash->{'C:'}{'MinGW'}{'include'}{'boost'}{'accumulators'} );
  33.  
  34. sub toStruct
  35. {
  36.     my $path = shift;
  37.     my @parts = split(/[\/\\]/, $path);
  38.     my $ref;
  39.     $ref = $hash;
  40.  
  41.     grep
  42.     {
  43.         $ref->{$_} = {} unless ( exists $ref->{$_} );
  44.         $ref = $ref->{$_};
  45.     }
  46.     @parts;
  47. }


输出示例(部分):
getting file lists ...
Deal ...
{
"accumulators.hpp" => {},
"accumulators_fwd.hpp" => {},
"framework" => {
"accumulator_base.hpp" => {},
"accumulator_concept.hpp" => {},
"accumulator_set.hpp" => {},
"accumulators" => {
"droppable_accumulator.hpp" => {},
"external_accumulator.hpp" => {},


缺点是用了大量空格作为缩进,处理庞大的目录树时内存暴涨。

头像
523066680
Administrator
Administrator
帖子: 333
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 29 times
Been thanked: 22 times
联系:

Perl 遍历磁盘文件并筛选出内容相同的目录

帖子 #3 523066680 » 2017年01月19日 15:50

备注:
  1. 使用过程将在 D 盘生成 dirs.txt 和 md5map.txt,dirs.txt 为dir输出结果(Unicode),
    md5map为所有目录的校验值
  2. 使用cmd /U /c 执行 dir 命令以确保Unicode字符的完整输出
  3. 使用 YAML::Tiny Dump 替代 Data::Dump,减少结构体输出的体积
  4. 内存占用情况:如果 dir 导出的文件大小为 100MB,则内存占用约为 250MB
  5. 冗余信息的处理:
    假设某个目录存在副本,且子目录下也存在副本

    代码: 全选

    ├─Fold
    │  ├─a
    │  └─a - 副本
    └─Fold - 副本
        ├─a
        └─a - 副本

    程序将只显示 fold 这一层的结果。但是,如果在副本的中间某一层存在差异,则会详尽地列出相同的子目录

  6. 效率:个人PC(双核4G旧主机蓝标硬盘),dir /a /s /b D: ,254506 行数据, 从 dir 到 Perl 输出判断结果
    耗时 58 秒
  1. =info
  2.     Code by 523066680@163.com
  3.     2017-01
  4. =cut
  5. use Encode;
  6. use IO::Handle;
  7. use Digest::MD5 qw/md5_hex/;
  8. use YAML::Tiny;
  9. STDOUT->autoflush(1);
  10.  
  11. print "Dir ...\n";
  12. #system("cmd /U /c dir /a /s /b C:\\ >D:\\dirs.txt");
  13.  
  14. print "Data dealing ...\n";
  15. our $hash = {};
  16. our @lines;
  17. our %fold_md5;
  18. our %md5map;
  19. my $gstr;
  20.  
  21. open READ,"<:raw",'D:\\dirs.txt';
  22. {
  23.     local $/ = "\x0d\x00\x0a\x00";
  24.     while ($line = <READ>)
  25.     {
  26.         $line =~s/\x0d\x00\x0a\x00//;
  27.         $gstr = encode('gbk', decode('utf16-le', $line));
  28.         push @lines, $gstr;
  29.         toStruct( $gstr );
  30.     }
  31. }
  32. close READ;
  33.  
  34. print "Compare ...\n";
  35. compare();
  36.  
  37. sub compare
  38. {
  39.     my @parts;
  40.     my $ref;
  41.     my $md5;
  42.  
  43.     print "Getting md5 information ...\n";
  44.     open WRT, ">:raw", "D:\\md5map.txt";
  45.     for my $i ( 0 .. $#lines )
  46.     {
  47.         @parts = split(/[\/\\]/, $lines[$i]);
  48.         $ref = $hash;
  49.         grep { $ref = $ref->{$_} } ( @parts );   #将引用迭代到路径的最后一层
  50.         next if (! keys %{$ref} );               #如果没有下一层文件内容则略过
  51.        
  52.         $md5 = md5_hex( Dump($ref) );
  53.         $fold_md5{ $lines[$i] } = $md5;
  54.  
  55.         print WRT $md5 ." ". encode('utf8', decode('gbk', $lines[$i])) ."\n";
  56.     }
  57.     close WRT;
  58.  
  59.  
  60.     for my $k ( keys %fold_md5 )
  61.     {
  62.         $md5 = $fold_md5{$k};
  63.         push @{ $md5map{$md5} }, $k;
  64.     }
  65.  
  66.     #去重,如果一组MD5内容相同的目录,且它们上一级目录的MD5也相同
  67.     #则无需列出。
  68.     print "Cut repeat case ...\n";
  69.     my $tp;
  70.     my $prev;
  71.     for my $m ( keys %md5map )
  72.     {
  73.         if ( $#{$md5map{$m}} > 0  )
  74.         {
  75.             undef $md5;
  76. ST:         for my $p ( @{ $md5map{$m} } )
  77.             {
  78.                 #取得上一层路径
  79.                 $tp = $p;
  80.                 $tp =~ s/(\\|\/)[^\\\/]+$//;
  81.  
  82.                 if (    ( defined $md5 )
  83.                     and ( $md5 eq $fold_md5{$tp} ) #MD5相同
  84.                     and ( $prev ne $tp )           #并且不是相邻目录
  85.                     #例如 "Fold\a" "Fold\a副本" 的上一级都是 Fold,md5一致
  86.                 )
  87.                 {
  88.                     delete $md5map{$m};
  89.                     last ST;
  90.                 }
  91.                 else
  92.                 {
  93.                     $md5 = $fold_md5{$tp};
  94.                 }
  95.                 $prev = $tp;
  96.             }
  97.         }
  98.         else
  99.         {
  100.             #删除没必要列出的情况
  101.             delete $md5map{$m};
  102.         }
  103.     }
  104.  
  105.     print "Find same folder\n";
  106.     for my $k ( keys %md5map )
  107.     {
  108.         print join("\n", @{$md5map{$k}} );
  109.         print "\n";
  110.         #dump_byPath( $md5map{$k}->[0] );
  111.         print "\n";
  112.     }
  113. }
  114.  
  115. sub dump_byPath
  116. {
  117.     my $path = shift;
  118.     my $ref = $hash;
  119.     for my $e ( split(/[\/\\]/, $path) )
  120.     {
  121.         $ref = $ref->{$e};
  122.     }
  123.     print Dump( $ref );
  124. }
  125.  
  126. sub toStruct
  127. {
  128.     my $path = shift;
  129.     my @parts = split(/[\/\\]/, $path);
  130.     my $ref;
  131.     $ref = $hash;
  132.  
  133.     for my $e ( @parts )
  134.     {
  135.         if ( not exists $ref->{$e} ) #如果不加判断,会不断地替换,最后只有一个路径的结构
  136.         {
  137.             $ref->{$e} = {};
  138.         }
  139.         $ref = $ref->{$e};
  140.     }
  141. }


回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客