vars.pm 探検

Env.pm を調べていたときに use vars qw( LIST ) という表現が出てきました。use vars は組み込み関数ではなく、use で vars.pm モジュールを読み込んでいるだけなのです。wlocate vars.pm で vars.pm を調べると、次のように、import メソッドしかありません。コードの長さも手頃のようです。今度は vars.pm を探検してみましょう。

package vars;

require 5.002;

# The following require can't be removed during maintenance
# releases, sadly, because of the risk of buggy code that does
# require Carp; Carp::croak "..."; without brackets dying
# if Carp hasn't been loaded in earlier compile time. :-(
# We'll let those bugs get found on the development track.
require Carp if $] < 5.00450;

sub import {
    my $callpack = caller;
    my ($pack, @imports, $sym, $ch) = @_;
    foreach $sym (@imports) {
        if ($sym =~ /::/) {
            require Carp;
            Carp::croak("Can't declare another package's variables");
        }
        ($ch, $sym) = unpack('a1a*', $sym);
        *{"${callpack}::$sym"} =
          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
           : do {
                require Carp;
                Carp::croak("'$ch$sym' is not a valid variable name\n");
             });
    }
};

1;

最初は、3行目の require 5.002; についてです。perldoc は -f コマンドラインオプションをつけると Perl の関数について調べることができます。これを使って require について調べてみます。

$ perldoc -f require | less

すると次のような文書が現れます。

=item require EXPR

=item require

Demands some semantics specified by EXPR, or by $_ if EXPR is not
supplied.  If EXPR is numeric, demands that the current version of Perl
(C<$]> or $PERL_VERSION) be equal or greater than EXPR.

赤い字の所を読むと require 5.002; がこのモジュールが動作するために Perl 5.002 以上のバージョンを要求していることが分かります。次にコメントを読んでみます。

後述の require ( 10行目の require Carp if $] < 5.00450; のこと)は、メインテナンスのリリースの間は削除できません。require Carp; Carp::corak "..."; のように括弧なしに croak を呼び出すようなコードが混じっていた場合、(Perl の)バグのため、コンパイルの早い次期に Carp が呼び出されていないとプログラムが中止されてしまう危険があるからです。development track (開発の... 意味が良く分かりませんでした。)ではそのことを告知しています。

要するに つぎの require 文は削除できないと言うことでしょう。

recuire Carp if $] < 5.00450;

上の文で、Carp モジュールはエラー処理を拡張するためのモジュールです。大体 carp が warn と同じ動作を、croak が die と同じ動作をします。もちろん、デバッグの情報が warn や die よりも多くなります。

$] は Perl のバージョンナンバーを格納しています。テストしてみましょう。

$ perl -e 'print "$]\n"'
5.00404

したがって 上の文は、「Perl のバージョンが 5.00450 以下だったら Carp パッケージを読み込む。」ということになります。

