miau's blog?

patch for PerlScript 5.8.x.xxx(PerlScript版)

今まで PerlScript の日本語問題に対応するパッチを何回か公開してましたが、この辺りをさらに使いやすくしてみました。

patch_for_PerlSE.pls

適当なディレクトリに保存して実行するだけです。
パッチが正常に適用できた場合「successfully patched! please re-run this script.」と表示されます。再度実行すると「already patched!」というメッセージが表示されるはずです。

以下、仕組みとか。

(2008/01/21 追記)

5.10.0.1002 でも動作しました。5.10.0.1001 にはバグがあってちゃんと PerlScript 自体が動きませんでした(5.10.0.1000 でもそうかも)ので、1002 以降を入れるようにしましょう。

Bug 74031  PerlSE.dll cannot load C:\Perl\bin\Perl58.dll




■動機

ベースとなっているのはこのあたりのパッチなんですが。

patch for PerlScript 5.8.7.813
patch for PerlScript 5.8.x.xxx

前者は .exe を C:\Perl\bin にコピーする手間があるし、後者はコマンドラインでコマンドを叩く手間があるわけで。
・もっと楽に適用できるものが欲しい
・パッチが適用されているかのチェックも同時に行いたい
ということで、今回のスクリプトを書きました。

■仕組み

ファイルの末尾でこんな処理をしています。

# パッチが当てられてなければ、以降は読み込まれないはずです。。。。
BEGIN {
$patched = 1;
}

コメント部分で日本語の文字数をほどよく調整しているので、パッチが適用されていない場合はこの BEGIN ブロックが読み込まれず、$patched が false になります。パッチが適用されていればこのブロックが読み込まれるので、$patched が true になります。この $patched の値を判別することで、処理の分岐を行っています。

もし日本語版以外の Windows でこのスクリプトを使いたい場合、上記の日本語を適当な 2 バイト文字に置き換えて使用してください。

■ソース(日本語コメントつき)

上記の仕組みにしているため、配布物では日本語でコメントを書くのを控えてます。
わかりにくい箇所もあると思うので、コメント追記した上でソースを貼っておきます。

use strict;
use warnings;

our $patched;

# パッチ適用済かチェック
# (パッチが適用されていれば、末尾の BEGIN ブロックが読み込まれ true になる)
if ($patched) {
MsgBox("already patched!");
exit(0);
}

# PerlSE.dll のパスを取得
# PerlScript 実行時は $^X($EXECUTABLE_NAME)が
# C:\Perl\bin\PerlSE.dll になるようです。
my $dll_file = $^X;
if ($dll_file !~ m/PerlSE\.dll$/) {
MsgBox("can't find PerlSE.dll");
exit(1);
}

# DLL ファイルの読み込み
open my $dll, '<', $dll_file or die "can't open $dll_file: $!";
binmode $dll;
local $/; # 一気読みモード
my $data = <$dll>;
close $dll;

# パッチの適用
# 詳細は patch for PerlScript 5.8.7.813 の項を参照。
my $count = (
$data =~ s{
\xFF\x74\x24\x18\xFF\x15\xE8\x90\x1C\x28\x59\x8B\xF0\xFF\x74\x24
\x10\x8B\xCB\x8D\x46\x02\x50\xE8\x64\xFF\xFF\xFF\x8B\xF8\x85\xFF
\x74\x14
}{
"\x57\x57\x57\x57\x6A\xFF\xFF\x74\x24\x2C\x57\x57\xFF\x15\x74\x90" .
"\x1C\x28\x8B\xF0\x57\x8B\xCB\x40\x50\xE8\x62\xFF\xFF\xFF\x8B\xF8" .
"\x90\x90"
}ex
);
unless ($count) {
MsgBox("failed to patch...");
exit(1);
}

# DLL のリネーム
# PerlSE.dll を使用中のため、直接書き込みはできません。
# バックアップを兼ねて、リネームを行います。
(my $backup_file = $dll_file) .= '.OLD';
while (-e $backup_file) {
# .OLD が存在する場合は .OLD1、.OLD2 というように名称変更
$backup_file =~ s/(\d*)$/$1 + 1/e;
}
rename($dll_file, $backup_file) or die "can't rename $dll_file to $backup_file: $!";

# DLL に書き込み
open my $dll, '>', $dll_file or die "can't open $dll_file: $!";
binmode $dll;
print $dll $data;
close $dll;

MsgBox("successfully patched! please re-run this script.");
exit(0);

# パッチが当てられてなければ、以降は読み込まれないはずです。。。。
BEGIN {
$patched = 1;
}

posted at 07:54:21 on 2007-03-15 by miau - Category: Perl No Trackbacks - Permalink

TrackBack

このエントリにトラックバックはありません
現在トラックバックは受け付けていません。

Comments

No comments yet

Add Comments

現在コメントは受け付けていません。
お手数ですが、 こちら のコメント欄にでも記載していただければと思います。