一区二区三区在线-一区二区三区亚洲视频-一区二区三区亚洲-一区二区三区午夜-一区二区三区四区在线视频-一区二区三区四区在线免费观看

腳本之家,腳本語言編程技術及教程分享平臺!
分類導航

Python|VBS|Ruby|Lua|perl|VBA|Golang|PowerShell|Erlang|autoit|Dos|bat|

服務器之家 - 腳本之家 - perl - fdupe 查找重復文件的Perl腳本代碼

fdupe 查找重復文件的Perl腳本代碼

2020-06-17 11:14perl教程網 perl

fdupe 是一個很小的 Perl 腳本,用來檢索指定目錄并找出其中重復的文件,該腳本是通過文件內容來識別是否重復文件,而非文件名。fdupe 無需其他 Perl 腳本支持,運行速度非常快

圖:

fdupe 查找重復文件的Perl腳本代碼

 

復制代碼 代碼如下:


#!/usr/bin/perl
#
# fdupe tool - finding duplicate files
#
# $Id: fdupe,v 1.7 2011/10/14 20:11:21 root Exp root $
#
# Source code Copyright (c) 1998,2011 Bernhard Schneider.
# May be used only for non-commercial purposes with
# appropriate acknowledgement of copyright.
#
# FILE :        fdupe
# DESCRIPTION : script finds duplicate Files.
# AUTHOR:       Bernhard Schneider <[email protected]>
# hints, crrections & ideas are welcome
#
# usage: fdupe.pl <path> <path> ...
#        find / -xdev | fdupe.pl
#
# how to select and remove duplicates:
#   redirect output to >file, edit the file and mark lines you
#   wish to move/delete with a preceding dash (-)
#   Use following script to delete marked files:
#   #!/usr/bin/perl -n
#   chomp; unlink if s/^-//;
#
# history:
# 12.05.99 - goto statment replaced with next
# 14.05.99 - minor changes
# 18.05.99 - removed confusing 'for $y'
#            included hash-search
# 20.05.99 - minor changes
# 02.03.00 - some functions rewritten, optimized for speed
# 10.01.01 - hint-fix by Ozzie |ozric at kyuzz.org|
# 05.03.02 - fixed hangups by reading block/char-Devices
# 08.09.11 - skips checking of hard links
# 14.10.11 - accept file names from stdin
#
#use strict; # uncomment for debugging

 

$|=1;
local (*F1,*F2); my %farray = (); my $statF1;

# ------------------------------
# traverse directories
sub scan ($) {
    my ($dir) = $_[0];
    opendir (DIR, $dir) or die "($dir) $!:$@";
    map {
          (-d) ? scan ($_) : push @{$farray{-s $_}},$_
             unless (-l or -S  or -p or -c or -b);
    } map "$dir/$_", grep !/^\.\.?$/, readdir (DIR); closedir (DIR);
}

# ------------------------------
# get chunk of bytes from a file
sub getchunk ($$) {
  my ($fsize,$pfname) = @_;
  my $chunksize = 32;
  my ($nread,$buff);

  return undef unless open(F1,$$pfname);

  $statF1 = [(stat  F1)[3,1]];
  binmode F1;
  $nread = read (F1,$buff,$chunksize);
  ($nread == $chunksize || $nread == $fsize) ? "$buff" : undef;

# ------------------------------
# compare two files
sub mycmp ($) {
  my ($fptr) = $_[0];
  my ($buffa, $buffb);
  my ($nread1,$nread2);
  my $statF2;
  my ($buffsize) = 16*1024;

  return -1 unless (open(F2,"<$$fptr"));

  $statF2 = [(stat  F2)[3,1]];

  return 0
   if ($statF2->[0] > 1 && $statF1->[1] == $statF2->[1]);

  binmode F2;
  seek (F1,0,0);

  do {  $nread1 = read (F1,$buffa,$buffsize);
     $nread2 = read (F2,$buffb,$buffsize);

     if (($nread1 != $nread2) || ($buffa cmp $buffb)) {
         return -1;
        }
  } while ($nread1);

  return 0;
}

# ------------------------------

print "collecting files and sizes ...\n";

if (-t STDIN) {
 $ARGV[0] = '.' unless $ARGV[0]; # use wd if no arguments given
 map scan $_, @ARGV;
} else { 
 while (<STDIN>)  {
  s癧\r\n]$鞍g;
  push @{$farray{-s $_}},$_
   unless (-l or -S  or -p or -c or -b);
 }
}

