minimal_perl2

sort関数

典型的な呼び出し形式
sort LIST reverse sort LIST sort { CODE-BLOCK } LIST reverse sort { CODE-BLOCK } LIST
例	説明
@A=sort @A ; #A-Zの順 #　上記の明示バージョン @A=sort { $a cmp $b } @A; #　上記の逆順バージョン @A=reverse sort @A; @B=sort {$a <=> $b} @B; @B=reverse sort @B; $,='\n"; print sort @C;	第一の例は@Aの要素を英数字順に並べ替える。第二の例は文字比較演算子のcmpを使ったデフォルトの並び替え規則を指定して同じ結果を要求する明示的な方法。 reverseは昇順＜ー＞降順数値比較演算子を使った並べ替え規則にしたがって配列@の要素を並べ替える。reverseはリストを逆順に並べ替える。 @Cの要素を1行に1つづつ英数字順で表示。

intra_line_sort スクリプト

#! /usr/bin/perl -s -wn

our ($debug);                        # スイッチはオプション

$debug and chomp               #　"<-"と　$_を同じ行に表示
$debug and print "$_ <- Original\n";
$,=" ";                                  #　表示時にスペースで区切る

# 空白文字を区切りとして行を分割してソート
print sort {$a <=> $b} split; #　数のソート

debug and print " <- Sorted\n";
print "\n";　　　　　　　#　出力上でレコードを分離

grep 関数

典型的な呼び出し形式
grep {CODE-BLOCK} LIST
例	説明
@B=grep { /^[a-z]/i } @A; @B=grep { -d } @A; @B=grep { rand >= .5 } @A $,='\n"; print grep { length >3 } @A;	@A中の要素で英文字で始まるものを@Bに格納。 @Aの要素でディレクトリファイル名のものを＠Bに @から無作為に選択した要素を@Bに @Ａ中の3文字を越えるながさの要素を出力

join関数

典型的な呼び出し形式
join STRING, LIST
例	説明
$properties=join '/',$size,$shape,$color; $string_with_NLS=join "",@strings_with_NLS; $strings_with_NLS=join "\n",@strings_without_NLS	スカラー変数の値を単一の文字列に結合。要素と要素はスラッシュで区切る。 $propertiesの結果例:huge/irregular/clear 配列の要素を結合し，ニューラインで終わるレコード群からなる単一の文字列にする.上の例では(既にニューラインで終わっている文字列用に)要素と要素の間に空文字列を挿入し，下の例では(ニューラインのついてない文字列用に)ニューラインを挿入。

map関数

典型的な呼び出し形式
map { CODE-BLOCK } LIST
例	説明
@B=map { sqrt } @A; @B=map { "\L$_" } @A; @A=map { "$_\n" } @A; $,=' '; print map { "'$_ '"} @A;	@Aの各要素の平方根と小文字バージョンを@Bに格納 @Ａの各要素にニューラインを付加したものを＠Ａに格納 @Aの各要素をシングルクォートで囲んでスペースで区切った結果を出力。

グロブ演算子(file name generation:FNG)
ファイル名を山括弧で囲むことで呼び出される。

典型的な呼び出し形式
<pattern> <pattern1>,<pattern2>,等
例	説明
@files=<pattern>; @files=(<pattern1>, <pattern2>); $,="\n"; print <pattern1>, <pattern2>; print sort <pattern1>, <pattern2>;	patternにマッチするファイル名を@filesに格納。 pattern1 または　pattern2 にマッチするファイル名を@filesに格納。グロブの結果を変数に直接代入する場合は複数のグロブ演算市をコンマで区切って括弧で囲む。 pattern1またはpattern2にマッチするファイル名を\nで釘って出力。pattern1にマッチするものを英数字順で出力してからpattern2にマッチするものを出力。第2の例はマッチするファイル名の集合全体をソート処理してから出力。

グロブ演算子のFNGメタキャラクタ