sub import {

import メソッドは他のファイルから use vars でこのモジュールが要求されたときに自動的に実行されるメソッドです。

    my $callpack = caller;

caller 関数については、Env.pm でも出てきました。caller の戻り値は caller が含まれているメソッドを呼び出したパッケージの名前になります。例えば main package から import メソッドが呼ばれた場合は、$callpack の値は 'main' になります。

    my ($pack, @imports, $sym, $ch) = @_;

my は引数のリストの変数が局所変数であると宣言します。@_ にどんなデータリストが入っているかということが問題ですが、main パッケージから import 関数が呼ばれていれば、@_ の第1引数はパッケージ名、第2引数以下には use vars qw( LIST )で渡されたリスト(LIST)が入ります。例えば、main package で use vars qw( $a $b $c ); と vars パッケージが要求された場合、vars.pm が require された後、import メソッドが自動実行されます。その際、import 関数には @_ = ( 'main', '$a', '$b', '$c') が渡されます。したがって $pack = 'main'、@imports = ( $a, $b, $c )となります。$sym、$ch、には何も代入されず、局所変数として宣言されただけということになります。

    foreach $sym (@imports) {
        if ($sym =~ /::/) {
            require Carp;
            Carp::croak("Can't declare another package's variables");
        }

for each 文で $sym に @imports リストの要素がひとつずつ代入されます。if ($sym =~ /::/) で変数名にダブルコロンの入っているものがある場合は、次の require Carp 以下を実行します。Carp::croak で Can't 以下のエラーメッセージを出してプログラムを終了させます。

        ($ch, $sym) = unpack('a1a*', $sym);

unpack が分からないので perldoc -f unpack | less で調べます。

=item unpack TEMPLATE,EXPR

Unpack does the reverse of pack: it takes a string representing a
structure and expands it out into a list value, returning the array
value.  (In a scalar context, it returns merely the first value
produced.)  The TEMPLATE has the same format as in the pack function.
Here's a subroutine that does substring:

    sub substr {
        local($what,$where,$howmuch) = @_;
        unpack("x$where a$howmuch", $what);
    }

良く分かりませんが、unpack は pack と反対の動作をし、それをコントロールする TEMPLATE は pack と同じ意味をもつようです。vars のソースでは 'a1a*' が TEMPLATE に相当するようですが、どういう意味なのかが不明です。そこで、perldoc -f pack | less で今度は pack の説明を読んでみます。

=item pack TEMPLATE,LIST

Takes an array or list of values and packs it into a binary structure,
returning the string containing the structure.  The TEMPLATE is a
sequence of characters that give the order and type of values, as
follows:


    A   An ascii string, will be space padded.
    a   An ascii string, will be null padded.
    b   A bit string (ascending bit order, like vec()).
    B   A bit string (descending bit order).
    h   A hex string (low nybble first).
    H   A hex string (high nybble first).

ありました、ありました。a は ascii 一文字で null 文字で区切られるようです。'a1a*' は ascii 一文字 と 残りの ascii 文字列にわけるという意味ではないかと推測します。そこで次のようなテストスクリプトを作ります。

#!/usr/bin/perl
($a, $b) = unpack( 'a1a*', 'defg' );
print $a, ' ', $b, "\n"

テストしてみます。

$ perl test_unpack.pl 
d efg

確かに 'defg' が 'd' と 'efg' に分けられています。したがって上記のソースでは、$sym = '$name' の場合、$ch = '$'、$sym = 'name' となって、変数の識別記号が $ch に、変数名が $syn に入ることになります。

        *{"${callpack}::$sym"} =
          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
           : $ch eq "\&" ? \&   {"${callpack}::$sym"
}
           : do {
                require Carp;
                Carp::croak("'$ch$sym' is not a valid variable name\n"
);
この長い文で変数の import を行ないます。長い文ですが、基本的には *{main::name} = ( \${main::name} ) という式が実行されると考えられます。{main::name} のタイプグロブ(*; typeglob)に、${main::name} のリファレンス(\)を代入する。という意味になります。奇妙な方法ですがこれで他のパッケージにグローバル変数を導入することになるようです。タイプグロブを使って変数のエイリアスを作る方法は、man perlmod として /typeglob で検索すると説明を見つけることができます。これがなぜ変数を導入することになるのかもうひとつよく分からないのですが、次のようなテストスクリプトを test_ref.pl で作成してみます。

$a = 'hello';
@b = (hi, there);
*name = \$a;
*name = \@b;
print "$name\n";
print @name, "\n";

テストすると下記のようになります。うまく動くようです?????

$ perl test_ref.pl
hello
hithere

= の左の項は3項演算子 ? を組み合わせて case 文を作った面白い方法です。? 演算子は普通は $a ? 'yes' : 'no' のような使いかたをします。$a が真だったら 'yes' が値となり、$a が偽だったら 'no' が値となります。たとえば次のようになります。

$ perl -e 'print 1 ? "yes" : "no", "\n"'
yes
$ perl -e 'print 0 ? "yes" : "no", "\n"'
no

これを組み合わせて C 言語などの case 文を実現しているのが上のソースプログラムです。しかし、説明よりテストプログラムを作ったほうが早いので次のプログラムを test_case.pl という名前で作成します。

#!/usr/bin/perl
$a = 3;
$b = ( $a == 1 ? 'one'
     : $a == 2 ? 'two'
     : $a == 3 ? 'three'
     : 'error'
     );
print "$b\n";

テストしてみましょう。

$ perl test_case.pl
three

Perl には case 文がありませんが、このように色々な方法で case 文を実現することができます。man perlsyn にも例が上げてあります。

以上、解けない謎も残りましたが vars.pm もなんとか攻略することができました。