まとめて実装

このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。

さて、今までの考察を盛り込み、
細かい問題点を整理していき、
モジュールとしてまとめてみよう。

========== EncoderHandle.pm ==========

# 独自クラス。
package EncoderHandle;

# Perl 5.6 以上を要求する。
require v5.6.0;

# これらは理由がない限り指定。バグを防ぐ効果もある。
use strict;
use warnings;

# Tie::Handle を継承。
use Tie::Handle;
our @ISA = qw<Tie::Handle>;

# 強制ではないが、バージョンも指定しておく。
our $VERSION = '1.00';

# 変換関数へのコードリファレンス。
my $from_to;

# 文字列の eval は実行時に評価される。
# フォールバックと言えども、
# 通常のモジュール読み込みと同じように扱いたいので、
# BEGIN ブロック（サブルーチン）に含めることで、
# コードの実行をコンパイル時に行う。
BEGIN {

    # Encode モジュールを読み込んでみる。
    eval 'use Encode;';
    unless ($@) {
        # 成功したら変換関数のリファレンスを得る。
        $from_to = \&Encode::from_to;
        return;
    }

    # Encode と Jcode が使う名前の変換用。
    my %jcode_map = (
        'euc-jp'      => 'euc',
        'shift_jis'  => 'sjis',
        'iso-2022-jp' => 'jis',
        'utf-8'      => 'utf8',
        'ucs-2'      => 'ucs2', # 正式ではないが。
    );

    # Jcode モジュールを読み込んでみる。
    eval 'use Jcode;';
    unless ($@) {
        # 成功したら Encode::from_to と同じシグネチャの
        # クロージャをつくり、リファレンスを得る。
        # 昨日と同じだが、短く省略して書いている。
        $from_to = sub {
            my $encoding = Jcode::convert(\$_[0],
                $jcode_map{$_[2]}, $jcode_map{$_[1]});
            return undef if not defined $encoding;
            length $_[0];
        };
        return;
    }

    # jcode.pl スクリプトを読み込んでみる。
    eval "require 'jcode.pl';";
    unless ($@) {
        $from_to = sub {
            my $encoding = Jcode::convert(\$_[0],
                $jcode_map{$_[2]}, $jcode_map{$_[1]});
            return undef if not defined $encoding;
            length $_[0];
        };
        return;
    }

    # 全部なければあきらめる。
    die "Can't locate Encode.pm, Jcode.pm and jcode.pl.";
}

# コンストラクタのような役割のメソッド。
sub TIEHANDLE {
    my $package = shift;
    my %param = @_;

    # パッケージ名が名前でくるとは限らない。
    # オブジェクトの場合は ref で名前を取り出し、
    # 名前でもない場合は、このパッケージ名を使う。
    # __PACKAGE__ 特殊変数は、現在のパッケージ名を示す。
    $package = (ref $package or $package or __PACKAGE__);

    # パラメータが省略された場合、既定値を入れる。
    $param{'IF_ENCODING'} = 'euc-jp'
        unless defined $param{'IF_ENCODING'};
    $param{'IO_ENCODING'} = 'euc-jp'
        unless defined $param{'IO_ENCODING'};
    $param{'HANDLE'} = *STDOUT
        unless defined $param{'HANDLE'};

    # オブジェクトを作成する。
    bless(\%param, $package);
}

# 書き出し系関数のハンドラ。 引数は順に、
# インスタンス自身、データ、長さ、
# そして省略可能な、データ内の書き出し開始位置だ。
sub WRITE {

    # 分かりやすいように引数を変数に格納。
    my $this  = $_[0];
    my $length = $_[2];
    my $offset = ($_[3] or 0);
    my $text = substr($_[1], $offset, $length);
    my $handle = $this->{'HANDLE'};
    my $if_enc = $this->{'IF_ENCODING'};
    my $io_enc = $this->{'IO_ENCODING'};

    # 適切なモジュールを呼び出してコード変換。
    $length = $from_to->($text, $if_enc, $io_enc);

    # 失敗すれば死ぬ。
    die "Can't convert encoding" if not defined $length;

    # print 関数は、暗黙に $\ を勝手に書き出す。
    # 今回は $text だけを書き出したいので、
    # local を使って一時的に未定義にする。
    local $\;

    # 変換したデータを書き出す。
    print $handle $text;
}

# 通常、1 を返すが、真なら何でもいい。
'Loafer!';

========== end of EncoderHandle.pm ==========