2001-10-08

Perlそぞろ書き

ここには、実用的とか技巧的とかではないにしろ、面白そうな書き方を集めようとしています。ここにあるサンプルは、バグがあったり(それはきっと私の書き間違い)するかもしれませんが、あらかじめご了承下さい。

# 条件演算子
# 正規表現の ^, $, .
# コンテキストの判定
# シンボルテーブル
# リファレンスの型
# データのコピー

条件演算子

Perlで唯一の三項演算子である条件演算子 ? : は、A ? B : C のとき「A ならば B を、さもなければ C を」値として返す。[cf. perlop]

do { if (A) {B} else {C} } としても同じように働くが、表記がはるかに簡便である。

ネストして、複雑な分岐を表すことができる。

サンプルコード
$result = $foo
          ? $bar
              ? '$foo=TRUE, $bar=TRUE'
              : '$foo=TRUE, $bar=FALSE'
          : $bar
              ? '$foo=FALSE, $bar=TRUE'
              : '$foo=FALSE, $bar=FALSE';

右方向の結合規則を持つので、A ? B : C ? D : E(A ? B : C) ? D : E ではなく A ? B : (C ? D : E) と解釈される。これはif-elsif-else の梯子を表すことができ、switch文と同様なことを簡潔に記述することができる。[cf. perlsyn]

foreachを使うことによって、$_にローカルなエイリアスが作られる。

サンプルコード
foreach ($char) {
    $ctype = /^[A-Za-z]$/    ? 'alpha' :
             /^[0-9]$/       ? 'digit' :
             /^[ \n\r\t\f]$/ ? 'space' :
                               'others';
}

条件演算子は偽の値やリストや配列を返すことも問題なくできる。これは論理値としてスカラーコンテキストが強制される && ||とは異なる。

サンプルコード
   $a = $cond && 0 || 1;           # うまくいかない
   $a = $cond ? 0 : 1;             # うまくいく

   @a = $cond && @b || (0,1,2,3);  # うまくいかない
   @a = $cond ? @b : (0,1,2,3);    # うまくいく

正規表現の ^$.

正規表現 ^$. の意味は次のとおり。[cf. perlre]

      /^/     通常は文字列の先頭。
              /m があると行の先頭(文字列の先頭または任意の \n の直後)。

      /$/     通常は文字列の末尾か 文字列の末尾の \n の直前。
              /m があると行末(文字列の末尾または任意の \n の直前)。

      /./     通常は \n を除く文字。
              /s があると\nを含む任意の文字。

従って、次のような結果になる。

サンプルコード
     "ABC\n" =~ /ABC$/  # マッチする。
"ABC\nXYZ\n" =~ /ABC$/  # マッチしない。
"ABC\nXYZ\n" =~ /ABC$/m # マッチする。
        "\n" =~ /./     # マッチしない。
        "\n" =~ /./s    # マッチする。
        "\n" =~ /^.$/   # マッチしない。
        "\n" =~ /^.$/m  # マッチしない。
        "\n" =~ /^.$/s  # マッチする。
      "\n\n" =~ /^.$/s  # マッチする。
       "\nA" =~ /.^A/   # マッチしない。
       "\nA" =~ /.^A/m  # マッチしない。
       "\nA" =~ /.^A/s  # マッチしない。
       "\nA" =~ /.^A/sm # マッチする。

コンテキストの判定

wantarrayはサブルーチンの呼び出されたコンテキストを返す。[cf. perlfunc]
サンプルコード
$a   = tellcontext();
($a) = tellcontext();
@a   = tellcontext();
tellcontext();

sub tellcontext {
    print defined wantarray
    ? wantarray
        ? "list context:   "
        : "scalar context: "
    :     "void context:   ";
    printf "at Pkg %s, File %s, L %s\n", caller;
}
実行結果
scalar context: at Pkg main, File D:\test.pl, L 1
list context:   at Pkg main, File D:\test.pl, L 2
list context:   at Pkg main, File D:\test.pl, L 3
void context:   at Pkg main, File D:\test.pl, L 4

