camel

それって<*glob*>「メタ演算子」で。

Perl5 でネコ演算子Range Check - id:kazuhookuのメモ置き場
Perl 5 で、ある値が範囲内に入ってるか確認したいことってあるわけで。たとえば、
my $t = time;
if ($min <= $t && $t < $max) {
    ...
}
みたいな冗長なコードは書きたくない。

こんな感じで。

#!/usr/bin/perl
use strict;
use warnings;
{
    no warnings 'redefine';
    *CORE::GLOBAL::glob = sub{
        my $expr = shift;
        warn $expr;
        $expr =~ s{
            \A(.*?)~~(.*?)(\^\.)(\.\^?)(.*?)
        }{
            my $num = eval $1;
            my $min = $2;
            my $lt0  = length($3) == 1 ? '<=' : '<';
            my $lt1  = length($4) == 1 ? '<=' : '<';
            my $max = $5;
            qq($min $lt0 $num && $num $lt1 $max);
        }emsx;
        warn $expr;
        eval $expr;
    };
}

local $\="\n";
print "OK" if     <length('^..^') ~~ 3^..^5>;
print "OK" unless <length('^..^') ~~ 0^..^3>;

モダンPerlにおいて、<$filehandle>と違って<*glob*>は滅多に使わない演算子ですが、その中でmicro-DSLを実装するのにはうってつけ。このCORE::GLOBAL::glob()をDSL置き場として使う手法は、「PERL HACKS」ではHACK #90として紹介されています。

上記の例は、ネコだけあってevalを使いまくってお遊びの印象が強いのですが、こちらの方はむちゃ便利かつ強力で、上記が黒魔術ならこちらは白魔術といったおもむきです。

#!/usr/bin/perl
use strict;
use warnings;
{
    use Carp;
    no warnings 'redefine';
    *CORE::GLOBAL::glob = sub {
        my $path = shift;
        $path =~ s/\A\s+//;
        $path =~ s/\s+\z//;
        my $slurp;
        if ( $path =~ m{\w+://} ) {
            eval { require LWP::Simple; };
            croak $@ if $@;
            $slurp = LWP::Simple::get($path);
        }
        else {
            local $/;
            open my $fh, '<', $path or croak "$path:$!";
            $slurp = CORE::readline($fh);
            close $fh;
        }
        return $slurp;
    };
}

print </etc/motd>;
print <http://www.dan.co.jp/>;

というわけで、CPANにうpしておきました。

cpan

<Enjoy/>

Dan the Perl Monger