先週の水曜日には、EPUBをほぐしたフォルダーを、Perlで再Zipして元のEPUBに戻すというプログラムを書きました。

Opus 28:たまに書くならこんなPerl:EPUBを固める : 『かんたんPerl倶楽部』

 次の日の木曜日には、WindowsのActivePerlについてくるpl2bat.batというのを使って、ドラッグ&ドロップでPerlのスクリプトを起動するという話を書きました。

Opus 29:たまに書くならこんなPerl:Windowsのドラッグ&ドロップで駆動する : 『かんたんPerl倶楽部』

 この2つを組み合わせると、当然ながら、EPUBをほぐしたフォルダーをドラッグ&ドロップすると元のEPUBにかためてくれるプログラムが作れます。

Boeing 737-217-Adv, Zip Air AN0256511

 まず。Opus 28で作成したPerlスクリプト、zipEpub.plを小改造します。

#! /usr/local/bin/perl
# zipEpub.pl -- EPUBファイル圧縮

use strict;
use warnings;
use 5.10.0;

use Archive::Zip;
#use Cwd;

my $cwd = shift; # カレントディレクトリの絶対パス名
chdir $cwd;
$cwd =~ m{([^\\]+)$}; # カレントディレクトリのディレクトリ名
my $rwd = $1;
my $zipFile = $cwd.'\\..\\'.$rwd.'.epub'; # ひとつ上の階層にディレクトリ名.epubという名前で置く
die "$zipFile already exists" if -f $zipFile; # すでにある場合は死ぬ

my $zip = Archive::Zip->new(); # 新規Zipオブジェクトを作る
my $mime = $zip->addFile ('mimetype'); # mimetypeを追加
$mime->desiredCompressionLevel ( 0 ); # -0 # 圧縮率0で圧縮
$zip->writeToFileNamed( $zipFile ); # ファイルを書き出す

$zip = Archive::Zip->new( $zipFile ); # 既存のzipファイルを読み込む
my $pred = sub { not /^mimetype$/ }; # ディレクトリからファイルを取り出すクライテリアを決める。今回は「mimetypeでなかったら」
$zip->addTree ('.', '', $pred ); # カレントディレクトリ以降のツリーを、mimetypeでなければZipに追加する。
$zip->overwrite(); # ファイルを上書きする

 まず、以前はコマンドラインでEPUBをほぐしたフォルダー(これ、正式にはなんと言うんでしょうね)がカレント ディレクトリーの状態でスクリプトを起動するという前提にもたれよりかかって、Cwd::cwdというモジュール メソッドでカレント ディレクトリーの絶対パス名を取得していました。
 しかし、pl2bat.batを使ってできたバッチファイルにフォルダーをドラッグ&ドロップすると、そのフォルダーの絶対パスがスクリプトの第1引数($ARGV[0])に入るので、shiftでそれを$swdにいれてやります。で、chdir関数でそこに移動します。

 あと、zipEpub.plはパス区切り文字がスラッシュだったのを、Windows用にバックスラッシュにします。
 こうして改造したzipEpub.plを、C:\Perl\bin\pl2bat.batにドラッグ&ドロップすると、zipEpub.batが以下のようにできます。

@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S %0 %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#! /usr/local/bin/perl
#line 15
# zipEpub.pl -- EPUBファイル圧縮

use strict;
use warnings;
use 5.10.0;

use Archive::Zip;
use Cwd;

my $cwd = shift; # カレントディレクトリの絶対パス名
chdir $cwd;
$cwd =~ m{([^\\]+)$}; # カレントディレクトリのディレクトリ名
my $rwd = $1;
my $zipFile = $cwd.'\\..\\'.$rwd.'.epub'; # ひとつ上の階層にディレクトリ名.epubという名前で置く
die "$zipFile already exists" if -f $zipFile; # すでにある場合は死ぬ

my $zip = Archive::Zip->new(); # 新規Zipオブジェクトを作る
my $mime = $zip->addFile ('mimetype'); # mimetypeを追加
$mime->desiredCompressionLevel ( 0 ); # -0 # 圧縮率0で圧縮
$zip->writeToFileNamed( $zipFile ); # ファイルを書き出す

$zip = Archive::Zip->new( $zipFile ); # 既存のzipファイルを読み込む
my $pred = sub { not /^mimetype$/ }; # ディレクトリからファイルを取り出すクライテリアを決める。今回は「mimetypeでなかったら」
$zip->addTree ('.', '', $pred ); # カレントディレクトリ以降のツリーを、mimetypeでなければZipに追加する。
$zip->overwrite(); # ファイルを上書きする

__END__
:endofperl

 あとは、このバッチファイルにフォルダーを放り込んでやるだけで駆動します。

 このバッチファイルは、コマンドラインで起動しても同じように動くのでよくできています。