次の例では、Ucは無効コンテキストのとき引数のスカラーを直接変更する。

サンプルコード
sub Uc (\$); # 前方宣言

# 組みこみ関数の uc と同様な挙動。
$a = "1: perl";
$b = Uc $a;
print "$a\n$b\n";

# 式 Uc $c は無効コンテキストだが…
$c = "2: perl";
Uc $c;
print "$c\n";

# & を付けるのはプロトタイプチェックを避けるため。
# リテラルはスカラー変数ではない!
print &Uc("3: perl"),"\n"; 

sub Uc (\$) {
    my $str = shift;
    ref $str eq 'SCALAR'
    ? defined wantarray
        ? uc $$str
        : $$str =~ tr/a-z/A-Z/
    : uc $str
}
実行結果
1: perl
1: PERL
2: PERL
3: PERL

シンボルテーブル

シンボルテーブル [cf. perlmod] は、それぞれのpackageに対して用いられている名前を格納するハッシュに収められている。そうしたハッシュは、スタッシュ stash [cf. perlguts] と呼ばれるが、mainパッケージなら、%main:: または簡略して %:: と記す。hogeパッケージなら %hoge:: であり、foo::barパッケージなら %foo::bar:: と記す。

それぞれのハッシュは、識別子の名前をキーに、それに対する型グロブを値に持つ。

サンプルコード
$foo::bar::some = 1;

package foo::bar;
$piyo = $puru = 0;

package main;

while (my ($k,$v) = each %foo::bar::) {
   print "$k => $v\n";
}
実行結果
some => *foo::bar::some
piyo => *foo::bar::piyo
puru => *foo::bar::puru

このときハッシュの値 $v(これが識別子 foo::bar::hoge に対応するものとする)からは、次のような表記によって関連するデータに変換することができる($v をブロックに入れて *{ $v }{SCALAR} などのように書いてもよい)。

*$v{SCALAR}      \$foo::bar::hoge   スカラーのリファレンス
*$v{ARRAY}       \@foo::bar::hoge   配列のリファレンス
*$v{HASH}        \%foo::bar::hoge   ハッシュのリファレンス
*$v{CODE}        \&foo::bar::hoge   サブルーチンのリファレンス
*$v{GLOB}        \*foo::bar::hoge   型グロブのリファレンス
*$v{IO}          (foo::barパッケージに属するhogeファイルハンドル
                  またはディレクトリハンドル)
*$v{FILEHANDLE}  *$v{IO} の同義語(古いバージョンとの互換性を保つため)
                 ディレクトリハンドルも除外されない!
*$v{PACKAGE}     'foo::bar'         パッケージ名の文字列
*$v{NAME}        'hoge'             名前を表す文字列

この形式を使えば、use strict 'refs'のときでも、シンボリックリファレンスを使用できる。もちろん、必要があるならそのスコープに対してno strict 'refs'を使用すれば済む話であるのだが。

サンプルコード
use strict;

for my $i (0..9) {
   no strict 'refs';        # これがないと致命的エラー
   ${ "abc$i" } = $i * $i;  # シンボリックリファレンス
}
for my $i (0..9) {
  # こちらは no strict 'refs'; にする必要はない。
   print ${ $::{"abc$i"} },"\n";
   print ${ *{ $::{"abc$i"} }{SCALAR} },"\n"; # でも長たらしい
}

次の例は、foo::barパッケージから、スカラー変数だけ、エイリアスをmainパッケージに作る。

サンプルコード
use strict;

$foo::bar::val = "abc";
$foo::bar::num = 125;

foreach my $v (values %foo::bar::) {
   if (*{$v}{SCALAR}) {
      no strict 'refs';
      *{ *{$v}{NAME} }  = *{$v}{SCALAR};
   }
}

