それって<*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しておきました。
- /lang/perl/File-Glob-Slurp/trunk - CodeRepos::Share - Trac
- dankogai's p5-file-glob-slurp at master - GitHub
- Dan Kogai / File-Glob-Slurp/ - search.cpan.org
<Enjoy/>
Dan the Perl Monger
は
\A(.*?)~~(.*?)(\^\.|\.)(\.\^|\.)(.*)
ではないでしょうか?
3..5
と
3..^5
の場合に置換しないようなのです。