print "now comparing ...\n";
for my $fsize (reverse sort {$a <=> $b} keys %farray) {

  my ($i,$fptr,$fref,$pnum,%dupes,%index,$chunk);

  # skip files with unique file size
  next if $#{$farray{$fsize}} == 0;

  $pnum  = 0;
  %dupes = %index = ();

  nx:
  for (my $nx=0;$nx<=$#{$farray{$fsize}};$nx++) # $nx now 1..count of files
  {                                             # with the same size
 $fptr = \$farray{$fsize}[$nx];          # ref to the first file
    $chunk = getchunk $fsize,$fptr;
    if ($pnum) {
   for $i (@{$index{$chunk}}) {
         $fref = ${$dupes{$i}}[0];
      unless (mycmp $fref) {
            # found duplicate, collecting
         push @{$dupes{$i}},$fptr;
   next nx;
      }
   }
    }

    # nothing found, collecting
    push @{$dupes{$pnum}},$fptr;
    push @{$index{$chunk}}, $pnum++;
  }
  # show found dupes for actual size
  for $i (keys %dupes) {
    $#{$dupes{$i}} || next;
    print "\n size: $fsize\n\n";
    for (@{$dupes{$i}}) {
        print $$_,"\n";
    }
  }
}

close F1;
close F2;

 

延伸 · 閱讀

精彩推薦
  • perlperl pop push shift unshift實例介紹

    perl pop push shift unshift實例介紹

    perl的pop跟push操作數組的最右邊,shift跟unshift操作數組的最左邊 ...

    腳本之家4612020-06-10
  • perlperl常見問題集合之二

    perl常見問題集合之二

    哪些平臺上有 Perl?要到哪里去找? Perl的標準發行版(由 perl 發展小組負責維護)僅以原始碼形式發行。您可在 http: //www.perl.com/CPAN/src/latest.tar.gz處取得。這個檔...

    腳本之家2102020-05-29
  • perlPerl使用nginx FastCGI環境做WEB開發實例

    Perl使用nginx FastCGI環境做WEB開發實例

    這篇文章主要介紹了Perl使用nginx FastCGI環境做WEB開發實例,實現了路由系統和模板系統,需要的朋友可以參考下...

    Perl教程網2412020-06-18
  • perlperl use vars pragma使用技巧

    perl use vars pragma使用技巧

    perl 中的vars是perl中的一個pragma(預編譯指示符),專門用來預定義全局變量,這些預定義后的全局變量在qw()列表中,在整個引用perl文件中皆可使用,即便使...

    perl教程網6812020-06-16
  • perlPerl List::Util模塊使用實例

    Perl List::Util模塊使用實例

    這篇文章主要介紹了Perl List::Util模塊使用實例,本文給出掃描符合條件的某個列表并取出第一個符合條件的、求1到1000之間的和 、求一組數字的最大值與最小...

    腳本之家4712020-06-22
  • perlperl命令行參數內建數組@ARGV淺析

    perl命令行參數內建數組@ARGV淺析

    這篇文章主要介紹了perl命令行參數內建數組@ARGV淺析,本文重點在于講解@ARGV的用法,并通過實例來說明,需要的朋友可以參考下 ...

    perl教程網6162020-06-18
  • perlPerl從文件中讀取字符串的兩種實現方法

    Perl從文件中讀取字符串的兩種實現方法

    有時候我們需要從文件中讀取字符串,這里簡單介紹下, 需要的朋友可以參考下 ...

    腳本之家6252020-06-08
  • perlPerl的經典用法分享

    Perl的經典用法分享

    Perl的經典用法分享,學習perl的朋友可以參考下 ...

    腳本之家6562020-06-06
主站蜘蛛池模板: 欧美日韩精品一区二区三区视频在线 | 久久成人免费大片 | 啊好大好粗 | 久久偷拍免费2017 | 99热这里只有精品在线观看 | 久久视热频国产这里只有精品23 | 国产成人cao在线 | 大学第一次基本都没了 | 青青青国产精品国产精品久久久久 | 99视频全部看免费观 | 亚洲女性色尼古综合网 | 亚洲性视频在线观看 | 免费视频片在线观看大片 | 日韩精品一区二区三区中文在线 | 美女脱得一二净无内裤全身的照片 | 小小水蜜桃视频高清在线观看免费 | 91庥豆果冻天美精东蜜桃传媒 | 第一福利在线导航 | 国产视频福利 | 久久精品无码人妻无码AV蜜臀 | 美国大片成人性网 | 亚洲成人国产 | 女人和男人搞基 | 91午夜剧场| 91大神在线观看精品一区 | 国产小情侣自拍 | 美女露全身永久免费网站 | 国产精品久久国产精品99 gif | 韩国最新理论三级在线观看 | 呜嗯啊野战h呻吟男男双性 污小说在线阅读 | 无毒成人社区 | 99热这里只有精品在线 | 九九九九九九 | 禁止的爱善良的未删减版hd | 包臀裙女教师波多野结衣 | 亚洲精品久久啪啪网站成年 | 亚洲一区二区三区福利在线 | 亚洲 欧美 中文 日韩 另类 | 奇米影视7777久久精品 | 日韩精品视频福利资源站 | 国产精品亚洲片夜色在线 |