$foo::bar::val = "modified";

print "$main::val\n$main::num\n";

$main::num = -12;

print "$foo::bar::num\n";

次に示すものは、スカラー名とファイルハンドル名を関連付ける一例である(何の意味があるかは知らない)。すなわち、スカラーの値を同名のファイルハンドルに振り分けて出力する(fh1.txtには "from FH1\n" が、fh2.txtには "from FH2\n" が記入される)。ここで、ファイルハンドル { *$v{IO} } はブロックに入れないと構文エラーになる。

サンプルコード
package foo::bar;

open FH1, ">fh1.txt";
$FH1 = "from FH1\n";

open FH2, ">fh2.txt";
$FH2 = "from FH2\n";

package main;

for my $v (values %foo::bar::) {
   next unless *$v{IO};
   print { *$v{IO} } ${ *$v{SCALAR} };
}

スタッシュはハッシュであるため、そのキーには、いかなる文字列も使用できる。したがって、シンボリックリファレンスを使用することで、日本語の変数名を使用することもできる(こんなことしたいかは別にして)。引用符を忘れないこと(例えば、@{'データ'} はよいが、@{データ} は不可)。

サンプルコード
use strict;
no strict 'refs'; # use strict; を使用しないならこの行は不要。

@{'データ'} = (2, 5, 6, 3, -8, 6);

print ${'データ'}[ 3 ], "\n";

${'合計'} = 0;

foreach (@{'データ'}) { ${'合計'} += $_ }

print ${'合計'}, "\n";

リファレンスの型

リファレンスの型は ref関数を用いて求めることができる。戻り値は次のとおり。

SCALAR       スカラーのリファレンス
ARRAY        配列のリファレンス
HASH         ハッシュのリファレンス
CODE         サブルーチンのリファレンス
GLOB         型グロブのリファレンス
REF          \\23や \[1,2,3]のようなリファレンスのリファレンス
LVALUE       左辺値のリファレンス (\substr や \vec, \posなどによって生成する)
IO::Handle   ファイルハンドルのリファレンス
             (*FH{IO} または *FH{FILEHANDLE} などとして生成する)

しかし、リファレンスがあるパッケージにblessされていると、そのパッケージ名を返す。

そのため、たとえば配列のリファレンスが HASHというパッケージにblessされていると、戻り値は'HASH'になる。だからといってハッシュと考えて %{ } でデリファレンスしようとしても当然うまくいかない。(普通はpackage HASH; なんてしなくて、package Hash;と命名するのかもしれないが)それ以外の(まともな)パッケージ名だとしても、refでは何のレファレンスかは分からない。

もっともblessされているオブジェクトなら、型はコンストラクタに書いてあるはずだから、あらためて検査する必要は、たぶん、ふつうは無いのでしょう。

リファレンスを文字列として評価すると、スカラーなら SCALAR(0x1765274), ハッシュならHASH(0x176f0e8)のような形式をとる。blessされている場合はfoo::bar=HASH(0x176f0e8)のように、等号の前にパッケージ名が添えられる。このような文字列を用いれば、正しいデータ型を求めることができる。

次のコードは、$refから正しいデータ型と、(もしあれば)blessされたパッケージ名を得る。なお、"$ref" とわざわざダブルクオートで囲んでいるのは、そうしなくても次に =~ s/// で評価したときに$strは文字列に変換されるので必要ないが、$strが文字列であることが明確になる(代入時にはすでに文字列に変換されているようになる)。

このようにすると、ファイルハンドルのリファレンスは実は、IO::Handleパッケージにblessされた IO という型名のリファレンスであることがわかる。

