[kansaipm] Re: Perl 5.6 ネタ

[mishima at momo.so-net.ne.jp]

三嶋です。

岡部さんこんにちは。
おかげさまで perl-win32-j のほうではいつも勉強させていただいてます。

早速、というか遅ればせながら、Filter モジュールを入れて、わたなべさん
の SJIS.pm もパクらせていただきました。
さらに、ファイルI/O時にフィルタを仕込めるようにした FileHandle のサブ
クラスを作ってみましたので、後ろにサンプルプログラムと共に付けておきま
す。（FileFilterと名づけました）

#ソースにコメントがなくて申し訳ないのですが、興味のあるかたは解読してみ
#てください。

サンプルでは、おおよそこんな感じで使っています。
$in  = new FileFilter("<&STDIN",  sub{ SJISをUTF8に変換する処理 });
$out = new FileFilter(">&STDOUT", sub{ UTF8をSJISに変換する処理 });
$out->autoflush(1);		# スーパークラスのメソッド
while($_=$in->readline){	# 読込み時に SJIS->UTF8
    $out->printf(...);		# 書込み時に UTF8->SJIS
    $out->print(...);		# 書込み時に UTF8->SJIS
}

サンプルの実行例は、以下の通りです。
最初に１行のメッセージが出ます（「表」の字を無理に使ってます^^)。プロ
ンプト '> ' の後に適当な文字列を入力すると、文字コードの判定と文字数お
よびバイト数が表示され、次の行に正規表現の \b と \B にマッチする箇所に 
| と - を挿入した結果が表示されます。

bash-2.02$ test.pl
単語の境界に"|"を、それ以外の文字境界に"-"を挿入して表示します。
> 日本語も alphabet も正しく表示できる。
コード＝utf8	文字数＝24	バイト数＝52
|日-本-語-も| |a-l-p-h-a-b-e-t| |も-正-し-く-表-示-で-き-る|。-
> 

#ところで、use bytes, no bytes の切り替えが完全には実装されていないよう
#ですね。length($_[0])の結果が（文字/バイトの）コンテキストにかかわらず、
#バイト数になってしまいました。しかし、$_[0]=~/.*/; length($&); とやる
#とuse bytesのときはバイト数が、no bytesのときは文字数が返るんですね。
#あら不思議。

以下、FileFilter.pm とサンプルプログラムのソースです。
これを動かすためには、Perl 5.6 本体の他に、Jcode, Filter の
両モジュールと、4/4の岡部さんのメールにある SJIS.pm が必要です。

# EUC コードをお使いの場合には、ソース中の sjis という記述を
# 適宜 euc に置き換えてお試しください。（当然 SJIS.pm の名前も^^)

====================<test.plここから>====================
#!/usr/local/bin/perl

use utf8;
use Jcode;

use FindBin qw($Bin);
use lib $Bin;
use SJIS;
use FileFilter;

sub chars {
    no bytes;
    $_[0] =~ /.*/;
    return length($&);
    #return length($_[0]);
}
sub bytes {
    use bytes;
    $_[0] =~ /.*/;
    return length($&);
    #return length($_[0]);
}

my $jcode = new Jcode;
my $in  = new FileFilter("<&STDIN",
			 sub{ $jcode->set(join('', at _),sjis)->utf8 });
my $out = new FileFilter(">&STDOUT",
			 sub{ map{ $jcode->set($_,utf8)->sjis }@_ });
$out->autoflush(1);
$out->print("単語の境界に'|'を、それ以外の個所に'-'を挿入して表示します。\n");
while(print '> ' and $_ = $in->readline){
    chomp;
    $out->printf("コード＝%s\t文字数＝%d\tバイト数＝%d\n",
		 scalar Jcode::getcode($_), chars($_), bytes($_));
    s/(\b)|\B/defined($1)?'|':'-'/ge;
    $out->print($_,"\n");
}
====================<test.plここまで>====================

====================<FileFilter.pmここから>====================
package FileFilter;
use strict;
use Carp;
use FileHandle;

use vars qw(@ISA);
@ISA = qw(FileHandle);

sub new {
    my $type = shift;
    my $class = ref($type) || $type;
    my $filter = pop;
    ref($filter) eq 'CODE' or croak "Bad option for FileFilter\n";
    my $self = $class->SUPER::new(@_);
    %{*$self}->{filter} = $filter;
    return $self;
}

sub print {
    my $self = shift;
    if( my $filter = %{*$self}->{filter} ){
	$self->SUPER::print($filter->(@_));
    }else{
	$self->SUPER::print(@_);
    }
}

sub printf {
    my $self = shift;
    if( my $filter = %{*$self}->{filter} ){
	$self->SUPER::print($filter->(sprintf(shift, at _)));
    }else{
	$self->SUPER::printf(shift, at _);
    }
}

sub readline {
    my $self = shift;
    if( my $filter = %{*$self}->{filter} ){
	return( $filter->(scalar(<$self>)) );
    }else{
	return( scalar(<$self>) );
    }
}

sub readlines {
    my $self = shift;
    if( my $filter = %{*$self}->{filter} ){
	return( $filter->(<$self>) );
    }else{
	return( <$self> );
    }
}

1;
====================<FileFilter.pmここまで>====================

--
$p='Perl'; $_='Masahiro Mishima'; sub _{pack'c*',$x=110+ at _*5,$x+1}
tr/oma/fa_/;s/./chr(ord($&)+2)/ge;@x=(sort(grep{!$_{$_}++}split//),
$p=~/(.(..).)/);$x[7]=~s/^/_/e;$x[8].=_ 1;for(@w=(47,1639,8,31259))
{s/\d/$x[$&+1]/g} print ucfirst "@w.\n";