karronoliの日記

最近Perlさんに飯を食わせてもらうようになりました

perl | 14:07 |

ところでいろんな環境にそれなりにポーティングされていて手っ取り早く使えるスクリプト言語ってやっぱPerlなんですね．最近になってそれが身に染みて感じるようになりました．そんなPerlですがFIle::chdirのpodを読んでて挙動が気になったのでソース読んだらtieっていう関数を知りました．遊ぶ分には楽しめそうだと思ってロガーを書いてみました．

package Hoge;
use strict;
use warnings;
use utf8;
use POSIX 'strftime';
use Time::HiRes 'gettimeofday';

if (exists($ARGV[0])) {
    tie *STDOUT, __PACKAGE__, 'a.log';
}

sub TIEHANDLE {
    my $class = shift;
    my $fn = shift;
    open(my $f, '>>', $fn);
    select((select($f), $| = 1)[0]);
    bless \$f, $class;
}
sub PRINT {
    my $self = shift;
    my $fh = ${$self}; # なんでか一旦置き換えしないと怒られる
    my $tag = (scalar @_ > 1)? shift:'DBG';
    my $msec = sprintf("%06d", (gettimeofday())[1]);
    my ($package, $filename, $line, $subroutine, $hasargs,
     $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
    my $output = "@{[strftime('%Y-%m-%d.%H:%M:%S', localtime)]}.$msec [$tag] $subroutine:$line @{[join(' ', @_)]}";
    print $fh $output;
}

sub DESTORY {
    my $self = shift;
    my $fh = ${$self};
    close($fh);
}

package main;
sub {
    print 1,"hoge\n";
    print "fuga\n";
}->();
eval {
    print 'hige', "piyo\n";
    print "funya\n";
}; if ($@){}

適当な名前で保存して実行するとtieの引数で渡したファイルにこんなんが書かれます．(PRINTでグチャグチャ文字列を持ってるのが気にいらないですね．)

2010-09-05.13:50:10.022877 [1] main::__ANON__:42 hoge
2010-09-05.13:50:10.024172 [DBG] main::__ANON__:42 fuga
2010-09-05.13:50:10.024367 [hige] (eval):43 piyo
2010-09-05.13:50:10.024496 [DBG] (eval):43 funya

ツイートする

IPC::ほげほげとか

perl | 14:07 |

冒頭の「いろんな環境にそれなりにポーティング」に関係するんですけどその幻想をぶち壊してくれたのがIPC系の"標準モジュール"達です．corelist /IPC/で自分が使おうとしてたのを見ると

IPC::Cmd was first released with perl 5.009005
IPC::Open2 was first released with perl 5
IPC::Open3 was first released with perl 5

という感じで流石Perlさんは古くからいろんな環境のことを気にしてくれてたのか，と思って使ったんですがnot implだがなんだかいって運悪く使えない環境に当たってしまいました．どんな環境かはIPC::Cmdの結構最初に書いてあります．見つけたときは残念な気持になりました．んで，凝ったことをするつもりはなかったのでopenでこんな感じのを最近書きました．

#カレントディレクトリの.plなファイルをzipする
my $pid = open($proc, '|zip hoge.zip -@');
print $proc join("\n", glob('*.pl'));
close($proc);

オプションの-@は標準入力にファイルパスを書き込んで，そのファイルをzipしてくれます．なにげにzipコマンドのオプションはよくできています．しかもArchive::Zipを使うよりパフォーマンスよさそうな気がちょっぴりするし．ただ始めに使ったzipコマンドがinfo-zipのzipコマンドのバージョン2.0でファイル名8文字+拡張子3文字までパスにディレクトリを含められないという最悪の仕様でした．そんな古いのはまずないでしょうが注意が必要です．

ツイートする