filenameプラグマを作ってみたよ。

filenameプラグマを作ってみたよ。

　とりあえず作ってみた。たぶん動くんじゃないかな？

　これを使って何をしたいかはまた後で。

名前

　filename - utf8文字列なファイル名を変換したり、読み出したファイル名をutf8文字列に変換する方法を指定する

概要

use filename 'cp932';
open my $fh, '<', $filename;

use filenname 'cp932', qw/:globally/;  # modify CORE::GLOBAL
my $fh = IO::File->new( $filename, 'r' );

use filename \&_convert_cp932;
open my $fh, '<', $filename;

use Encode;
my $enc = Encode::find_encoding('cp932');
sub _convert_cp932 {
    my $filename = shift;
    if (utf8::is_utf8($filename)) {
        $enc->encode($filename);
    }
    else {
        $enc->decode($filename);
    }
}

注意

　ファイルハンドル周りは挙動がよく分からないので、これで正しいのか自信がないです。

　１引数のopen()には対応していません（すべき？）。

　sysopen()にも対応していません（すべき？）。

予定

　どれを使うか引数で指定できるようにしたほうがいい気がする。

　Exporterを使うべきか悩みどころ。

希望

　encodingプラグマと一緒に配布するとうれしいんじゃないかな？

ソースコード

package filename;
our $VERSION = '0.01';

use strict;
use Encode qw/is_utf8 find_encoding/;
use Symbol qw/qualify_to_ref gensym/;

sub import {
    my $pkg = shift;
    my $encoding = shift;
    my %opt = map +(lc $_ => 1), @_;

    my $convert;
    if (ref $encoding eq 'CODE') {
        $convert = $encoding;
    }
    else {
        my $enc = find_encoding($encoding);
        $convert = sub {
            my $filename = shift;
            if (is_utf8($filename)) {
                $enc->encode($filename);
            }
            else {
                $enc->decode($filename);
            }
        };
    }

    my $where = $opt{':globally'}? 'CORE::GLOBAL': caller(0);

    no strict 'refs';
    no warnings 'redefine';

    my $open = eval {$where->can('open')};
    *{"$where\::open"} = sub (*;$@) {
        my $fh;
        if (defined $_[0]) {
            $fh = qualify_to_ref(shift, caller);
        }
        else {
            $_[0] = gensym;
            $fh = shift;
        }

        if (@_ == 0) {
            $open? $open->   ($fh):
                   CORE::open($fh);
        }
        elsif (@_ == 1) {
            my $expr = is_utf8($_[0])? $convert->($_[0]): $_[0];
            $open? $open->   ($fh, $expr):
                   CORE::open($fh, $expr);
        }
        elsif (@_ >= 2) {
            my $mode = shift;
            my $expr = is_utf8($_[0])? $convert->(shift): shift;

            $open? $open->   ($fh, $mode, $expr, @_):
                   CORE::open($fh, $mode, $expr, @_);
        }
    };

    my $opendir = eval {$where->can('opendir')};
    *{"$where\::opendir"} = sub (*$) {
        my $dh;
        if (defined $_[0]) {
            $dh = qualify_to_ref(shift, caller);
        }
        else {
            $_[0] = gensym;
            $dh = shift;
        }

        my $expr = is_utf8($_[0])? $convert->($_[0]): $_[0];

        $opendir? $opendir->($dh, $expr): CORE::opendir($dh, $expr);
    };

    my $readdir = eval {$where->can('readdir')};
    *{"$where\::readdir"} = sub (*) {
        my $dh = shift;
        unless (ref $dh) {
            $dh = qualify_to_ref($dh, caller);
        }

        my @res = $readdir? $readdir->($dh): CORE::readdir($dh);
        map +$convert->($_), @res;
    };

    my $glob = eval {$where->can('glob')};
    *{"$where\::glob"} = sub {
        my $pat = shift || $_;
        is_utf8($pat) and $pat = $convert->($pat);
        if (wantarray) {
            my @res = $glob? $glob->($pat): CORE::glob($pat);
            map +$convert->($_), @res;
        }
        else {
            my $res = $glob? $glob->($pat): CORE::glob($pat);
            $convert->( $res );
        }
    };

}

1;