print 1+2+3; # 6 と出力
print(1+2) + 3; # 3 と出力
print (1+2)+3; # これも 3!
print +(1+2)+3; # 6 と出力
print ((1+2)+3); # 6 と出力
Perl に -w スイッチを付けて実行すれば、こういったものには警
告を出してくれます。
print (...) interpreted as function at - line 1.
Useless use of integer addition in void context at - line 1.
となります。
-r ファイルが実効 uid/gid で読み出し可
-w ファイルが実効 uid/gid で書き込み可
-x ファイルが実効 uid/gid で実行可
-o ファイルが実効 uid の所有物
-R ファイルが実 uid/gid で読み出し可
-W ファイルが実 uid/gid で書き込み可
-X ファイルが実 uid/gid で実行可
-O ファイルが実 uid の所有物
-e ファイルが存在する
-z ファイルの大きさがゼロ
-s ファイルの大きさがゼロ以外 (大きさを返す)
-f ファイルは通常ファイル
-d ファイルはディレクトリ
-l ファイルはシンボリックリンク
-p ファイルは名前付きパイプ (FIFO)
-S ファイルはソケット
-b ファイルはブロック特殊ファイル
-c ファイルはキャラクタ特殊ファイル
-t ファイルハンドルは tty にオープンされている
-u ファイルの setuid ビットがセットされている
-g ファイルの setgid ビットがセットされている
-k ファイルの sticky ビットがセットされている
-T ファイルはテキストファイル
-B ファイルはバイナリファイル (-T の反対)
-M スクリプト実行開始時のファイル修正からの日数
-A 同様にアクセスがあってからの日数
-C 同様に inode が変更されてからの日数
があります。
例:
while (<>) {
chop;
next unless -f $_; # 通常ファイル以外はスキップ
...
}
-s/a/b は、置換演算 (s///) の符号反転ではありません。
しかし、-exp($foo) は期待どおりに動作します。
print "Can do.\n" if -r $a || -w _ || -x _;
stat($filename);
print "Readable\n" if -r _;
print "Writable\n" if -w _;
print "Executable\n" if -x _;
print "Setuid\n" if -u _;
print "Setgid\n" if -g _;
print "Sticky\n" if -k _;
print "Text\n" if -T _;
print "Binary\n" if -B _;
($package,$filename,$line) = caller;
を返します。
EXPR を付けると、デバッガがスタックトレースを表示す
るために使う情報を返します。
$cnt = chmod 0755, 'foo', 'bar';
chmod 0755, @executables;
while (<>) {
chomp; # 最後のフィールドの \n を避ける
@array = split(/:/);
...
}
左辺値であれば、代入を含めて、任意のものを chomp で
きます:
chomp($cwd = `pwd`);
chomp($answer = <STDIN>);
リストを chomp すると、個々の要素が chomp され、削除
された文字数の合計が返されます。
while (<>) {
chop; # 最後のフィールドの \n を避ける
@array = split(/:/);
...
}
左辺値であれば、代入を含めて、任意のものを chop でき
ます:
chop($cwd = `pwd`);
chop($answer = <STDIN>);
リストを chop すると、個々の要素が chop されます。
最後の chop の値だけが返されます。
$cnt = chown $uid, $gid, 'foo', 'bar';
chown $uid, $gid, @filenames;
passwd ファイルから数値表現でない uid を検索する例を
示します:
print "User: ";
chop($user = <STDIN>);
print "Files: "
chop($pattern = <STDIN>);
($login,$pass,$uid,$gid) = getpwnam($user)
or die "$user not in passwd file";
@ary = <${pattern}>; # ファイル名の展開
chown $uid, $gid, @ary;
open(OUTPUT, '|sort >foo'); # sort へのパイプ
... # 出力
close OUTPUT; # sort の完了を待つ
open(INPUT, 'foo'); # 結果を入力
FILEHANDLE は、実際のファイルハンドル名を値とする式
でもかまいません。
$pwd = (getpwuid($<))[1];
$salt = substr($pwd, 0, 2);
system "stty -echo";
print "Password: ";
chop($word = <STDIN>);
print "\n";
system "stty echo";
if (crypt($word, $salt) ne $pwd) {
die "Sorry...\n";
} else {
print "ok\n";
}
もちろん、聞かれれば、誰にでもパスワードを打ってあげ
るなんてのは、もってのほかです。
# history ファイルのオフセットを印字
dbmopen(%HIST,'/usr/lib/news/history',0666);
while (($key,$val) = each %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
dbmclose(%HIST);
例:
print if defined $switch{'D'};
print "$val\n" while defined($val = pop(@ary));
die "Can't readlink $sym: $!"
unless defined($value = readlink $sym);
eval '@foo = ()' if defined(@foo);
die "No XYZ package defined" unless defined %_XYZ;
sub foo { defined &$bar ? &$bar(@_) : die "No bar"; }
undef() も参照してください。
foreach $key (keys %ARRAY) {
delete $ARRAY{$key};
}
(ただし、undef() コマンドを使った方が速いでしょう。)
最終的な操作がハッシュの key による検索である限りは、
EXPR には任意の複雑な式を置くことができます:
delete $ref->[$x][$y]{$key};
die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news';
chdir '/usr/spool/news' or die "Can't cd to spool: $!\n"
LIST の評価結果が改行で終わっていなければ、その時点
のスクリプト名とスクリプトの行番号、(もしあれば) 入
力ファイルの行番号と改行文字が、続けて表示されます。
ヒント: メッセージの最後を ", stopped" のようなもの
で終わるようにしておけば、"at foo line 123" のように
追加されて、わかりやすくなります。
die "/etc/games is no good";
die "/etc/games is no good, stopped";
は、それぞれ
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
と表示することになります。
do 'stat.pl';
は、
eval `cat stat.pl`;
と同じようなものですが、より効率的で、簡潔であり、エ
ラーメッセージでファイル名がわかる、カレントディレク
トリでファイルが見つからなかったときに、-I 示すすべ
てのディレクトリを探す、といったことがあります
(perlvar manpage の「定義済み名」にある @INC 配列も
参照してください)。
#!/usr/bin/perl
require 'getopt.pl';
require 'stat.pl';
%days = (
'Sun' => 1,
'Mon' => 2,
'Tue' => 3,
'Wed' => 4,
'Thu' => 5,
'Fri' => 6,
'Sat' => 7,
);
dump QUICKSTART if $ARGV[0] eq '-d';
QUICKSTART:
Getopt('f');
while (($key,$value) = each %ENV) {
print "$key=$value\n";
}
keys() や values() も参照してください。
# 最後のファイルの最終行の前にダッシュを入れる
while (<>) {
if (eof()) {
print "--------------\n";
}
print;
}
# ファイルごとに行番号をリセットする
while (<>) {
print "$.\t$_";
if (eof) { # eof() ではない
close(ARGV);
}
}
現実的なヒント: Perl で eof が必要となることは、ほと
んどありません。
# 0 除算を致命的でなくす
eval { $answer = $a / $b; }; warn $@ if $@;
# 効率的ではないが、同じ
eval '$answer = $a / $b'; warn $@ if $@;
# コンパイル時エラー
eval { $answer = };
# 実行時エラー
eval '$answer ='; # $@ を設定
eval() では、何が調べられるかに、特に注意しておくこ
とが必要です:
eval $x; # CASE 1
eval "$x"; # CASE 2
eval '$x'; # CASE 3
eval { $x }; # CASE 4
eval "\$$x++" # CASE 5
$$x++; # CASE 6
上記の CASE 1 と CASE 2 の動作は同一で、変数 $x 内の
コードを実行します。
exec '/bin/echo', 'Your arguments are: ', @ARGV;
exec "sort $outfile | uniq";
第一引数に指定するものを本当に実行したいが、実行する
プログラムに対して別の名前を教えたい場合には、LIST
の前に、「間接オブジェクト」(コンマなし) として、実
際に実行したいプログラムを指定することができます。
(これによって、LIST に単一のスカラしかなくても、複数
値のリストであるように、LIST の解釈を行ないます。)
例:
$shell = '/bin/csh';
exec $shell '-sh'; # login シェルの振りをする
あるいは、より直接的に、
exec {'/bin/csh'} '-sh'; # login シェルの振りをする
print "Exists\n" if exists $array{$key};
print "Defined\n" if defined $array{$key};
print "True\n" if $array{$key};
ハッシュ要素は、定義されているときにのみ真となり、存
在しているときにのみ定義されますが、逆は必ずしも真で
はありません。
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
die() も参照してください。
use Fcntl;
と書くことが必要でしょう。
use Fcntl;
fcntl($filehandle, F_GETLK, $packed_return_buffer);
$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;
sub lock {
flock(MBOX,$LOCK_EX);
# さらに、待っている間に書き足した
# 人がいるといけないので ...
seek(MBOX, 0, 2);
}
sub unlock {
flock(MBOX,$LOCK_UN);
}
open(MBOX, ">>/usr/spool/mail/$ENV{'USER'}")
or die "Can't open mailbox: $!";
lock();
print MBOX $msg,"\n\n";
unlock();
flock() ではネットワークをまたがって、ロックは行なえ
ません。
$SIG{'CHLD'} = sub { wait };
ダブル fork という仕掛けも使えます (fork の返却値の
エラーチェックは省いています);
unless ($pid = fork) {
unless (fork) {
exec "what you really wanna do";
die "no exec";
# ... または ...
some_perl_code_here;
exit 0;
}
exit 0;
}
waitpid($pid,0);
$login = getlogin || (getpwuid($<))[0] || "Kilroy";
# インターネットの sockaddr
$sockaddr = 'S n a4 x8';
$hersockaddr = getpeername(S);
($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
($name,$passwd,$uid,$gid,
$quota,$comment,$gcos,$dir,$shell) = getpw*
($name,$passwd,$gid,$members) = getgr*
($name,$aliases,$addrtype,$length,@addrs) = gethost*
($name,$aliases,$addrtype,$net) = getnet*
($name,$aliases,$proto) = getproto*
($name,$aliases,$port,$proto) = getserv*
(エントリが存在しなければ、空リストが返されます。)
$uid = getpwnam
$name = getpwuid
$name = getpwent
$gid = getgrnam
$name = getgrgid
$name = getgrent
etc.
getgr*() によって返る値 $members は、グループのメン
バのログイン名をスペースで区切ったものです。
($a,$b,$c,$d) = unpack('C4',$addr[0]);
のようにして、unpack することができます。
# インターネット sockaddr
$sockaddr = 'S n a4 x8';
$mysockaddr = getsockname(S);
($family, $port, $myaddr) =
unpack($sockaddr,$mysockaddr);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
gmtime(time);
のようにして使用します。
@foo = grep(!/^#/, @bar); # コメント行の除去
は
@foo = grep {!/^#/} @bar; # コメント行の除去
は、同じことをします。
require "ioctl.ph"; # たぶん /usr/local/lib/perl/ioctl.ph
としなくてはならないでしょう。
require 'ioctl.ph';
$sgttyb_t = "ccccs"; # 4 つの char と 1 つの short
if (ioctl(STDIN,$TIOCGETP,$sgttyb)) {
@ary = unpack($sgttyb_t,$sgttyb);
$ary[2] = 127;
$sgttyb = pack($sgttyb_t,@ary);
ioctl(STDIN,$TIOCSETP,$sgttyb)
|| die "Can't ioctl: $!";
}
ioctl (と fcntl) の返却値は、
| OS からの返却値 | Perlの返却値 |
| -1 | 未定義値 |
| 0 | "0 but true" という文字列 |
| その他 | OS からの返却値 |
($retval = ioctl(...)) || ($retval = -1);
printf "System returned %d\n", $retval;
のように簡単に知ることができます。
join EXPR,LIST
LIST や ARRAY の個別の文字列を、EXPR の値で区切って
1 つの文字列につなげ、その文字列を返します。
$_ = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
この perlfunc manpage の split の項も参照してくださ
い。
$cnt = kill 1, $child1, $child2;
kill 9, @goners;
シェルとは異なり、Perl では、シグナルに負の数を与え
ると、プロセスではなく、プロセスグループに対して、
kill を行ないます。
sub RANGEVAL {
local($min, $max, $thunk) = @_;
local $result = '';
local $i;
# $thunk が $i へのリファレンスを作るとでしょう
for ($i = $min; $i < $max; $i++) {
$result .= eval $thunk;
}
$result;
}
if ($sw eq '-v') {
# ローカル配列をグローバル配列で初期化
local @ARGV = @ARGV;
unshift(@ARGV,'echo');
system @ARGV;
}
# @ARGV が戻される
# 一時的に連想配列 digits に加算
if ($base12) {
# (NOTE: これにこだわらない方が効率的 !)
local(%digits) = (%digits,'t',10,'e',11);
parse_num();
}
Local() は実行時のコマンドですから、ループを通るごと
に実行されることに注意してください。
local($foo) = <STDIN>;
local @FOO = <STDIN>;
は、どちらも右辺にリストコンテキストをもたらしますが、
local $foo = <STDIN>;
では、スカラコンテキストになります。
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
のようにして使用します。
$now_string = localtime; # 例 "Thu Oct 13 04:54:34 1994"
perlmod manpage の timelocal の項や POSIX モジュール
によって使用できる strftime(3) 関数も参照してくださ
い。
@chars = map(chr, @nums);
は、数のリストを対応する文字に変換します。
また、
%hash = map {&key($_), $_} @array;
は、
%hash = ();
foreach $_ (@array) {
$hash{&key($_)} = $_;
}
をちょっと変わった書き方で書いたものです。
my $_; # 不正
とはできません。
sub RANGEVAL {
my($min, $max, $thunk) = @_;
my $result = '';
my $i;
# $thunk が $i へのリファレンスを作るとでしょう
for ($i = $min; $i < $max; $i++) {
$result .= eval $thunk;
}
$result;
}
if ($sw eq '-v') {
# my 配列をグローバル配列で初期化
my @ARGV = @ARGV;
unshift(@ARGV,'echo');
system @ARGV;
}
# 外部の @ARGV が再び見えるようになる
EXPR に代入を行なうとき、my は EXPR がスカラとして参
照されるか、配列として参照されるかには、影響しません。
つまり、
my($foo) = <STDIN>;
my @FOO = <STDIN>;
は、どちらも右辺にリストコンテキストをもたらしますが、
my $foo = <STDIN>;
では、スカラコンテキストになります。
なるべく、字句スコープの変数を使うようにすることもあ
るでしょう。
use strict 'vars';
とすれば、その場所から囲っているブロックの最後までは、
字句変数か、パッケージ名で完全に修飾した変数でなけれ
ば、参照できないように制限できます。
LINE: while (<STDIN>) {
next LINE if /^#/; # コメントを捨てる
...
}
continue ブロックが存在すれば、たとえ捨てられる行に
あっても、それが実行されます。
LABEL が省略されると、
このコマンドは、もっとも内側のループを参照します。
$val = oct($val) if $val =~ /^0/;
EXPR を省略すると、$_ を使用します。
$ARTICLE = 100;
open ARTICLE or die "Can't find article $ARTICLE: $!\n";
while (<ARTICLE>) {...
open(LOG, '>>/usr/spool/news/twitlog'); # (log は予約語)
open(article, "caesar <$article |"); # 記事の復号
open(extract, "|sort >/tmp/Tmp$$"); # $$ は現 pid
# include を使っているファイルのリストを処理する
foreach $file (@ARGV) {
process($file, 'fh00');
}
sub process {
local($filename, $input) = @_;
$input++; # マジカルインクリメント
unless (open($input, $filename)) {
print STDERR "Can't open $filename: $!\n";
return;
}
while (<$input>) { # 間接ファイルハンドル
if (/^#include "(.*)"/) {
process($1, $input);
next;
}
... # 好きな処理
}
}
Bourne シェルの慣例にしたがって、EXPR の先頭に ">&"
を付けると、EXPR の残りの文字列をファイルハンドル名
(数字であれば、ファイル記述子) と解釈して、それを dup
してオープンします。
#!/usr/bin/perl
open(SAVEOUT, ">&STDOUT");
open(SAVEERR, ">&STDERR");
open(STDOUT, ">foo.out") || die "Can't redirect stdout";
open(STDERR, ">&STDOUT") || die "Can't dup stdout";
select(STDERR); $| = 1; # バッファリングしない
select(STDOUT); $| = 1; # バッファリングしない
print STDOUT "stdout 1\n"; # これはサブプロセス
print STDERR "stderr 1\n"; # でも働きます
close(STDOUT);
close(STDERR);
open(STDOUT, ">&SAVEOUT");
open(STDERR, ">&SAVEERR");
print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";
N を数値として、"<&=N" と指定すると、Perl は、そのフ
ァイル記述子に対する C の fdopen() と同じことを行な
います。
open(FILEHANDLE, "<&=$fd")
"-|" や "|-" というふうに、"-" というコマンドにパイ
プをオープンすると、fork が行なわれ、open の返却値と
して、親プロセスにはチャイルドプロセスの pid が、チ
ャイルドプロセスには 0 が返されます。
open(FOO, "|tr '[a-z]' '[A-Z]'");
open(FOO, "|-") || exec 'tr', '[a-z]', '[A-Z]';
open(FOO, "cat -n '$file'|");
open(FOO, "-|") || exec 'cat', '-n', $file;
パイプのファイルハンドルを明示的に close することで、
親プロセスは、チャイルドプロセスの終了を待ち、$? に
ステータス値を返します。注: fork を行なう操作では、
フラッシュされていないバッファがあると、fork 後には、
そのバッファの内容が両方のプロセスで残ったままになっ
てしまいますから、出力がダブらないように $| を設定す
る必要があるかもしれません。
オープンするために渡されたファイル名は、はじめと終わ
りの空白が取り除かれます。
$file =~ s#^(\s)#./$1#;
open(FOO, "< $file\0");
a ASCII 文字列、ヌル文字で埋める
A ASCII 文字列、スペース文字で埋める
b ビット列 (昇ビット順、vec() と同じ)
B ビット列 (降ビット順)
h 16 進数文字列 (低位ニブルが先)
H 16 進数文字列 (高位ニブルが先)
c signed char 値
C unsigned char 値
s signed short 値
S unsigned short 値
i signed int 値
I unsigned int 値
l signed long 値
L unsigned long 値
n "network" 順序 (ビッグエンディアン) の short
N "network" 順序 (ビッグエンディアン) の long
v "VAX" 順序 (リトルエンディアン) の short
V "VAX" 順序 (リトルエンディアン) の long
f 機種依存の単精度浮動小数点数
d 機種依存の倍精度浮動小数点数
p ヌル文字で終端する文字列へのポインタ
P 構造体 (固定長文字列) へのポインタ
u uuencode 文字列
x ヌル文字
X 1 文字後退
@ 絶対位置までヌル文字で埋める
これらの文字の後には、繰り返し数を示す数字を付けるこ
とができます。
例:
$foo = pack("cccc",65,66,67,68);
# $foo eq "ABCD"
$foo = pack("c4",65,66,67,68);
# 同じ
$foo = pack("ccxxcc",65,66,67,68);
# $foo eq "AB\0\0CD"
$foo = pack("s2",1,2);
# リトルエンディアンでは、"\1\0\2\0"
# ビッグエンディアンでは、"\0\1\0\2"
$foo = pack("a4","abcd","x","y","z");
# "abcd"
$foo = pack("aaaa","abcd","x","y","z");
# "axyz"
$foo = pack("a14","abcdefg");
# "abcdefg\0\0\0\0\0\0\0"
$foo = pack("i9pl", gmtime);
# 実際の struct tm (とにかく私のシステムでは)
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}
一般には、pack で使用したものと同じテンプレートが、
unpack 関数でも使用できます。
$tmp = $ARRAY[$#ARRAY--];
と同じ効果があります。
for $value (LIST) {
$ARRAY[++$#ARRAY] = $value;
}
とするのと同じ効果がありますが、より効率的です。
q/STRING/
qq/STRING/
qx/STRING/
qw/STRING/
汎用のクォート。
# 単純な Pascal のコメント除去プログラム
# (警告: 文字列中には { や } がないと仮定)
LINE: while (<STDIN>) {
while (s|({.*}.*){.*}|$1 |) {}
s|{.*}| |;
if (s|{.*| |) {
$front = $_;
while (<STDIN>) {
if (/}/) { # コメントの終わり
s|^|$front{|;
redo LINE;
}
}
}
print;
}
REF
SCALAR
ARRAY
HASH
CODE
GLOB
があります。
if (ref($r) eq "HASH") {
print "r is a reference to an associative array.\n";
}
if (!ref ($r) {
print "r is not a reference at all.\n";
}
perlref manpage も参照してください。
sub require {
local($filename) = @_;
return 1 if $INC{$filename};
local($realfilename,$result);
ITER: {
foreach $prefix (@INC) {
$realfilename = "$prefix/$filename";
if (-f $realfilename) {
$result = do $realfilename;
last ITER;
}
}
die "Can't find $filename in \@INC";
}
die $@ if $@;
die "$filename did not return true value" unless $result;
$INC{$filename} = $realfilename;
$result;
}
ファイルは、同じ名前で 2 回読み込まれることはありま
せん。
reset 'X'; # すべての X 変数をリセット
reset 'a-z'; # 小文字変数をリセット
reset; # ?? 検索だけをリセット
reset "A-Z" とすると、ARGV や ENV といった配列もなく
なってしまいますから、止めた方が良いでしょう。
select(REPORT1);
$^ = 'report1_top';
select(REPORT2);
$^ = 'report2_top';
のようにしなければならないでしょう。
FILEHANDLE は、実際のファイルハンドルの名前を示す、
式でもかまいません。
$oldfh = select(STDERR); $| = 1; select($oldfh);
のようなものです。
Perl 5 では、ファイルハンドルはメソッドを持ったオブ
ジェクトですから、最後の例は
use FileHandle;
STDERR->autoflush(1);
のように書くと良いでしょう。
$rin = $win = $ein = '';
vec($rin,fileno(STDIN),1) = 1;
vec($win,fileno(STDOUT),1) = 1;
$ein = $rin | $win;
のようにして作成することができます。
複数のファイルハンドルに select を行ないたいのであれ
ば、
sub fhbits {
local(@fhlist) = split(' ',$_[0]);
local($bits);
for (@fhlist) {
vec($bits,fileno($_),1) = 1;
}
$bits;
}
$rin = &fhbits('STDIN TTY SOCK');
のようなサブルーティンを書くとよいでしょう。
通常は、
($nfound,$timeleft) =
select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
のように使い、いずれかの準備が整うまでブロックするに
は、
$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
のようにします。
select(undef, undef, undef, 0.25);
のようにして得られます。
$semop = pack("sss", $semnum, -1, 0);
die "Semaphore trouble: $!\n" unless semop($semid, $semop);
は、セマフォ ID $semid のセマフォ $semnum で待ち合わ
せを行ないます。
例:
# 文字の順でソート
@articles = sort @files;
# 同じことを明示的にソートルーティンを指定して
@articles = sort {$a cmp $b} @files;
# 同じことを逆順に
@articles = sort {$b cmp $a} @files;
# 数値の昇順にソート
@articles = sort {$a <=> $b} @files;
# 数値の降順にソート
@articles = sort {$b <=> $a} @files;
# サブルーティン名を指定してソート
sub byage {
$age{$a} <=> $age{$b}; # 整数を仮定
}
@sortedclass = sort byage @class;
sub backwards { $b cmp $a; }
@harry = ('dog','cat','x','Cain','Abel');
@george = ('gone','chased','yz','Punished','Axed');
print sort @harry;
# AbelCaincatdogx と出力
print sort backwards @harry;
# xdogcatCainAbel と出力
print sort @george, 'to', @harry;
# AbelAxedCainPunishedcatchaseddoggonetoxyz と出力
push(@a,$x,$y) splice(@a,$#a+1,0,$x,$y)
pop(@a) splice(@a,-1)
shift(@a) splice(@a,0,1)
unshift(@a,$x,$y) splice(@a,0,0,$x,$y)
$a[$x] = $y splice(@a,$x,1,$y);
次の例では、配列の前に、それぞれの配列の大きさが渡さ
れるものとしています:
sub aeq { # 2 つのリスト値を比較する
local(@a) = splice(@_,0,shift);
local(@b) = splice(@_,0,shift);
return 0 unless @a == @b; # 長さは等しいか
while (@a) {
return 0 if pop(@a) ne pop(@b);
}
return 1;
}
if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... }
print join(':', split(/ */, 'hi there'));
は、'h:i:t:h:e:r:e' という出力になります。
LIMIT を使うと、行を部分的に split することができま
す。
($login, $passwd, $remainder) = split(/:/, $_, 3);
リストへ代入するとき、LIMIT を省略すると、Perl は、
無駄な仕事を避けるため、そのリストの変数の数より、1
つだけ大きい LIMIT が与えられたものとして処理を行な
います。
split(/([,-])/, "1-10,20");
は、リスト値
(1, '-', 10, ',', 20)
を生成します。
/PATTERN/ は、実行時に変わるパターンを指定する式で置
き換えることができます。
例:
open(passwd, '/etc/passwd');
while (<passwd>) {
($login, $passwd, $uid, $gid,
$gcos, $home, $shell) = split(/:/);
...
}
(上記の $shell には、まだ改行がついたままです。
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
のようにして使います。
下線だけの _ という、特別なファイルハンドルを、stat
に渡すと、実際には stat を行なわず、stat 構造体に残
っている、前回の stat やファイルテストの情報が返され
ます。
if (-x $file && (($d) = stat(_)) && $d < 0) {
print "$file is executable NFS file\n";
}
(これは、NFS のもとでデバイス番号が負になるマシンで
のみ動作します。)
while (<>) {
study;
print ".IX foo\n" if /\bfoo\b/;
print ".IX bar\n" if /\bbar\b/;
print ".IX blurfl\n" if /\bblurfl\b/;
...
print;
}
"f" は "o" よりもめずらしいので、/\bfoo\b/ を探すと
き、$_ で "f" を含む場所だけが探されます。
$search = 'while (<>) { study;';
foreach $word (@words) {
$search .= "++\$seen{\$ARGV} if /\\b$word\\b/;\n";
}
$search .= "}";
@ARGV = @files;
undef $/;
eval $search; # ぶっ飛ばす
$/ = "\n"; # 入力のデリミタをもとに戻す
foreach $file (sort keys(%seen)) {
print $file, "\n";
}
$symlink_exists = (eval 'symlink("","");', $@ eq '');
require 'syscall.ph'; # h2ph を実行する必要があるかも
syscall(&SYS_write, fileno(STDOUT), "hi there\n", 9);
Perl は、システムコールに最大 14 個の引数しか渡せま
せんが、実用上問題はないでしょう。
# print out history file offsets
tie(%HIST, NDBM_File, '/usr/lib/news/history', 1, 0);
while (($key,$val) = each %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
untie(%HIST);
連想配列をインプリメントするパッケージでは、次のよう
なメソッドを用意します:
TIEHASH objectname, LIST
DESTROY this
FETCH this, key
STORE this, key, value
DELETE this, key
EXISTS this, key
FIRSTKEY this
NEXTKEY this, lastkey
通常の配列をインプリメントするパッケージでは、次のよ
うなメソッドを用意します:
TIEARRAY objectname, LIST
DESTROY this
FETCH this, key
STORE this, key, value
[others TBD]
スカラ変数をインプリメントするパッケージでは、次のよ
うなメソッドを用意します:
TIESCALAR objectname, LIST
DESTROY this
FETCH this,
STORE this, value
($user,$system,$cuser,$csystem) = times;
undef $foo;
undef $bar{'blurfl'};
undef @ary;
undef %assoc;
undef &mysub;
return (wantarray ? () : undef) if $they_blew_it;
$cnt = unlink 'a', 'b', 'c';
unlink @goners;
unlink <*.bak>;
注: スーパーユーザ権限で、Perl に -U を付けて実行し
た場合でなければ、unlink でディレクトリを削除するこ
とはありません。
sub substr {
local($what,$where,$howmuch) = @_;
unpack("x$where a$howmuch", $what);
}
そして、
sub ordinal { unpack("c",$_[0]); } # ord() と同じ
ということもできます。
さらに、フィールドの前に %<数値> というものを付けて、
項目自身の代わりに、その項目の <数値>-ビットのチェッ
クサムを計算させることができます。
while (<>) {
$checksum += unpack("%16C*", $_);
}
$checksum %= 65536;
は、System V の sum プログラムと同じ値を計算します。
また、
$setbits = unpack("%32b*", $selectmask);
は、効率的に、ビットベクターの設定されているビットを
数えるものです。
unshift(ARGV, '-e') unless $ARGV[0] =~ /^-/;
LIST は、はらばらにではなく、一度に登録されるので、
順番はそのままです。
BEGIN { require Module; import Module LIST; }
というのと、全く同値です。
use integer;
use sigtrap qw(SEGV BUS);
use strict qw(subs vars refs);
use subs qw(afunc blurfl);
通常のモジュールが、現在のパッケージにシンボルをイン
ポートする (これは、ファイルの終わりまで有効です) の
に対して、これらの擬似モジュールは、現在のブロックス
コープにインポートを行ないます。
no integer;
no strict 'refs';
標準モジュールやプラグマの一覧は、perlmod manpage を
参照してください。
#!/usr/bin/perl
$now = time;
utime $now, $now, @ARGV;
$bits = unpack("b*", $vector);
@bits = split(//, unpack("b*", $vector));
のようにします。
use POSIX "wait_h";
...
waitpid(-1,&WNOHANG);
とすると、ブロックが起こらないようにして、任意のプロ
セスを wait します。
return wantarray ? () : undef;