メタキャラクタ	意味	例	マッチする例
? [xyz] [c1-c2] [!xyz] [!c1-c2] *	任意の１文字角括弧の中に明示的に列挙した任意の文字(クラス) c1からc2の範囲のものをすべて含め，先頭の！の後に指定したものは除外する。任意の文字(重複可）または何もなし	<f?.txt>, <.?> <[abc].txt> <f[0-9].txt> <f[!0-9].txt> <.txt> <f>	f2.txt, fX.txt .., .a, .9 a.txt, b.txt, c.txt f2.txt, f8.txt fX.txt, f%.txt f2.txt, fX.txt, H.txt f2.txt, fX.txt, fud

FNG記法と正規表現記法の対応関係

FNG	正規表現	意味
? * [a-z] [!a-z]	. .* [a-z] [^a-z]	一つの文字 0個以上の文字小文字の英文字小文字の英文字ではない１文字
a* *a abc	^a a$ ^abc$	"a"で始まる "a"で終わる正確に"abc"
該当なし	X?, X*, X+	0または１文字，0または文字以上、１文字以上の「ｘの連続」

ディレクトリ管理のための関数

perl関数	対応するUnix親族	呼び出し形式	説明
chdir mkdir rmdir	cd mkdir rmdir	Function dirname or die "$0: Function failed: ", $!;	ディレクトリdirnameについて，切り替え，作成，削除を行うか(dieによって）プログラムを終了する。rmdirが成功するにはそのディレクトリが空でなければならない。成功か失敗を表す真偽値を返す。

ファイル管理のための関数

perl関数	対応するUnix親族	呼び出し形式または呼び出し例	説明
umask	umask	umask 0022; #所有者についてのみ書き込み可 printf "Umask is : %040\n", umask;	新たに作成されたファイルにデフォルトで許可されるアクセス権を剥奪する8進数のビットマスクを設定。００２２はグループとその他に付いて書き込み権を剥奪。
chmod chown unlink	chmod chown rm	$success=chmod perm_num,file(s); $success=chown UID_num, GID_num,file(s); $success=unlink file(s);	8進数によるアクセス権指定perm_num(例えば０７５５）を使ってfaile(s)のアクセス権を設定。 file(s)を所有者UID_num及びグループGID_numと関連付ける。ディレクトリからfile(s)の名前を削除。
rename move copy	mv mv cp	remname old,new or die "$0: rename failed: $!"; use File::Copy; #モジュールをロード move old, new or die "$0: move failed: $!"; use File::Copy; #モジュールをロード copy old, new or die "$0: copy failed: $!";

スクリプトの作成

exit関数

シェル	Perl	説明
exit exit 0 exit 1-255	exit; exit 0; exit 1-255;	引数なしの場合シェルのexitは$?変数の最後の値を親プロセスに返すことでプログラムの成功または失敗を表す。Perlはデフォルトで0を返して成功を表す。引数の0はのスクリプト成功を表す. １から２５５迄はスクリプトの失敗を表す.

シェルとperlにおけるshiftとunshiftの使い方

シェル	Perl	説明
shift 該当なし shift 2 該当なし該当なし	shift; $variable=shift; shift; shift;　または $arg1=shift; $arg2=shift; shift @any_array; unshift @array1, @array2	左端の引数を削除し他のすべての引数を１つ左にずらす Perlでは削除された引数がshiftから返されるためそれを変数に保存できるシェルのshiftはずらす個数のオプションがある. 同様のことをperlで実現するには、shiftを複数回呼び出す。 perlのshiftは，配列の名前を引数にとることが出来，その指定されたものをデフォルトの対象(通常は@ARGV,サブルーチン内では@_）の代わりに処理の対象にする。 Perlのunshiftは@array1の最初の内容の前に@array2の内容が含まれるようarray1を初期化しなおす。例えば @array1=(a,b),@array2=(1,2) => array1は(1,2,a,b)となる。

if /else構造

Shell	Perl
if condition then commands else commands fi	if (condition) { code; } else { code; }
if cond; then cmds; else cmds; fi	if (cond) {code;} else {code;}

ネストしたif/elseとelsif

else中のif/else	代わりのelsif
if (A) { print 'Acase'; } else { #　この括弧が消える if (B) { print 'Bcase'; } else { print 'other case'; } } #　この括弧が消える	if (A) { print 'Acase'; } elsif (B) { print 'B case'; } else { print 'other case'; }

cd_report

cd_report スクリプト

#! /usr/bin/perl -s -wnlaF'\t+'
our (search,$a,$t,$r); #
BEGIN {
$num_field=3; #
sel_cds=0; #
$options=( defined $r or defined $a or
defined $tor defined $search);
print "TITLE\t\t\tARTIST\t\tRATING"; #
}
####
( $title,$artist,$rating )=@F;
$fcount=@F;
if ( $count != $num_fieldsw ) { #
warn "\n\tBad field count of $fcount on line #$.; skipping!";
}
else {
$selected=( #
defined $t and $title =~ /$t/i or #
defined $a and $artist=~ /$a/i or #
definde $search and /$search/i or #
! $options #
);
if ( $selectes ) {
$sel_cd++;
$num_ratings+=$rating;
print;
}
}
END {
$num_cd=$.;
if ( $r and $sel_cds >0 ) {
$ave_rating= $sum_rating / $sel_cds;
print "\n\tAverage Rating for $sel_cds CDs: $ave_rating";
}
print "\nProcesses $num_cds CD records"+
}

文字列の連結演算子と反復演算子

名前	記号	例	結果	説明
連結演算子反復演算子	. x	$ab='A'.'B'; $abc=$ab."C"; $abc='A'; $abc.='B'; $abc.='C'; $dashes='-' x 4; $spaces=' ' x2	AB ABC A AB ABC ---- &Square;&Square;	連結演算子は左辺と右辺の文字列を結合。代入演算子との組で使われると右を左に追加。(.＝）反復演算子は左辺の文字列を指定された回数繰り返す。

シェルとPerlに置けるコマンド置換/コマンド展開

シェル	Perl	説明
var=`cmd` または var=$(cmd) array=(`cmd`) または array=($(cmd)) cmd2 `cmd` または cmd2 $(cmd) ”‘cmd‘” または "$(cmd)"	$var=`cmd` @array=`cmd` function `cmd` または function scalar `cmd` `cmd`	cmd中の変数置換がダブルクォートで囲まれているかのように処理されそれからcmdが処理され出力が変数に代入される。cmdの終了値が$?に格納。 cmd の出力が上記と同様に処理され、シェルの場合「語群」perlの場合 $/区切りのレコード群が配列に代入される。 cmdが処理されてからシェルでは個々の出力がcmd2に渡される。Perlのリストコンテキストでは出力の各レコードがfunctionに個々の引数として渡される。 Perlのスカラーコンテキストではすべてが単一の引数として渡される。シェルではcmdの出力を更なる処理から保護するためにダブルクォートが必要。 Perlでは不可。シェルの例ではcmdの出力全体が１行になるのに大してPerlの例では$/区切りのレコード群リストになる。

tputによる画面表示の制御と問い合わせ。

表示モード	有功にするオプション	無効にするオプション
強調下線付き太字半輝度点滅	smso smul bold dim blink	rmso rmul sgr0 sgr0 sgr0
ターミナル情報	オプション	説明
列行	cols lines	列数を報告行数を報告

highlight_trailing_ws スクリプト

#! /usr/bin/perl -wpl
BEGIN {
$ON = `tput smso`; # start mode "standout"
$OFF = `tput rmso`; # remove mode "standout"
}
# <white space> を反転させて注意を引く
s/[<space>\t]+$/$ON<whitespace>$OFF/g;

rgrep スクリプト

#! /usr/bin/perl -wnl
BEGIN {
$Usage="Usage: $0 'pattern' dir1 {dir2 ...]";
@ARGV >= 2 or warn "$Usage\n" and exit 255;
$pattern=shift #
# `@ARGV` は"@ARGV"のように扱われる.要素はスペース区切り
@files=grep {chomp; -r and -T } #
`find @ARGV -follow -type f -print`;
@files or warn "$0: No files to search\n" and exit 1;
@ARGV=@files; #
}
#
#
/$pattern/ and printf "$ARGV: " and print;

system 関数

例

説明

system 'command(s)';
system "command(s)";

system 'command(s)';
! $? or warn 'failed';

シングルクォート中のコマンドは変更なしで実行される。
ダブルクォート中のコマンドは変数展開されてから実行
される。場合によってはコマンド引数をシングルクォート
で囲んでシェルが実行しないようにする。
function or warn がPerlの関数の失敗を報告するのと同様
! $? or warnはsystemが実行したコマンドの失敗を報告する
!はUnixの真偽値をperlの真偽値に変換する。

news_flash スクリプト

#! /usr/bin/perl -wl
$width=(`tput cols` or 80); #
$line='-' x $width; #
$heading='NEWS FLASH:';
$heading=' '.`date '+%X'`; #
chomp $heading; #
# 中央揃え
$heading_length=length $heading;
$offset=(width - $heading_length) / 2;
#
#
"padding=' ' x $offset; #
print "$line"; #
print "$padding$heading"; #
print "$line\n"; #

news_flash2 スクリプト

#! /usr/bin/perl -s -wl
our ($debug);
$file=shift; #
if (! defined $file or ! -T $file) {
die "Usage: $0 filename\n";
}
#画面制御
$REV=( `tput smso` or "");
$NO_REV=(`tput rmso` or "");
$UL=( `tput smul` or "");
$NO_UL=( `tput rmul` or "");
$width=(`tput cols` or 80); #
chomp $width; #
$line='-' x $width; #
$heading='NEWS FLASH:';
$heading=' '.`date '+%X'`; #
chomp $date; #
# 中央揃え
$msg_length=length "$heading $date
$offset=(width - $msg_length) / 2;
#
#
"padding=' ' x $offset; #
print "$line"; #
print $padding, $REV, $heading, $NO_REV, " ",
$UL, $date, $NO_UL;
print "$line\n"; #
#
$command="fmt -$width 'file'"; #
$debug and warn "Command is:\n\t$command\n\n"and
$command="set -x; $command"; #
system $command; #
! $? or warn "$0: This command failed: $command\n";

シェルとPerlのeval関数

シェル	Perl
eval 'command' error=$? (($error > 0)) && echo "failed: $error" >&2	eval 'stuff'; # $@を設定 $@ ne "" and warn "failed: $@";
該当なし	eval; # $_中のコードを評価

psh スクリプト

#! /usr/bin/perl -wnl
BEGIN {
$ON=`tput smso`;
$OFF=`tput rmso`;
$prompt="${ON}psh>$OFF;
print $prompt;
}
eval;
$@ ne "" and warn $@;
print $prompt;
END {
#
#
#
! defined and print ""; #
}

preg スクリプト

#! /usr/bin/perl -s -wnl
our ($f, $i, $l, $v, $n, $d, $p, $m, $s, $r); #
BEGIN {
$Usage="Usage: $0 [-f] [-i] [-l] [-v] [-n] [-d];
$Usage.=" [-p|-c] [-m][-s] [-r] 'RE' [file...]\n";
# 少なくともパターン因数は必要
@ARGV >0 or warn "$Usage" and exit 255;
# 両立できないスイッチは不可
defined $p and defined $c and
warn "$Usagen \n\tCan`t have -p and -c\n" and exit 1;
$X='g';
$ON=$OFF="";
if ($d) {
$ON=(`tput smso` or "") ; $OFF=(`tput rmso` or "");
};
$p and $/="";
$c and $/=$c;
$i and $X.="i";
$m and $X.="m";
$s and $X.="s";
$pattern=shift @ARGV;
$f and $pattern=`\Q` .$pattern. '\E';
$r and @ARGV=grep { chomp; -T }
`find @ARGV -follow -type f -print`;
$multifiles=@ARGV >1;
$matcher="s/$pattern/$ON\$&$OFF/$X";
$v and $matcher="! $matcher";
}
#####
$found_match=eval $matcher;
if ( $@ne "" ) { #
warn "\n$0: Eval failed for pattern: '$matcher'\n\n";
die "Perl says:\n$a\n";
}
elsif ($found_match) {
if ($1) {print $ARGV; close ARGV;}
elseif ($multifiles) { print "$ARGV:"; }
if (! $1) {
$n and print "$.:";
print;
$p and print "";
}
}

リスト変数

シェルとperlにおける配列の構文

	シェル	Perl	備考
値の代入値の取得と表示値の削除複数の値の代入すべての値の取得と表示	n[0]=13 echo ${n[0]} unset n[0] n=(13 42) echo "${n[@]}"	$n[0]=13; print $n[0]; delete $n[0]; @n=(13, 42); @n=qw/13 42/; @n=qw!\ \| /!; print "@n";	Perlではスカラー値を参照する場合常に変数名に$記号を使う. シェルでは値を取得する場合のみ$記号を使うシェルでは配列の名前と添字を波括弧で囲むシェルは指定された要素を削除、Perlは要素の値を未定義にした後もそのスロットを維持する。シェルは括弧内の初期値のリストにおける空白文字をセパレータとして認識する。perlではデフォルトでコンマが必要で追加の空白文字が可能。qwXの構文では、対をなすXデリミタの間で空白文字だけが認識される

shell_types スクリプト

#! /usr/bin/perl -wnlaF':'
BEGIN {
@ARGV=( '/etc/passwd' ); #
}
#
if ( $F[-1] =~ /sh$/ ) {
push @human, $F[0];
}
else {
push @inhuman, $F[0];
}
END {
$=', ';
print "\UThese account use human shells: \E\n@human\n";
print "\UThese accounts use inhuman shells:\E\n@inhuman";
}

show_field2 スクリプト

#! /usr/bin/perl -wnla
BEGIN {
$Usage="Usage: $0 '2,1,4..7,etc' [file1 ...]";
#　フィールド番号の順序が表示順になる
#　先頭フィールドは１で固定する
　
　
#　フィールド指定をチェック
defined $fields and $friends =~ /^[\d,.]+$/g or
warn "$Usage\n" and exit 1;
#　5，2..4=>5，2，3，4と変換し、
#　それらの添字番号を@fieldに保存
@fields=eval "( $fields )";
}
if (@F >0) {
#
unshift @F,
"$Usage\n\tThere's no field #0! The first is #1.\n";
print "@F[ @fields ]"; #
}

fcookie スクリプト

#! /usr/bin/perl -wnl
BEGIN {
@ARGV=('/usr/share/games/fortunes/satrtrek');
$/='%';
}
#
push @fortunes,$_;
END {
print @fortunes[ rand @fortunes ];

fcookie2 スクリプト

#! /usr/bin/perl -wnl
#
BEGIN {
@ARGV or #
@ARGV=( '/ust/share/games/fortunes/startrek' );
push @ARGV, '-'; #
$/='%';
$initializing=1; #
}
############
if ($initializing) {
push @fortunes, $_; #
if (eof) {
$initializing=0;
$/="\n";
print 'Press <Enter> for a future, or <^D>: ';
}
}
#########
else {
#
#
#
$index=rand @fortunes; #
printf $fortunes[ $index ];
delete $fortunes[ $index];
@fortunes=grep { defined } @fortunes; #
@fortunes or
die "\n$0: How unfortunate; out of fortunes!\n";
}

電話番号のハッシュ

%phone
キー	値
Joe Jan	789-9843 897-7164

Perlのハッシュ構文

	例	備考
値の代入値の取得と表示エントリの削除複数の値の代入すべての要素の取得と表示	$h{A}=1; $h{'B C'}=2; print $h{A}; print $h{'B C'}; または exists $h{A} and print $h{A}; delete $h{A}; delete $h{'B C'}; %h=( A => 1, 'B C' => 2 ); または %h=list_generator; $,='\n'; print sort values %h; print sort keys %h; print map { "$_=$h{$_}"} sort keys %h; または foreach $key (sort key %h) { print "$key=$h{$key}"; }	ハッシュ中の単一のスカラー値を参照する場合は $記号を使う。複数語のキーはクォートが必要。特定のキーがハッシュ中にあるかどうか分からない場合はexitsを使って確認できる delete関数は指定のキーと値をハッシュから削除する。キー =>　値の対をコンマで区切った明示リストでハッシュを初期化できる.リストジェネレータと呼ばれる式で初期化することも可能ハッシュから要素を取り出すにはvalue関数とkey 関数を使うことができる。sort をつけるとソート処理される.ハッシュの要素を"キー=値"の形で出力するには一般にmapまたはforeachが使われる

ハッシュの添字アクセスの構文

初期化格納される値添字アクセス結果	%X=( A => 1, B => 2, C => 3); 1 2 3 %X(A) %X(B) %X(C) 1 2 3
添字によるスライス結果	@X{A,B} "@X{C,A,B}" @X{C,B,A} 12 3 1 2 321

unique_args スクリプト

#! /usr/bin/perl -wnl
BEGIN {
$debug=defined $ENV{DEBUG_unique_args};
if ($debug) {
$,="\n\t";
print "$0: Initial arguments (sorted):", sort @ARGV;
PRINT "";
}
foreach $arg (@ARGV) {
#
#
$unique{$arg}++;
}
@ARGV=sort keys %unique;
if ($debug) {
print "\n$0: Final arguments: ",@ARGV;
exit 0;
}
}
#

unique_inputs スクリプト

#! /usr/bin/perl -wnl
$unique{$_}++;
END {
@inputs=sort keys %unique;
if (defined $ENV{DEBUG_unique_inputs}) {
foreach $input (@inputs) {
$unique{$input} > 1 and
print "$0: '$input' appeared $unique{$input}times";
}
print "";
}
#
$,="\n";
print @inputs;
}

user_lookup スクリプト

#! /usr/bin/perl -wnlaF':'
#
#
BEGIN {
$initializing=1;
#
($id, undef, $uid, $gid, $name, $shell)=(0..6);
#
@ARGV=( '/etc/passwd', '-');
$prompt="\nEnter login-ID or UID: " #
}
if ($initializing) {
#
#
$user{ $F[id] }=
$user{ $F[$uid] }="
ID: $F[$id]
UID: $F[$uid]
GID: $F[$gid]
NAME: $F[$name]
HOME: $F[$home]
SHELL: $F[$shell]";
if (eof) {
$initializing=0;
printf $prompt;
}
}
#
else {
if (exists $user{$_}) {
print $user{$_};
}
else {
warn "No such user: '$_'\n;
}
printf $prompt;
}
#
END {
print "",;
}

count_words スクリプト

#! /usr/bin/perl -wnlaF'\W+'
foreach $word (@F) {
#
#
$lc_word="\L$word";
$count{$lc_word}++;
$total++;
}
END {
printf "%20s%14s\n", 'WORD', 'FREQUENCY';
foreach $word (sort keys %count) {
$frequency=$count{$word} / $total;
#
#
printf "%20s%14f\n", $word, $frequency;
}
]

シェルとperlの一般的なリストジェネレータ

シェルの名前	perlの名前	シェルの例	perlの例
ファイル名生成コマンド置換変数置換該当なし該当なし	グロブコマンド展開変数展開入力演算子マッチ演算子	* `cat memo` $(cat memo) (微妙） `find . -print` "$@" "${names[@]}" $* ${names[*]} $names 該当なし該当なし	<*> split /\s+/, `cat memo` `cat memo` File::Find 参照 @ARGV split /\s+/, "@names" split /\s+/, "@ARGV" split /\s+/, "@names" split /\s+/, $names <> <STDIN> /\w+/g

ループ

シェルとperlのループ関連の相違点

相違点	シェル	perl
コードブロックのデリミタコードブロックの内容個々のスクリプト引数スクリプト引数すべてスクリプト引数の数リテラル値の明示リスト	do done コマンド $1,$2,... $*, "$@" $# 'Pat' 'Kim'	{ } 文 $ARGV[0],$ARGV[1],... @ARGV(リストコンテキストで） @ARGV(スカラーコンテキストで） ( 'Pat', 'Kim' )

while/until ループ

シェル	perl
while condition do code done	while ( condition) { code; }
while condition; do code; done	while (condition) {code};

compress_image スクリプト

#! /ustr/binperl -wl
$DEBUG=1;
$qual=80;
$fname or die "Usage: $0 -fname=imagefile\n";
#
! system "cp $fname /tmp/$fname" or die "$0: cp failed\n";
$DEBUG and #
print "Size of $fname: ", -s $fname, ' bytes';
while (-s $fname > 55_000) { #
#
! system "convert -quality $qual /tmp/$fname jpg:$fname" or
die "$0: convert failed\n";
$DEBUG and #
print "Size of $fname: ", -s $fname, ' bytes';
$qual=$qual - 5;
}

暗黙ループと明示ループにおける全処理と後処理

暗黙ループ(-nによる)	明示ループ
BEGIN {ここに入力前のコード｝ LINE: while (<>) { ここに入力を処理するコード } END {ここに入力後のコード}	ここに入力前のコード LINE: while (<>) { ここに入力を処理するコード } ここに入力後のコード

シェルとperlのdo while ループ

シェル	Perl
while prelim_code condition do : # ヌルコマンド done	do { prelim_code; } while (condition);
while commands; do :; done	do { prelim_code; } while(condition);

シェルのforループとperlのforeachループ

シェル	perl
for var in LIST do code done	foreeach $var (LIST) { code; }
for var in LIST; do code; done	foreach $var (LIST) {code};

expand_acronymsスクリプト

#! /usr/bin/perl -wpl
BEGIN {
%expansion=(
FWIW => "for what it's worth",
IMHO => "in my humble opinion"
AFAIK => "as far as I know"
JAPH => "just another perl hacker"
YMMV => "your mileage may vary"
);
}
foreach $acronym (keys %expansion) {
s/\b$acronym\b/%expansion{$acronym}/ig;
}

compress_image2スクリプト

#! /ustr/binperl -wl
# Usage: compress_image2 image [image...]
$DEBUG=1;
$qual=80;
foreach $fname (@ARGV) {
#
! system "cp $fname /tmp/$fname" or
die "$0: cp failed\n";
$DEBUG and #
print "Size of $fname: ", -s $fname, ' bytes';
while (-s $fname > 55_000) { #
#
! system "convert -quality $qual".
" ' /tmp/$fname' 'jpg:$fname' " or
die "$0: convert failed\n";
$DEBUG and #
print "Size of $fname: ", -s $fname, ' bytes';
$qual=$qual - 5;
}
}

perlのfor ループ

for (init; condition; increment) {
code;
}

for (init; condition; increment) {code;}

raffleスクリプト

#! /usr/bin/perl -s -wl
#
$Usage="Usage: $0 [-debug] name1 num_tickets1 ...";
#
for ($index=0; $index < @ARGV; $index+=2) {
$name="\U$ARGV[$index]";
$tickets=$ARGV[$index+1];
#
$debug and
warn "Inserting $tickets tickets for $name\n"
for ( $tcount=1; $tcount <= $tickets; $tcount++ ) {
push @fishbowl, $name; #
}
}
@fishbowl or die "Usage\n";
$debug and print "\nFishbowl contains: @fishbowl";
print "\nSelecting a ticket ...";
$rand_num= int rand @fisgbowl;
$debug or slep 2;
print "\nAnd the winning ticket is #$rand_nim,",
"owned by: \"$fishbowl[rand_num]\"";

シェルとperlのループ制御ディレクティブ

シェル	Perl
continue loop-number break loop-number	next loop-label last loop-label

シェルのループ制御ディレクティブの構文

while
COMMAND_RETURNS_TRUE
do
for item in LIST
do
TRUE_CONDITION && continue 1 #
TRUE_CONDITION && continue 2 #
TRUE_CONDITION && break 1 #
TRUE_CONDITION && break 2 #
done
#
TRUE_CONDITION && break 1 #
done
#

Perlのループ制御ディレクティブの構文

OUTER:while(COMMAND_RETURNS_TRUE) {
INNER: foreach $item (LIST) { #
TRUE_CONDITION and next INNER; #
TRUE_CONDITION and next OUTER; #
TRUE_CONDITION and last INNER; #
TRUE_CONDITION and last OUTER; #
}
#
#
TRUE_CONDITION and next OUTER; #
}
#

シェルとperlの拡張while/until ループ

シェル	perl
while # preliminary_code condition do conditional code done	while (1) { # preliminary_code; (condition) or last; } continue { continuation_code; }

シェルのselect ループ

select var ; do commands; done #
select var in LIST; do commands; done #

Perlのselect ループ

use Shell::POSIX::Select;
select          ()          {}          #
select          ()      {CODE; }   #
select           (LIST) {CODE; } #
select $var (LIST) {CODE; }   #

*Shell::POSIX::SelectはCPANからインストールできなかった。aptitudeなどでlibshell-posix-select-perlという
モジュールをインストールするとうまくいった。

perlman スクリプト

#! /usr/bin/perl -w
use Shell::POSIX::Select;
$perlpage=`man perl`;
#
# perlsyn Perl syntax
#
while ( $perlpage =~ /^\s+(perl\w+)\s+(.+)$/mg { #
#
$desc2pafe{$2}=$1; # $hash{'Perl syntax'}='perlsyn'
}
select $page ( sort keys %des2page ) {#
system "man $des2page{$page}";
}

サブルーチンと変数スコープ

機能	構文	コメント
サブルーチンを定義するサブルーチンを呼び出す値を返すコンテキストを検知する引数にアクセスする	sub name { code; } name(); #引数なしで呼び出す name(ARGS); #引数を指定して呼び出す $Y=name(); @X=name(ARGS); return VALUE(S); # VALUEを返す print get_time(); #時刻を表示 sub get_time { scalar localtime; } # if (wantarray) { return @numbers; #リスト値 } else { return $average; #スカラー値 } ($A,$B)=@_; print $B; # print $_[1]; # $A=shift; $B=shift; print $B; #	sub宣言はその後のnameをcodeと関連付ける。サブルーチンに渡したい引数を括弧のなかに指定。nameが返すVALUE（s)は必要に応じて自動的にスカラーに変換される returnはVALUE(S)を呼び出し元に送り返す。必要に応じてリストからスカラーに変換される returnに引数がない場合空のリストまたは、未定義値が返される。(get_timeの様に）retuen がないと，最後に評価された式の値が返される wantarrayはその呼び出しがリストコンテキストかスカラーコンテキストかによって真または偽を返す。これにより呼び出し時のコンテキストに応じてことなる値を返すサブルーチンの引数は、配列@_をコピー又は shiftすることで取得できる。或いは添字を使えば$_[0]は@_の第１要素を、$_[1]は第二要素を表す

centerスクリプト

#! /usr/bin/perl -wnl
use Text::Tabs; #
BEGIN {
$width=0; #
}
#
#
$_=expand$_;
#
s/^\s+//;
s/\s+$//;
#
#
#
$indent=($width - length)/2; #
$indent < 0 and $indent=0; #
#
$padding=' ' x $indent; #
print "$padding$_";

center2 スクリプト

#! /usr/bin/perl -s -wnl
# Usage: center2 [ -width=columns ] [file1 file2 ...]
our ($width);
BEGIN {
$cl_width=$width; #
}
print center_line($_); #
sub center_line {
#
use Text::Tabs; #expand()
if ( @_ != 1or $_[0] eq "") { #
warn "$0: Usage: center_line(string)\n";
$newstring=undef; #
}
else {
defined $cl_width and $cl_width > 2 or $cl_width=80;
$string=shift;
$string=expand $string;
$string=~ s/^\s+//;
$string=~ s/\s+$//;
#
$indent=($cl_width - length $dtring )/2;
$padding= ' ' x $indent;
$newstring="$padding$string";
}
return $newstring;
}

center2.strict スクリプト

#! /usr/bin/perl -s -wnl
# Usage: center2.strict [ -width=columns ] [file1 file2 ...]
use strict;
our ($width);
my ($cl_width); #
BEGIN {
$cl_width=$width; #
}
print center_line($_); #
sub center_line {
#
use Text::Tabs; #expand()
my $new_string; #
if ( @_ != 1or $_[0] eq "") { #
warn "$0: Usage: center_line(string)\n";
$newstring=undef; #
}
else {
defined $cl_width and $cl_width > 2 or $cl_width=80;
my ($string,$indent,$padding); #
$string=shift;
$string=expand $string;
$string=~ s/^\s+//;
$string=~ s/\s+$//;
#
$indent=($cl_width - length $dtring )/2;
$padding= ' ' x $indent;
$newstring="$padding$string";
}
return $newstring;
}

my, our,loaclの変数宣言

宣言	例	説明
my our local	my $A; my $A=42; my ($A, $B); my ($A, $B)=@values; our $A; our $A=42; our ($A, $B); our ($A,$B)=@values; {#変更後の$,の新たなスコープ　local $,='\t"; print @ARGV;タブ区切り } #以前の$,が回復	my宣言はプライベート変数を生成する（その宣言のスコープ内でのみ有効）。 strictモードにおけるourは、そのスコープ内のグローバル変数に完全名（例えば $main::Aまたは$::A)ではなく単純名（例えば$A)でアクセスすることによる致命的エラーを無効にする.ミニマルperlではすべてのスイッチ変数とモジュールでエクスポートする変数についてこの宣言をstrictモードで使う。 localはその宣言のスコープから実行の制御が外にでたとき変数の以前の値が復元されるようにするperlでは主としてprintのフォーマット変数($,と$")に使う

プログラムコード	変数のスコープ
! /usr/bin/perl ... use strict; use SomeModule my $A=42; BEGIN { my $B; ... print $A,$B; } print $A;	$A	$B

(変数のスコープの例（サブルーチンなし））

$Aの最初のスコープ	$Aの最終的なスコープ
#! /usr/bin/perl1 ... use strict; use SomeModule;	#! /usr/bin/perl1 ... use strict; use SomeModule; {
my $A=42; #メイン print $A; # メイン sub C {}	my $A=42; #メイン print $A; # メイン
my $A=42; #メイン print $A; # メイン sub C {}	｝ sub C {}

メインを波括弧で囲むことで変数がサブルーチンに漏れることを防ぐ

変数のスコープ
A：プログラム全体	B：BEGIN、メイン、END	C：BEGINとメイン	D：メインとEND	E:メインのみ
use strict;	use strict; {	use strict; {	use strict; BEGIN { } {	use strict; BEGIN { } {
decl $v; BEGIN { } メイン END { } サブルーチン	decl $v; BEGIN { } メイン END { }	decl $v; BEGIN { } メイン	decl $v; BEGIN { } メイン END { }	decl $v; BEGIN { } メイン
	decl $v; BEGIN { } メイン END { }	} END { } サブルーチン	decl $v; BEGIN { } メイン END { }	｝ END
	｝サブルーチン	} END { } サブルーチン	} サブルーチン	サブルーチン

波括弧が変数のスコープに及ぼす影響

プログラムコード	変数のスコープ
#! /usr/bin/perl ... use strict; use SomeModule; { # 特設スコープの開始 our ($A); #スイッチ変数 my $B; BEGIN { my $C; print $A,$B,$C; } print $A,$B; #メインプログラム END { my $D; coscious ($A,$B,$D); print $A,$B,$D; } } # 特設スコープの終了 sub coscious { my $E: print $E: }	$A	$B	$C	$D	$E
	■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■	■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■	■ ■	■ ■ ■	■ ■

変数のスコープの例(サブルーチンあり）

モジュールとCPAN

シンプルもジュールテンプレート

package Module_name; #
use strict;
use Carp;
our (@ISA, @EXPORT,@EXPORT_OK);
#
our ( module_vars, module_subs );
require Exporter; @ISA=( 'Exporter' ); #
#
@EXPORT=qw( module_vars, module_subs ); #
@EXPORT_OK=qw( module_vars, module_subs); #
#
sub lime {
#
}
sub stantial {
#
}
#
1;

Center.pmモジュール

package Center; #
use strict;
use Carp;
our (@ISA, @EXPORT, @EXPORT_OK);
#
our ($cl_width);
require Exporter; @ISA=qw(Exporter); #
#
@EXPORT=qw(center_line); #
@EXPORT_OK=qw($cl_width); #
sub center_line {
#
use Text::Tabs; #
my $newstring; #
if (@_ != 1 or $_[0] eq "") { #
#
#warn _PACKAGE_, ":Usage: center_line(line)";
carp _PACKAGE_, ":Usage: center_line(line)"; #
$newstring=undef; #
}
else {
defined $cl_width and $cl_width > 2 or $cl_width=80;
my ($string, $indent, $padding); #
$sring = shift;
$string = expand ($string);
$string =~ s/^\s+//;
$string =~ s/\s+$//;
#
$indent=($cl_width - length $string )/2;
$padding=' ' x $indent;
$newstring="$padding$string";
}
return $newstring;
}
1;

check_linksスクリプト

#! /usr/bin/perl -wl
use strict;
use LWP::simple;
my $VERBOSE=0; #
defined $ENV{CL_VERBOSE} and $ENV{CL_VERBOSE}=~ /^\d+$/ and
$VERBOSE=$ENV{CL_VERBOSE}; #
{ #
foreach my $url (@ARGV ) { check_link( $url) };
}
END {
#
#
print STDERR "";
}
sub check_link {
my ($url, @links, $link, @h, $counter, $output );
$url=shift;
#lwp-request
if (@links=`lwp-request -o links '$url'`);
$VERBOSE and
print "\nGot " , scalar @links, " links for $url";
}
else {
warn "$!\n"; # OS
}
@links=uniquify ( @links); #
$VERBOSE and @links and #
print scalar @links , " links are unique";
foreach $links ( @links ) {
$link =~ /^(A|LINK)\s+mailto:/i and next; #
$link =~ s/^\w+\s+//; #
$link =~ s/\s+//g; #
$VERBOSE > 1 and printf "\nChecking '$link'";
if (@h=head $link) { #
if ( $VERBOSE > 1) {
print ": OKAY";
$VERBOSE > 2 and
printf " Type: %s\tSize:%s\tServer: %s\n",
$h[0], ( $h[1] or "N/A" ), $h[4];
}
else {
#
#
#
printf STDERR "\b%s #
('-', '\\', '|', '/')[$couter++ % 4];
}
}
else { #
$output = "\nBAD: '$link', in '$url'";
$output =~ s|http://||g; #
print $output;
}
}
}
sub uniquify { #
my %uniquue;
foreach ( @_ ) {$unique{$_}++; };
return sort keys %unique;
}

menu_ls スクリプト

#! /usr/bin/perl -wl
use Shell::POSIX::Select qw($Reply $Heading $Prompt $Eof);
#
#
@formats = ( 'regular', 'long');
@fmt_opt = ('', '-l');
@types = ( 'only non-hidden', 'all files' );
@typ_opt = ('', 'a' );
print "\n COMMAND COMPOSER FOR: ls\n"
$Heading="\n**** Style Menu ****;$
$Prompt= 'Choose listing style';
FORMAT: select ( @formats ) {
$user_format=$fmt_opt[ $Reply -1 ]
$Heading="\n****File Menu ****";
$Prompt="Choose files to list:";
TYPE: select (@types ){ #
$user_type=$typ_opt[ $Reply -1];
last FORMAT; #
}
$Eof and next; #
}
$Eof and exit; #
#
$command="ls$user_format $user_type\\\\\\\\\\\\\\2;
#
printf "Press<ENTER> to execute \"$command\" ";
#
defined <STDIN> or print "\n" and exit;
system $command; #

check_symlinks スクリプト

#! /usr/bin/perl -wl
use strict;
use File::Find;
{ # メイン　＋　chexk_slinks の特設スコープ
my $Bad=0; # check_slinksサブルーチンでも使われる
my $Total=0 #
my $Usage="Usage: $0 dir1 [dir2...]\n";
@ARGV or die "Usage";
my $start_time=time; #
foreach my $startdir( @ARGV ) {
--d $srartdir and -r _ and -x _ or
warn "$0: Bad directory argument: $startdir\n" and
next;
#
print "REPORTING BROKEN SYMLINKS UNDER: \E$startdir";
find \&check_slinks, $startdir";
}
#
print "FILES BROKEN/EXAMINED: ",
commafy ($Bad),"/", commafy ($Total);
show_times ($start_time);
sub check_slinks {
my $isbad=0; #
my $target; #
my $name=$File::Find::name;
if ( -l ) { # $_のファイルがシンボリックリンクなら
　　　　　 # 其れが指す先を見つける
　　 $target=readlink $_;
if (! defined $target or $target eq "") {
warn "$0: check_slinks(): bad readlink value",
" on \"$name\": $!\n";
$isbad=1;
}
elsif (! -e $target) {
#ターゲットなし：リンクが壊れているかNFSがダウン
print "\t$name -> $target";
$isbad=1;
}
}
# $Badと$Totalはここでもスコープ内
$isbad and $Bad++ #
$Total++; #
return; # find
}
} #メイン＋check_slinks の特設スコープの終わり
　
sub commafy {
my $number=shift;
defined $number or die "$0: commafy: no argument!";
while ($number =~ s/^(-?\d+)(\d{3})/$1,$2/) {;}
return $number;
}
sub show_times {
#
my $time=shift or
die "$0: show_times(): bad argument";
my $etime=time; #
my $dtime=$etime - $time;
printf "\UTime:%2d:%02d HR:MN ",
int ( ( $time / 3600 ) + .5),
( ( $dtime % 3600 ) + .5;
print "\nSTART: ",scalar localtime $stime,
" END: " ,scalar localtime $etime;
}

survey.cgiスクリプト

#! /usr/bin/perl
# survey.cgi:
use strict;
use CGI qw(:standard); # CGI.pm
#
use CGI:Carp qw(fatalToBrowser):
#通常の実行時は$formに組み立てて画面に表示
#CGIモーではブラウザに送り返す
　
if (! param()) { #
my $form=header(); #HTTP
$form.=start_html(-title=>'CGI Module Demo',
-BGCOLOR=> 'ivory');
$form.=h1('National Junk Food Survey');
#action=' 'により、送信したフォームをこのスクリプトが処理
$form.=startform(-method=>'GET,-action=>' ');
$form.=hr() ."\n";
$form.=b('Please enter your first initial and surname:');
$form.=p();
$form.='Initial';
$form.=textfield(-name=>'Init', -size=>1,--maxlength=>1);
$form.="\n";
$form.='Surname';
$form.=textfield(-name=>'name', -size=>12, -maxlength=>30);
$form.="\n\2 . hr() . "/n";
$form.=b('Please indicate your age grou:');
$form>=p();
$form.=radio_group(-name=>'age',
-Vlues=.['Under 25, '25-40','Older']);
$form.=hr() . "\n";
$form.=b('What are your favorite ice-cream flavors?');
$form.=p();
$form.=checkbox_group(-name=>'flavor',
-Values=>['Chocolate', 'Vanilla', 'Other']);
$form.=hr() ."\n";
$form.=b('How many pizzas do you have monthly?');
$form.="\n";
$form.=popup_menu(-name=>'pizzas', -size=>2,
-Values=>['no pizzas', 'one two three', 'four or more']);
$form.= hr() . "\n";
$form.=submit(-name=>'button', -value=>'SUBMIT');
$form.="\n";
$form.=endform();
$form.=end_html();
print $form;
}
else { #
my $response=header();
$response.=start_html(-title=>'Survey Response',
-BGCOLOR=>'snow');
$response.=h1('Ntional Junk Food Survey');
$response.=p();
$response.="You supplied these details:\n";
$response.=Dump();
$response.=p();
$response.=h2( i('Thank you for participating!'));
$response.=end_html();
#
print $response;
}

CGIモジュールの基本的な関数

関数の構文

関数の出力

header('type')

start_html(-title=>'Title',
-BGCOLOR=>'color')

pre('stuff')

hN('Heading')

comment('text')

em('word')

b('word')

p() hr() br()

ul(li('item1','item2'))

a({-href=>'URL'},'text')

img({-src=>'URL', -align=>'position'})

end_html()

指定された文書タイプ(デフォルトはtext/html）のHTTPヘッダ

HTMLヘッダと<body>タグ

ブラウザによるフォーマット処理が行われないコンテンツ

レベルNでフォーマット処理した見出し

HTMLコメントとしてのテキスト

強調して表示される語(italic)

太字

空行，水平方向の区切りせん，新たな行の開始

2項目の順序なし(黒点付き)リスト.順序付きはolを使う

URLへのリンクとしてのテキスト

URLで指定されるイメージ.オプションで位置の指定も可（イメ
ージそのものにはleftとright,イメージのキャプションテキストにはtop,middle,bottom

HTMLの終了(</body></html>)

CGIモジュールのフォーム関連の関数

関数の構文

関数の出力

start_form(-method=>'type',
-action=>'URL')

textfield(-name=>'Name',
-default=>'text',
-size=>num, -maxlength=>num)

scrolling_list(-name=>'Name',
-default=>'starting_value',
-Values=>['V1', V2'],
-size=>num)

param()

param('name')

Dump()

submit(-name=>'name',
-value=>'value')

image_button(-name=>'Name',
-src=>'URL',
-align=>'position')

reset()

end_form()

フォームの開始。パラメータの送信タイプ(type)はPOST(これがデフォルト）またはGET.-actionを省略すると現在のスクリプトが結果を処理する.

テキスト入力のためのフィールド。-maxlengthのnumが-sizeのnumを超えると水平方向にスクロールする.

スクロールリスト。popup_memu, radio_group, checkbox, checkbox_groupも同じ形-sizeはpopup_menuのみ）

すべてのパラメータの名前

指定されたパラメータの値

パラメータの名前と値のリストをフォーマット処理したもの。古いバージョンでは代わりにCGI：dump()を使う.

フォーム送信ボタン

フォーム送信ボタンとしてのイメージ.クリックされた位置のX座標とY座標はName.x, Name.yというパラメータとして取得可。

フォームリセットボタン

フォームの終了