More than 5 years have passed since last update.

特殊ファイルハンドル _ と、記号での関数定義

Perl

Last updated at 2018-05-28Posted at 2018-05-28

#kichijojipm で、 lodash.js を Perl5 に移植している話をした際、songmu さんから、次のような指摘をもらった

perlでアンダースコアは実は組み込みで使われてるんだよな #kichijojipm
— songmu (@songmu) 2018年5月25日

アンダースコアは特殊変数(?)としてデフォルトてま使われています #kichijojipm / “ファイルテスト演算子をつかいまくる” https://t.co/siK5ZYkkRF
— songmu (@songmu) 2018年5月25日

少し咀嚼してみる

`_` とは何か

-r, -x などのファイルテスト演算子を実行すると、演算対象となったファイルハンドルをキャッシュする
_ とは、そのキャッシュされたファイルハンドル
- stat cache と呼ぶこともある

example

-f $file && -r $file && -x $file;

# use _
-f $file && -r _ && -x _;

# stack filetest from perl5.10
-f -r -x $file

`filetest` pragma での注意

OS によっては、ファイルテストをコントロールしたい場合、
例えば、BSD::stat のように、 stat の挙動を変更できる

ここでは filetest pragma で access(2) を呼び、-r -w -x -R -W -X の挙動を変更できることについて書く

example-filetest-pragma.pl

$file = 'example.pl';
-r $file;
{
    use filetest 'access';
    -r $file;
}
-r $file;

system call を観察してみると、次のように stat64, access が呼び出されてることがわかる

% sudo dtruss  -f sudo -u $(id -u -n) 'perl example-filetest-pragma.pl' 2>&1 | grep example.pl
39296/0x117f576:  stat64("example.pl\0", 0x103987C80, 0x0)               = -1 Err#2
39296/0x117f576:  access("example.pl\0", 0x4, 0x0)               = -1 Err#2
39296/0x117f576:  stat64("example.pl\0", 0x103987C80, 0x0)               = -1 Err#2

ただし、現時点 perl5.26 だと、 filetest pragma ではキャッシュする仕組みを通していない
これは、将来、解消される予定
- https://metacpan.org/pod/filetest#Limitation-with-regard-to-_
キャッシュをしていないかどうか確かめるには、 -r -w -x -R -W -X しか置き換えないことを利用して、それ以外のファイルテストでキャッシュさせ、-r -w -x -R -W -Xを利用しても、キャッシュが置き換わってないことを確かめればよい。次がその例：

notice-filest-pragma

use strict;
use warnings;

use Test::More;

subtest 'default' => sub {
    ok -d '/etc';
    my @stat_etc = stat(_);
    ok not -w '/etc/passwd';
    ok -f _;
    my @stat = stat(_);
    ok not $stat[1] == $stat_etc[1];
};

subtest 'use filetest pragma' => sub {
    use filetest 'access';
    ok -d '/etc';
    my @stat_etc = stat(_);

    ok not -w '/etc/passwd';
    ok not -f _; # /etc/passwd is not file ??????????
    my @stat = stat(_);
    is_deeply \@stat_etc, \@stat; # _ is /etc !!!!!!!!!
};

done_testing;

長々と書いたが、
perl5.10 以降であれば、
次のように、ファイルテストを複数実施することができ、これは直感に反しない結果になる
ので、基本的に、これを利用すれば良いと思う

use strict;
use warnings;

use Test::More;

subtest 'stack' => sub {
    ok -d '/etc';
    ok not -f -w '/etc/passwd';
};

subtest 'stack with filetest pragma' => sub {
    use filetest 'access';
    ok -d '/etc';
    ok not -f -w '/etc/passwd';
};

done_testing;

余談: `_` を関数名として利用できる件について

っていうかPerl, 普通にunderscoreだけのサブルーチン定義出来るのな... #kichijojipm
— (HTTP)Sの執行者 (@__papix__) 2018年5月25日

次を見るとわかるように、不思議な挙動をするのでさらに不思議!!

まず、記号だけで関数定義を探ってみる
perldata を読むと、underscore, ::, ' あたりが使えそうなことがわかる

Usually this name is a single identifier, that is, a string beginning with a letter or underscore, and containing letters, underscores, and digits. In some cases, it may be a chain of identifiers, separated by :: (or by the slightly archaic '); all but the last are interpreted as names of packages, to locate the namespace in which to look up the final identifier (see Packages in perlmod for details).

色々手探りで探すと、↓↓ のような関数定義はできることがわかる

use strict;
use warnings;
use Test::More;

sub _ { 'call _' }
sub :: { 'call ::' }
sub _'_ { "call _'_" }

is _, 'call _';
is ::, 'call ::';
is _'_, "call _'_";

ok __PACKAGE__->can('_');
TODO: {
    local $TODO = 'can("::") does not return coderef of ::';
    ok not __PACKAGE__->can("::");
}
ok __PACKAGE__->can("_'_");

done_testing;

さらに、クラス呼び出しを試してみると・・

use strict;
use warnings FATAL => 'all';

package Foo {
    sub _ { 'call _' }
    sub :: { 'call ::' }
    sub _'_ { "call _'_" }
}

package main;

use Test::More;

subtest '_' => sub {
    eval "Foo::_";
    like $@, qr/Bareword "Foo::_" not allowed while "strict subs"/;

    eval "Foo->_";
    like $@, qr/Can't locate object method "_" via package "Foo"/;

    ok not (Foo->can('_'));
};

subtest '::' => sub {
    eval "Foo::::";
    like $@, qr/Bareword "Foo::::" refers to nonexistent package/;

    eval "Foo->::";
    like $@, qr/Bareword found where operator expected/;

    ok not (Foo->can('::'));
};

subtest "_'_" => sub {
    eval "Foo::_'_";

    # "Foo::_'_" ではなく、 Foo::_::_ !!
    like $@, qr/Bareword "Foo::_::_" not allowed while "strict subs"/;

    eval "Foo->_'_";
    ok not $@;

    ok(Foo->can("_'_"));
};

done_testing;