サンプルコード
foreach ("$ref") {
   if (s/^(.+)\=//)   { $pkg  = $1 } # $pkg  パッケージ名
   if (s/^([A-Z]+)//) { $type = $1 } # $type データ型
}

なお、文字列化演算子 "" がオーバーロードされているクラスのオブジェクトから型を求めるときは、次のようにして本来の文字列評価の結果を求める。

サンプルコード
use overload;
foreach (overload::StrVal($ref)) {
   if (s/^(.+)\=//)   { $pkg  = $1 } # $pkg  パッケージ名
   if (s/^([A-Z]+)//) { $type = $1 } # $type データ型
}

データのコピー

データは代入でコピーできる。しかしリファレンスを含むときは、そのままコピーすると両者の要素が同じ値を共有しているので、コピーした一方を変更すると、もう一方も同じ変更を受けてしまう。

サンプルコード
@abc = ([1,2,3],[4,5,6],[7,8,9]);
@xyz = @abc;       # そのまま代入
$abc[2][2] = 0;    # 一方の要素を変更すると
print $xyz[2][2];  # こっちも変わってしまう

リファレンスを値だけコピーして、関連をなくしたいときには、デリファレンスしてから改めてリファレンスを生成することで達成することができる。

サンプルコード
$new = [ @$old ];  # 配列のリファレンス
$new = { %$old };  # ハッシュのリファレンス

同じレベルの多次元配列、例えば二次元配列なら、たとえば次のようにする。[cf. perllol, perldsc]

サンプルコード
@newlol = ();
for (@lol) {
   push @newlol, [ @$_ ];
}

または、

@newlol = ();
for (i=0; i<@lol, $i++) {
   $newlol[$i] = [ @{ $lol[$i] } ];
}

しかし構造が複雑になると、単純なループで処理するのは難しい。

次のサブルーチンは、データの値をコピーする。必要なら、新しく生成したリファレンスを元のデータと同じパッケージにblessする。

ただし、スカラー・配列・ハッシュを除くリファレンス、すなわちサブルーチン・ファイルハンドル・型グロブのリファレンスは同じリファレンスのままコピーする。

なお、自己参照的、または相互参照的なレファレンスは、このcloneサブルーチンでは処理できない(再帰呼び出しが無限に終わらなくなる)。

サンプルコード
$new = clone($old);
@new = clone(@old);
%new = clone(%old);

sub clone {                                    #  1
  my(@list, $pkg, $type, @stack, @result);     #  2
  $pkg = $type = '';                           #  3
  if (@_ == 1 && ref $_[0]) {                  #  4
    my $str = "$_[0]";                         #  5
    if ($str =~ s/^(.+)\=//)   { $pkg  = $1 }  #  6
    if ($str =~ s/^([A-Z]+)//) { $type = $1 }  #  7
    @list = $type eq 'ARRAY'  ? @{ $_[0] } :   #  8
            $type eq 'HASH'   ? %{ $_[0] } :   #  9
            $type eq 'SCALAR' ? ${ $_[0] } :   # 10
                                return $_[0];  # 11
  }                                            # 12
  for (@list ? @list : @_) {                   # 13
    push @stack, ref $_ ? clone($_) : $_;      # 14
  }                                            # 15
  @result = $type eq 'ARRAY'  ? [ @stack ] :   # 16
            $type eq 'HASH'   ? { @stack } :   # 17
            $type eq 'SCALAR' ? \$stack[0] :   # 18
                                @stack;        # 19
  return $pkg ? bless($result[0],$pkg) :       # 20
         wantarray ? @result : $result[0];     # 21
}                                              # 22

解説

Data::Dumperモジュールを用いてもコピーができる(ただし現在 Version 2.101 の実装では無名サブルーチンの定義や左辺値リファレンスが失われてしまう。また、ファイルハンドルのリファレンスを含むとeval したときにエラーになってしまう)。

サンプルコード
use Data::Dumper;
eval Data::Dumper->Dump(
      [ $old, [@old], {%old}],
      ['new', '*new', '*new']
);
  # $old -> $new, @old -> @new, %old -> %new のコピーを行う。

Perlのページ