大きなサイズのファイルを探すPerlスクリプト

最近動画などを編集していて、 HDD が圧迫されつつあるので、要らない巨大ファイルを発見するためのスクリプトを書いてみた。

ディレクトリツリーを再帰的に辿ってツリー全体のサイズを集計する機能と、ディレクトリツリー内でトップ20までの大きさのファイルをリストアップする機能がある。

動画を編集していると中間ファイルもやたらとデカいので、GB単位で空き容量が消えていく。中間ファイルは最終的には必要ないので消せば良いのだが、消すことを忘れていたり、消していいファイルであるか否かを忘れていたりする。そんな中でディスクを多く消費しているファイルからチェックしていけば作業効率が良いので、こんなものを作ってみたわけである。

コマンドライン上で引数を与えないとカレントディレクトリを、引数を与えるとそのディレクトリをチェックする。深いディレクトリツリーの探索にはそれなりに時間がかかる。また、最後にサイズでソートするので処理中にはアウトプットされず、終了時にまとめてリストが出力される。

例：
perl lif.pl
perl lif.pl C:\some\directory\path


出力例：

Directory list in perl:
       0.434:   perl/sucren.pl
       1.752:   perl/lif.pl
       2.918: d perl/.svn
       5.104: d .

Top 20 largest single files:
       0.002: perl/.svn/format
       0.232: perl/.svn/all-wcprops
       0.434: perl/sucren.pl
       0.434: perl/.svn/text-base/sucren.pl.svn-base
       0.521: perl/.svn/entries
       1.729: perl/.svn/text-base/lif.pl.svn-base

尚、単位はKBである。

Windows では動作したが、他のプラットフォームでどうなるかはテストしていない。
Perl のバージョンは 5 以上。

書きなぐったスクリプトなので実行効率の点ではあまりよくないかもしれない。もし使う上で気に入らないなら、スクリプトなので好きなようにいじっちゃってください。あと、使ったために起こった損害については責任持てませんよ。

#!/usr/local/bin/perl
## lif - a disk space usage analyzer.
## Examines size of all files under given directory, sum up and
## sort by size.
## The largest single files under given directory are listed also.
use strict;
use warnings;

my $maxtops = 20; # Top # of largest single files to list

my $dir = ".";
if(0<=$#ARGV){
	$dir = $ARGV[0];
	print "DIR = $dir\n";
}

my @dirs = ();
my @tops = ();
my $i;
my @topnames = ();
my $total = sizestat($dir, 0);
my @sorted_dirs = sort @dirs;

print "Directory list in $dir:\n";
foreach $dir(@sorted_dirs){
	print $dir;
}
printf("%12.3f: d .\n", $total / 1000.);

splice(@tops,$maxtops+1,$#tops+1-$maxtops) if $maxtops <= $#tops;
print "\nTop $maxtops largest single files:\n";
for($i = $#tops; 0 < $i; $i--){
	printf "%12.3f: $topnames[$i]\n", $tops[$i] / 1000.;
}


sub sizestat;

sub sizestat{
	my $dir = $_[0];
	my $level = $_[1];
	opendir(DIR, $dir) || die "can't opendir $dir: $!";
	my @f = readdir(DIR);
	closedir DIR;
	my ($fi,$total);
	$total = 0;
	foreach $fi(@f){
		my ($fp,$fs);
		$fp = "$dir/$fi";
		next if !-e $fp;
		next if $fi eq "." || $fi eq "..";
		($fs) = (stat $fp)[7];
		if($fi ne "." && $fi ne ".." && -d $fp){
			$fs = sizestat $fp,$level+1;
		}
		if($level < 1){
			$dirs[$#dirs+1] = sprintf("%12.3f: %s $fp\n", $fs / 1000., -d $fp ? "d" : " ");
		}
		if(!-d $fp){
			my $j;
			for($j = 0; $j <= $#tops; $j++){
				if($tops[$j] < $fs){
					splice @tops,$j,0,$fs;
					splice @topnames,$j,0,$fp;
					last;
				}
			}
			if($#tops < $maxtops && $#tops < $j){
				$tops[$#tops+1] = $fs;
				$topnames[$#topnames+1] = $fp;
			}
		}
		$total += $fs;
	}
	return $total;
}