zipで圧縮

Perl

CSのデモを整理のためにzip圧縮しようとしたら、220個ものデモを手動でぽちぽち圧縮するのはとんでもなく面倒な事に気づいて、コマンドラインで出来れば・・・と思ったので。
オレオレバッチ処理プログラミングは楽しい。それにしても久々に普通のプログラムをPerlで書いた。

#!/usr/bin/perl

# 
# aaa.bin => aaa.bin.zip みたいな感じに圧縮するなにか
# 
# usage: perl thisprogram.pl {targetdirectory}
#

use strict;
use warnings;
use Archive::Zip;

# 1MB超えるファイルを対象とする
my $targetfilesize = 1024 * 1024;

# 引数処理
my @dirs = @ARGV;
if(!@dirs){
	# デフォルトでカレントディレクトリ
	push @dirs, '.';
}

# 圧縮ファイル生成時の一時領域。
my $tempfilepath = '';

# シグナル実装
$SIG{INT} = sub{
	if($tempfilepath ne ''){
		unlink($tempfilepath);
	}
	print "SIGNAL!!\n";
	exit(1);
};


# 指定されたディレクトリを全て探査
while(my $dirpath = pop @dirs){
	opendir(my $DIR, $dirpath) || next;
	print "diretory: $dirpath\n";
	
	$tempfilepath = $dirpath . "/zipfile.temp";
	
	while(my $filename = readdir($DIR)){
		my $filepath = "$dirpath/$filename";
		my $zipfilepath = "$dirpath/$filename.zip";
		
#		if(-d $filepath){
#			push @dirs, $filepath;
#			next;
#		}

		# 存在しないファイル || zip圧縮済みファイル || サイズ未満のファイル || 拡張子が.zipのファイル
		if(! -f $filepath || -f $zipfilepath || -s $filepath < $targetfilesize || $filepath =~ /\.zip$/){
			next;
		}
		
		# ファイルを圧縮
		print "compress: $filepath \n";
		my $zip = Archive::Zip->new();
		$zip->addFile($filepath);
		
		# 途中で中断するとゴミが出来るので、一時ファイルにしっかり書き出されてからリネーム。
		if($zip->writeToFileNamed($tempfilepath) == Archive::Zip::AZ_OK){
			rename($tempfilepath, $zipfilepath);
			print "success: $zipfilepath\n";
		# 失敗したら削除する
		}else{
			unlink($tempfilepath);
			print "failed: $zipfilepath\n";
		}
		
	}
}

仕様です

ファイルは一つづつ圧縮されるので、
"hoge.dat", "fuga.bin"と二つあった場合、一つにまとめられることはなく、
"hoge.dat.zip", "fuga.bin.zip"の二つが出来上がります。


デフォルトでカレントディレクトリが対象になります。ディレクトリ指定にも多分対応。
下限ファイルサイズを指定して圧縮するべきファイルを絞る事もできます。
既に圧縮済みだろうファイルは圧縮しません。


ディレクトリの中のディレクトリまでは探査しませんが、

#		if(-d $filepath){
#			push @dirs, $filepath;
#			next;
#		}

このあたりをコメントアウト外せば多分できます。


Windows+ActivePerl(v5.10.0-1005)でしか動かしていません。
基本的な使い方としては、拡張子".pl"をPerlに対応付けて、
このプログラムを圧縮したいファイルたちがあるところに放り込んで実行するだけです。