[perl] 1 行スクリプト覚書 with Active Perl

この稿を読む前に

この稿はWindowsMe上でActivePerlを走らせたい人向けの情報です。しかし、シェルとしては非力なWindowsMeのcommandプロンプトでの結果を載せているため、多分Unix版のPerl上でも動くでしょう。perlの前についている>マークはWindowsのプロンプトマークです。今から行うのはActivePerlでの話なのでunixのBシェルやCシェルのプロンプトマークである$や%は使いません。

ActivePerlで1行スクリプトを書く場合に気をつけること

unix版のPerlとWindows版のActivePerlの違いと言うよりもシェルの違いと言った方が良いのかもしれない。世にある様々な1行スクリプトの多くはunix版のPerlで動くように作られていると思う。ただ、unixはインストールするのめんどくさいしとか、Cygwinほどリッチな環境もイラナイしと思う輩のために、ActivePerlはある。指し当たって注意することはたった一つ。それは、Windiwsのcommandプロンプトではダブルコーテーションが1組しか使えないと言うことだ。だからWindowsMeとActivePerlの環境の元では下のように書くと多分期待どおりの結果を返さない。(と言うか僕はWindows野郎でMe使いなので他の環境についてよく知らない。)

> perl -e "print "Hello World!!";"

原因は先に述べたようにダブルコーテーションが1組しか使えない点にある。Hello World!!と表示させたい場合は下のように書く。忘れてはならないことは-eの後に続くプログラム文はダブルコーテーションで全てを括らねばならないと言う点だ。シングルコーテーションで括ってprint文の引数をダブルコーテーションで括るのもご法度である。

> perl -e "print 'Hello World!!';"

[文字出力] 文字列を標準出力に表示する(変数にセットされた)

D:\>perl -e "$xx = 'ww'; print \"$xx\";"
ww
D:\>

変数を使いたいときもあるかもしれない。そんな場合はシングルコーテーション(')をエンマークダブルコーテーション(\")のようにするといいんだな。これでも全く同様な出力が得られるんだな。この場合、コンパイラは下のように理解しているんだな。

$xx = 'ww';
print "$xx";

ダブルコーテーションで囲まれているので、変数展開が行われたんだな。これさえ覚えれば出力は完璧なんだな。

[文字出力] 文字列+改行を標準出力に表示する(メタ文字)

D:\>perl -e "print \"Hello World\n\";"
Hello World
D:\>

lオプションを使って改行するより、わかりやすいコマンドになっているんだな。つまり、通常のprint文で使用するダブルコーテーションを円マークでエスケープしてるところがミソ。これをPerlは下のように解釈しているんだな。

print "Hello World\n";

[文字出力] 文字列+改行を標準出力に表示する(lオプション)

C:\>perl -le "print "'ww'";"
ww
C:\>

つまりはechoコマンドのエミュレートということなんだな。まぁこのくらいならわざわざPerlを使うこともないんだけど、上で改行なしの表示法をやったし、何かと改行はあったほうが良いということで紹介しておこう。lオプションでprint文の最後に必ず改行コードを付けるようになるんだな。注意することはこのオプションを-elとしないこと。ちなみにそうすると下のようになる。-eオプションはこれ以降をPerlスクリプトとして解釈するようだけど、多分-e以降に-lが含まれていると理解されたんだろうな。

C:\>perl -el "print "'ww'";"
C:\>

[文字出力] 文字列+改行を標準出力に表示する(メタ文字,変数)

D:\>perl -e "$xx = 'ww'; print \"yy$xx\n\";"
yyww
D:\>

前述の様に、コマンドプロンプト上から入力されたエンマークダブルコーテーションの間に変数やメタ文字が含まれると、コンパイラはこれを解釈するので、下のようになるんだな。

$xx = 'ww';
print "yy$xx\n";

ここまでくれば文字列の出力は完璧なんだな。

[時刻表示] 時刻表示にまつわるエトセトラ

D:\>perl -e "($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);$year+=1900;$mon+=1; print \"$year/$mon\""
2005/10
D:\>

WindowsMEには時刻表示機能がないの何でだろー。

D:\>perl -le "@D=localtime(time); $D[5]+=1900; $D[4]+=1; foreach (@D){print}"
41
49
22
30
10
2005
0
302
0
D:\>

覚えてしまえlocaltimeで渡される配列。さすれば、あーんなこともこーんな事も自由自在だったりする。

D:\>perl -e "@D=localtime(time); $D[5]+=1900; $D[4]+=1; print \"$D[5]/$D[4]/$D[3] $D[2]:$D[1]:$D[0]\""
2005/10/30 22:52:34
D:\>

localtimeの引数を省略するとtimeを引数に取ったことと同じになるので、下のようにしても同じ。短さ追求ならこちらのほうがいいかな。

D:\>perl -e "@D=localtime; $D[5]+=1900; $D[4]+=1; print \"$D[5]/$D[4]/$D[3] $D[2]:$D[1]:$D[0]\""
2005/10/30 22:52:34
D:\>

短さを追求してわかりやすさを捨てた結果。

D:\>perl -e "@D=localtime; print 1900+$D[5].\"/\".$D[4]++.\"/$D[3] $D[2]:$D[1]:$D[0]\""
2005/9/30 23:44:59
D:\>

あんまり美しくはないけれど。というかやめたほうがいいかも。上よりも長いし、出力内容見にくいし。

D:\>perl -le "@D[0..5]=localtime(time); $D[5]+=1900; $D[4]+=1; $\"='/'; @D=reverse @D; print \"@D[0..5]\";"
2005/10/30/23/7/1
D:\>

遊んでみるとこうなる。1秒ごとに時間を出力。意味はない。

D:\>perl -le "while(1){@D=localtime; print 1900+$D[5].\"/\".$D[4]++.\"/$D[3] $D[2]:$D[1]:$D[0]\"; sleep(1);}"
2005/9/31 0:3:28
2005/9/31 0:3:28
2005/9/31 0:3:29
2005/9/31 0:3:30
2005/9/31 0:3:31
2005/9/31 0:3:33
2005/9/31 0:3:33
2005/9/31 0:3:34
Terminating on signal SIGINT(2)
D:\>

おばかな応用として、ラーメンタイマー改にしてみる。

D:\>perl -le "for(1..6){@D=localtime; print 1900+$D[5].\"/\".$D[4]++.\"/$D[3] $D[2]:$D[1]:$D[0]\a\"; sleep(30);} print\"\a\a\a\";"
2005/9/31 0:9:17
2005/9/31 0:9:47
2005/9/31 0:10:17
2005/9/31 0:10:47
2005/9/31 0:11:17
2005/9/31 0:11:47
D:\>

localtimeを文字列で評価すると人間にもわかる(つまり何時何分何秒)という形式で表示される。

$file_inf=localtime((stat($file))[9]);

[ディレクトリ走査] カレントディレクトリ中のファイルとディレクトリを表示する

D:\>perl -e "print <*>"

[ディレクトリ走査] カレントディレクトリ中のファイルとディレクトリの情報表示(dir /V)

このくらいならdirたたいたほうが速いって?そのとおり。ネタがなくなったって?そのとおり。

C:\>perl -e "while(<*>){print $_.\"\t\".scalar(localtime((stat($_))[9])).\"\n\";}"
a.bat   Tue Feb 14 02:35:46 2006
a.pl    Tue Feb 14 02:35:22 2006
a.txt   Tue Feb 14 02:02:04 2006
C:\>

しつこくやるのが上達のススメ。ということでファイルサイズを付加してみた。だってdir /Vだと1行に収まらないんだもん。

C:\>perl -e "while(<*>){@F=stat($_); print join\"\t\",($_,$F[7],scalar localtime $F[9],\"\n\");}"
a.bat   1474    Tue Feb 14 02:35:46 2006
a.pl    4988    Tue Feb 14 02:35:22 2006
a.txt   4844    Tue Feb 14 02:02:04 2006
C:\>

[ディレクトリ走査] カレントディレクトリ中のファイルのみを表示する

perlでファイルだけを表示してみる。ポイントはファイルテスト演算子を使ってファイルかディレクトリかをチェックするということ。ディレクトリ以外をファイルと思って処理してみる。昔書いていたものでは不十分とわかったので。

~~D:\>perl -e "print <*.*>"~~

$ perl -le 'print join"\n", grep{! -d $_}<*>'

文字コード変換

C:\>perl -e "require \"jcode.pl\"; print \"失敗\"; "
失敗
C:\>perl -e "require \"jcode.pl\"; $s=\"失敗\"; jcode::convert(\$s,'euc');print $s;"
シコヌヤ
C:\>

文字列だけならこんな感じ。ファイル内容を変換する場合は下のような感じ

C:\>perl -pe "require \"jcode.pl\"; jcode::convert(\$_,'euc'); " test.txt>test2.txt
C:\>

でも半角カタカナは上手く変換できないんだな。デスクトップ上に半角カナの名前があることのほうが問題か?

単語抜き出し

I have a dream that one day this nation will rise up and live out the true meaning of its creed: "We hold these truths to be self-evident: that all men are created equal." I have a dream that one day on the red hills of Georgia the sons of former slaves and the sons of former slaveowners will be able to sit down together at a table of brotherhood. I have a dream that one day even the state of Mississippi, a desert state, sweltering with the heat of injustice and oppression, will be transformed into an oasis of freedom and justice. I have a dream that my four children will one day live in a nation where they will not be judged by the color of their skin but by the content of their character. I have a dream today.

C:\>perl -anle "for(@F){push @d,$_} END{@e=grep(!$tmp{$_}++,@d); print \"@e\"}" a.txt
I have a dream that one day this nation will rise up and live out the true meani
ng of its creed: "We hold these truths to be self-evident: all men are created e
qual." on red hills Georgia sons former slaves slaveowners able sit down togethe
r at table brotherhood. even state Mississippi, desert state, sweltering with he
at injustice oppression, transformed into an oasis freedom justice. my four chil
dren in where they not judged by color their skin but content character. today.
C:\>

空ファイルを作るにはどーすりゃいーんじゃコラ

普通なら下のような感じで書けば、ファイル名1.txt,2.txt,3.txt,4.txt,5.txt,6.txt,7.txt,8.txt,9.txt,10.txtのファイル中にファイル名が書き込まれたファイルができるんだな。

for(1..10){
  $f="$_.txt";
  open(OUT,">$f");
  print OUT "$f";
  close OUT;
}

そこでこいつを下のようにしてみるんだな。

C:\>perl -e " for(1..10){$f=\"$_.txt\"; open(OUT,\">$f\"); print OUT \"$f\"; close OUT; }"
ファイルを作れませんでした.
C:\>

これはActivePerlの仕様なのか?もう今日は寝る。引数にワイルドカードも取れないし。どーすりゃいーんだ。

C:\>perl -e "for(1..10){print $_}"
12345678910
C:\>perl -e "for(1..10){print $_}">test.txt
C:\>perl -pe "" test.txt
12345678910
C:\>

C:\>perl -e "for(1..10){ system \"copy test.txt test$_.txt\"}"
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
        1 個のファイルをコピーしました.
C:\>

マッチしたファイルの内から特定の文字列のある行を抜き出す

D:\>perl -e "@F=<*.html>; foreach(@F){open IN,$_; print \"----------$_\n\"; while(<IN>){print if(m/1/);}; close IN;}"
----------test.html
    4 spaces 1 space
                2 tabs  1 tab
----------test2.html
<h1>PerlTestBody</h1>
D:\>

例えばこの例では"1"という文字が含まれている行を抜き出しているんだな。m//の中身を特定の文字に変えればいいんだな。

D:\>perl -e "@F=<*.html>; foreach(@F){open IN,$_; print \"----------$_\n\"; while(<IN>){print if(m/.*/);}; close IN;}"
----------test.html
    4 spaces 1 space
                2 tabs  1 tab
----------test2.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner,SearchOn<a href="http://www.google.com">Google</a>WithSomeWords.Google'sLogo<img href="http://www.google.com" alt="GoogleLogo">IsHere.</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

ファイル名を変更する

D:\>perl -e "opendir (DIR,'.'); @fname=readdir DIR; foreach(@fname){if(m/t_0.*\.wav/){ rename ($_,asd)}}"
D:\>

この場合同じファイル名になっても無条件に(エラーメッセージを出さずに)変更してしまうんだな。だからかなり危険なんだな。

D:\>perl -le "for(<*.wav>){ m/(t_)([0-9]*)(\.wav)/; $n=sprintf(\"%04d\",$2); $n= \"$1$n$3\"; print $n;rename $_,$n;}"
t_0010.wav
t_0011.wav
t_0012.wav
t_0013.wav
t_0014.wav
t_0015.wav
t_0016.wav
t_0017.wav
D:\>

rename s/\.eps\.png/\.png/ *eps.png

[perl] ファイル中の文字を置換する

だめぽ。jperlでしか動かんのかも。いまどきjperlもないだろということで。今windowsで動くperlといえばactive perlとstrawberry perlだけど、それぞれの違いは、モジュールの導入形式。前者は独自パッケージ形式ppm、後者はcpan経由のコンパイル。つまり、strawberry perlはlinux perlライクなパッケージ管理ができる。その代わりコンパイル環境が同時にセットアップされる。ぼくはこれを「strawberry perlは新しいものが使える」と表現してしまった。

D:\>jperl -ne "tr/Ａ-Ｚａ-ｚ０-９（）？！/A-Za-z0-9()?!/;print;" original.txt > new.txt

[perl] ファイルの内容をソートして標準出力

sortコマンドのエミュレートな感じかな。

D:\>perl -e "print sort(<>); exit;" c.txt

[perl] ファイル中の重複行を削除してソートの後標準出力

D:\>perl -ne "push(@l, $_) unless $f{$_}++; END{print sort(@l);}" c.txt > ccc.txt

ファイル中に特定の文字が含まれていたら出力(findコマンドに似てるかも)

C:\>perl -ne "if(m/失敗/){print}" Ma.18
C:\>

C:\>perl -ne "if(m/#FF0000/){print}" Magrdadd
<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#cc33ff" alink="#FF0000">
        <td width="10%" nowrap bgcolor="#FFCCCC" valign="top"><font color="#FF0000">すでに登録済みの<br>メールマガジン</font></td>
C:\>

このままだとMa.18やMagrdaddの内容しか走査しないので、使いにくい。というよりもgrepコマンドみたいなことがしたいんだな。

ファイル中の重複行を削除して標準出力

D:\>perl -ne "push(@l, $_) unless $f{$_}++; END{print @l;}" c.txt > ccc.txt

こーゆー奴は面白いってもんでしょ。nオプションは、スクリプトをwhile(<>)ループで囲むんだな。つまり、上のスクリプトは下のように解釈されていたんだな。

while(<>){
  push(@l, $_) unless $f{$_}++;
}
print @l;

読み込んだ行$_を配列@lにpushする際の条件として、$f{$_}が偽(0)であることを条件にしているんだな。未定義の$f{$_}が呼び出されたら、これを定義し値をインクリメント($f{$_}を1増やす)する。以前に$f{$_}が定義されていれば$f{$_}は0でないから、push(@l, $_) は実行されない。ファイル中から行を取り出せなくなったらダイヤモンド演算子は偽を返すからループから抜ける。スクリプト中のEND{}で囲まれたとこはループから抜けたら実行されので、最後に重複した要素のない配列を標準出力する。まぁどうせ後から配列操作をしないんだし、こんな感じのほうがすっきりしてていいかも。ここ中でのprintはprint $_と同義なんだな。

D:\>perl -ne "print unless $f{$_}++;" c.txt > ccc.txt

ファイルの内容に行番号を付けて標準出力

D:\>perl -ne "printf(\"%5d: %s\",$.,$_);" c.txt

なんでもないようで示唆にとんだスクリプトなんだな。最初に気をつけるのはprintf文の中身なんだな。通常のprint文ではダブルコーテーションで出力内容を括るけど、この場合はダブルコーテーションの前に円マーク(バックスラッシュ)をつけて明示的にエスケープしているんだな。多分これはWindows上で動くActivePerlだからなんだな。こうすることでスペースをわざわざ別コーテーションで括ることなしに使えるようにしているんだな。次に-nオプションでwhileループ中のスクリプトを書いているんだな。つまりこんな感じで解釈されたということなんだな。

while(<>){
  printf("%5d: %s",$.,$_);
}

printf文はダブルコーテーション中の%以降で指定した出力形式で、これに続く変数を展開して出力するんだな。2つの重要な特殊変数が使われているんだな。一つ目は$.なんだな。これは読み込み中のファイルの現在読み込んだ行の行番号を示しているんだな。これをprintf文で5桁(5桁未満の場合は空白で埋める)にしているんだな。5の部分を適当な整数に変えることができるんだな。二つ目は$_なんだな。これは読み込み中のファイルの現在読み込んだ行の内容を示しているんだな。これをprintf文で%sにて展開、つまり文字列として展開しているんだな。

簡易HTMLタグ削除フィルタ

C:\>perl -0 -pe "s/<[^>]*>//g;"

C:\>perl -e "s|<(.*?)>(.*?)</$1>|$2|m"

D:\>perl -ne "s|<(.*)>(.*)<\/\1>|$2|ig; print;" test.html
test
D:\>perl -ne "print;" test.html
<html>test</html>
D:\>

D:\>perl -ne "while(s|<(.*)>(.*)<\/\1>|$2|g) { print \"$_\n\"; }" test.html
<head><title>PerlTest</title></head><body>PerlTestBody</body>
<title>PerlTest</title>PerlTestBody
PerlTestPerlTestBody
D:\>perl -ne "print" test.html
<html><head><title>PerlTest</title></head><body>PerlTestBody</body></html>
D:\>

D:\>perl -ne "while(s|<(.*)>(.*)<\/\1>|$2|g) { }print \"$_\n\";" test.html
PerlTestPerlTestBody
D:\>perl -ne "print" test.html
<html><head><title>PerlTest</title></head><body>PerlTestBody</body></html>
D:\>

D:\>perl -ne "print;" test.html
<html><head><title>PerlTest</title></head>
<body>PerlTestBody</body>
</html>
D:\>perl -ne "while(s|<(.*)>(.*)<\/\1>|$2|g) { }print \"$_\n\";" test.html
<html>PerlTest
PerlTestBody
</html>
D:\>

D:\>perl -ne "$f.=$_; END{ while($f=~s|<(.*)>(.*)<\/\1>|$2|sg){} print \"$f\";}" test.html
PerlTest
PerlTestBody
D:\>perl -ne "print" test.html
<html><head><title>PerlTest</title></head>
<body>PerlTestBody</body>
</html>
D:\>

D:\>perl -ne "$f.=$_; END{ while($f=~s|<(.*)>(.*)<\/\1>|$2|sg){} print \"$f\";}" test.html
PerlTest
PerlTestBody
<hr>AllAboutPerlOneLiner
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
</body>
</html>
D:\>

D:\>perl -ne "$f.=$_; END{ while($f=~s|<(.*) .*>(.*)<\/\1>|$2|sg){} print \"$f\";}" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
Google
</body>
</html>
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

D:\>perl -ne "$f.=$_; END{ while($f=~s|<(.*) .*>(.*)<\/\1>|$2|sg){} while($f=~s|<(.*)>(.*)<\/\1>|$2|sg){} print \"$f\";}" test.html
PerlTest
PerlTestBody
<hr>AllAboutPerlOneLiner
Google
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

D:\>perl -0777 -e "$_=<>; while(s|<(.*) .*>(.*)<\/\1>|$2|sg){} while(s|<(.*)>(.*)<\/\1>|$2|sg){} print;" test.html
PerlTest
PerlTestBody
<hr>AllAboutPerlOneLiner
Google
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

D:\>perl -0777 -e "$_=<>; while(s|<(.*?) .*?>(.*?)<\/\1>|$2|sg){} while(s|<(.*?)>(.*?)<\/\1>|$2|sg){} print;" test.html
PerlTest
PerlTestBody
<hr>AllAboutPerlOneLiner,SearchOnGoogleWithSomeWords.Google'sLogo<img href="http://www.google.com" alt="GoogleLogo">IsHere.
Google
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner,SearchOn<a href="http://www.google.com">Google</a>WithSomeWords.Google'sLogo<img href="http://www.google.com" alt="GoogleLogo">IsHere.</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

D:\>perl -0 -pe "s/<[^>]*>//g;" test.html
PerlTest
PerlTestBody
AllAboutPerlOneLiner,SearchOnGoogleWithSomeWords.Google'sLogoIsHere.
Google
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner,SearchOn<a href="http://www.google.com">Google</a>WithSomeWords.Google'sLogo<img href="http://www.google.com" alt="GoogleLogo">IsHere.</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

D:\>perl -0 -pe "s/<[^>]*>//g;" test.html
PerlTest
PerlTestBody
AllAboutPerlOneLiner,SearchOnGoogleWithSomeWords.
Google'sLogoIsHere.
Google
D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner,SearchOn<a href="http://www.google.com">Google</a>WithSomeWords.
Google'sLogo<img href="http://www.google.com" alt="GoogleLogo">IsHere.</p>
<a href="http://www.google.com">Google</a>
</body>
</html>
D:\>

簡易と銘打っているならやっぱりスクリプトが長いのはよろしくないなぁということで。最初にあげたものに帰着したんだな。わざわざ-0をつけているのは1ファイルの内容をNULL値まで一気に$_に代入ということなんだけど、短い割りには上手いことHTMLタグを処理しているんだな。コンパイラはこれを下のように解釈しているんだな。

while (<>) {
  s/<[^>]*>//g;
} continue {
  print;
}

つまり、<で始まって、>以外の文字列が続いて、>で終わっているところは全て削除という操作をしているんだな。だから下手すると、意図しないところでマッチングされてしまうこともあるんだな。間違って<や>を文中で使用してしまうとそこも削除されてしまう可能性があるということ。

[フィルタ]各行のテキストに何かを追加して出力

C:\>perl -lne "print 'document.write('.chr(0x22).$_.'<>'.chr(0x22).'+'.$_.'+'.chr(0x22).'<br>\n'.chr(0x22).');'" a.txt

[フィルタ] テキストからHTML

秀逸なのはmap{}なんだな。map{}で@Aの全要素に対して置換コマンドを実行しているんだな。map{}は戻り値が配列になるから戻り値を@Aに代入してはいけないんだな。ちなみに戻り値には@Aの各要素に含まれる改行の数が含まれているんだな。

C:\>perl -e "@A=<>; map{s/\n/<br>\n/g}@A; print @A" a.txt
I have a dream that one day this nation <br>
will rise up and live out the true meani<br>
ng of its creed: "We hold these truths t<br>
o be self-evident: all men are created e<br>
qual." on red hills Georgia sons former <br>
slaves slaveowners able sit down togethe<br>
r at table brotherhood. even state Missi<br>
ssippi, desert state, sweltering with he<br>
at injustice oppression, transformed int<br>
o an oasis freedom justice. my four chil<br>
dren in where they not judged by color t<br>
heir skin but content character. today.<br>
C:\>

ちなみにコンパイラは次のように理解しているんだな。

open IN,"$ARGV[0]";
@A=<IN>;
close IN;
map{s/\n/<br>\n/g}@A;
print @A;

こんな風にしても同じ出力なんだな。

C:\>perl -ne "s/\n/<br>\n/g; print;" a.txt

コンパイラ的には次のような感じ。

open IN,"$ARGV[0]";
while(<IN>){
  s/\n/<br>\n/g;
  print;
}
close IN;

どっちがすっきりしているかってのは微妙なとこなんだな。でも配列の各要素について処理して結果を配列で返すような場合はmap{}を使ったほうがなんとなくお得な感じがするんだな。

話は変わるけど下に様にすると@Aの各要素中に含まれるピリオドの数を出力できるんだな。

C:\>perl -e "@A=<>; @A=map{s/\./<br>\n/g}@A; print map{\"in line \".++$i.\" a \".$_.\" times\n\"}@A;" a.txt
in line 1 a  times
in line 2 a  times
in line 3 a  times
in line 4 a  times
in line 5 a 1 times
in line 6 a  times
in line 7 a 1 times
in line 8 a  times
in line 9 a  times
in line 10 a 1 times
in line 11 a  times
in line 12 a 2 times
C:\>

行末の2個以上連続する空白、タブを削除

D:\>perl -pe "s/(  +|\t\t+)$//g" test.html
    4 spaces 1 space
                2 tabs  1 tab
D:\>perl -pe "" test.html
    4 spaces 1 space
                2 tabs  1 tab
D:\>

連続する空白を削除

D:\>perl -pe "s/(  +|\t\t+)//g" test.html
4 spaces 1 space
2 tabs  1 tab
D:\>perl -pe "" test.html
    4 spaces 1 space
                2 tabs  1 tab
D:\>

連続する改行を削除

Unix$ perl -0 -pe 's/\n+/\n/g;'
Win32> perl -0 -pe "s/\n+/\n/g;"

-0777とはファイルを一気に読み込んでPerlワンライナーに渡すオプション

D:\>perl -0777 -pe "print" test.html
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
</body>
</html>
<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
</body>
</html>
D:\>

例えばこんな感じ。こいつをPerlインタプリタは下のように解釈しているんだな。

while(<>){
  print;
} continue {
  print;
}

出力を見るとよくわかるけど、whileループ中のprint文によって出力された変数内にはtest.htmlの内容全てが収められているんだな。だから、出力中の1番目の<html>から</html>まではwhileループ中のprint文で一気に出力され、2番目の<html>から</html>まではcontinue中のprint文で一気に出力されるんだな。これに対して、下のように書いた場合は結果が変わるんだな。

D:\>perl -pe "print" test.html
<html><head><title>PerlTest</title></head>
<html><head><title>PerlTest</title></head>
<body>
<body>
<h1>PerlTestBody</h1>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
<hr><p>AllAboutPerlOneLiner</p>
</body>
</body>
</html>
</html>
D:\>

解釈は上の場合と全く同じなんだけど、whileループに渡されたダイアモンド演算子中の内容が異なっているんだな。

while(<>){
  print;
} continue {
  print;
}

-0777をオプションで指定しない場合、ファイルから1行ずつ読み込んでその内容がダイアモンド演算子の内容になるから、ファイル中の内容を1行ごとwhileループ中のprint文で表示して、この後にもう一回continue中のprint文で同じ内容を表示しているんだな。試しに下のようにしてみると何回whileループ中の分を実行したかがよくわかるんだな。

D:\>perl -0777 -pe "$i++;print $i " test.html
1<html><head><title>PerlTest</title></head>
<body>
<h1>PerlTestBody</h1>
<hr><p>AllAboutPerlOneLiner</p>
</body>
</html>
D:\>

この場合は-0777オプションがついているので、test.html中の内容が一気に渡され、whileループは1回。

D:\>perl -pe "$i++;print $i " test.html
1<html><head><title>PerlTest</title></head>
2<body>
3<h1>PerlTestBody</h1>
4<hr><p>AllAboutPerlOneLiner</p>
5</body>
6</html>
D:\>

この場合は-0777オプションがついていないので、test.html中の内容が行ごとに渡され、whileループは行数回だけ繰り返され、6回。

気分的な問題だけど、渡すファイルのファイルサイズが小さい場合は、-0777オプションをつけたほうが速いような気がしたんだな。つまり、

D:\>perl -0777 -pe "" test.html

としたほうが、

D:\>perl -pe "" test.html

とするよりも体感速度が速いということ。まぁタイプする量が少ないほうが好きなんで下のほうをよく使っちゃいますが。WindowsのMS-DOSプロンプトを使う場合は、入力する文字数に制限があるので、この手の逃げを使うことも結構有用かと。

バックアップを残して操作

perl -i.bak -pe s/abc/ABC/g *.txt

.txt の文字列abcを全てABCにして上書きする。*.txt.bakというファイルにバックアップは残す。

[ファイル編集] ファイル中の特定のレコードを加工して出力

D:\backup\LaTeX\Stress_Distribution>perl -ane "next if @F==();print \"set label'($F[3]$F[4]$F[5])' at $F[13],$F[15]\n\";" imp.dat>t
D:\backup\LaTeX\Stress_Distribution>perl -ane "next if @F==();print \"set label'($F[3]$F[4]$F[5])' at $F[7],$F[15]\n\";" imp.dat>t
D:\backup\LaTeX\Stress_Distribution>perl -ane "next if @F==();print \"set label'($F[3]$F[4]$F[5])' at $F[10],$F[15]\n\";" imp.dat>t
D:\backup\LaTeX\Stress_Distribution>

[ファイル編集] ファイル中の特定のレコードだけ出力

C:\WINDOWS\デスクトップ>perl -F"<>" -alne "print\"@F[1]\";" b.txt
Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)
Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90)
Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90; Lunascape 2.0.3)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (R1 1.5); .NET CLR 1.1.4322) Sleipnir/2.00
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.0.3705; .NETCLR 1.1.4322)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; InfoPath.1)
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; iebar)
Mozilla/5.0 (Macintosh; U; PPC Mac OS X; ja-jp) AppleWebKit/312.5.1 (KHTML, like Gecko) Safari/312.3.1
C:\WINDOWS\デスクトップ>

open IN,"b.txt";
@F=<IN>;
chomp @F;close IN;
for ( $i=0 ; $i<=$#F ; $i++ ) {
        @H = split(/<>/,$F[$i]);
        for ( $j=0 ; $j<=$#H ; $j++ ){
                $G[$i][$j]=$H[$j];
        }
}
for ( $i=0 ; $i<=$#G ; $i++ ) {
        for ( $j=0 ; $j<=$#{$G[$i]} ; $j++ ){
                print "$G[$i][$j]\n";
        }
}

[ファイル編集]配列のオフセット値が負(-x)の場合には、配列の末尾から数えてx番目

例えば、空白で区切られた4列のデータファイルがあったとする。このとき、各行を空白で区切った内容は配列@Fに収められる。したがって、1行目、2行目、3行目、4行目の内容はそれぞれ、$F[0]、$F[1]、$F[2]、$F[3]に収められる。このとき、配列のオフセット値に負の数を指定すると、1行目、2行目、3行目、4行目の内容はそれぞれ、$F[-4]、$F[-3]、$F[-2]、$F[-1]に収められる。つまり、配列のオフセット値に負(-$n)を指定した場合、$F[-$n]の内容は、配列の末尾から数えて$n番目の内容と同じ、つまり$F[$n-$#F-1]ということなんだな。

C:\WINDOWS\デスクトップ>perl -lane "$n=1; print \"$F[$n-$#F-1] $F[$n]\"" b.dat
2.11520385742188 2.11520385742188
3.05591735839844 3.05591735839844
4.1234130859375 4.1234130859375
5.36311340332031 5.36311340332031
6.1601806640625 6.1601806640625
7.09348449707031 7.09348449707031
8.60143432617187 8.60143432617187
9.57536010742187 9.57536010742187
10.8480926513672 10.8480926513672
11.7131164550781 11.7131164550781
12.6625122070312 12.6625122070312
14.0559478759766 14.0559478759766
14.6789276123047 14.6789276123047
16.3958953857422 16.3958953857422
16.2184478759766 16.2184478759766
17.0652526855469 17.0652526855469
19.6688018798828 19.6688018798828
19.8661254882813 19.8661254882813
20.2305358886719 20.2305358886719
22.4033935546875 22.4033935546875
C:\WINDOWS\デスクトップ>

[数値計算] 任意の関数f(x)の表現

C:\>perl -e "$x=4; $a=1; $f[$x]=exp(-$a*$x**2); print $f[$x]"
1.12535174719259e-007
C:\>

C:\>perl -le "$a=1; for(1..10){ $x=$_; $f[$x]=exp(-$a*$x**2); print $f[$x]}"
0.367879441171442
0.0183156388887342
0.00012340980408668
1.12535174719259e-007
1.3887943864964e-011
2.31952283024357e-016
5.24288566336346e-022
1.60381089054864e-028
6.63967719958073e-036
3.72007597602084e-044
C:\>

C:\>perl -le "$a=1; $f[$x]=$x**2; for(1..10){ $x=$_; $g[$x]=exp(-$a*$x**2); print \"$x\t$f[$x]\t$g[$x]\";}"
1               0.367879441171442
2               0.0183156388887342
3               0.00012340980408668
4               1.12535174719259e-007
5               1.3887943864964e-011
6               2.31952283024357e-016
7               5.24288566336346e-022
8               1.60381089054864e-028
9               6.63967719958073e-036
10              3.72007597602084e-044
C:\>

うまくできたと思ったけど、こうするとだめなんだな。つまり上の場合、$f[$x]には何も含まれてはいないから表示もされないわけなんだな。これは$f[$x]を定義した式の右辺に$xが含まれていて、$xがこの時点で定義されていないためなんだな。そこで下のようにしてみるんだな。

C:\>perl -le "$a=1; sub f(){return exp(-$a*$_**2);} for(1..10){ print &f($x)}"
0.367879441171442
0.0183156388887342
0.00012340980408668
1.12535174719259e-007
1.3887943864964e-011
2.31952283024357e-016
5.24288566336346e-022
1.60381089054864e-028
6.63967719958073e-036
3.72007597602084e-044
C:\>

こうするとprint文が実行されたときにサブルーチン&fが引数$x付きで呼ばれて、目的の関数を毎回定義しなくてもよくなるんだな。また、こうすることで余分なメモリを使わなくてすむこともあるんだな。つまり、どうせ1回表示するだけならサブルーチンとして定義しておいたほうがいいということ。

[省文字] 乱数の生成

例えば、ある関数f(x)がg(x)とh(x)の線形結合であらわされている場合、f(x)=a*g(x)+b*h(x)と書けるんだな。計算するたびにこのaとbを適当な数に変化させ、xとf(x)を出力する場合を考えるんだな。

C:\>perl -le "@S = map{rand} @S[0..9]; print \"@S\";"
0.6502685546875 0.025390625 0.410919189453125 0.35791015625 0.797760009765625 0.361724853515625 0.340911865234375 0.92474365234375 0.505035400390625 0.580718994140625
C:\>

上のようにすると大量に乱数を変数にセットできるんだな。こいつを使ってある関数g(x)、h(x)の線形結合を出力してみるんだな。

C:\>perl -le "sub f{@S=map{rand}@S[0..3]; return $S[3]*$_**3+$S[2]*$_**2+$S[1]*$_+$S[0];} for(1..10){$f=&f($_); print \"$_ $f\";}"
1 2.25576782226563
2 7.90341186523438
3 13.4155578613281
4 35.8011169433594
5 49.6056213378906
6 233.369232177734
7 120.380859375
8 267.388641357422
9 58.6871643066406
10 589.035797119141
C:\>

上の例が最大にスクリプトを長く書いた例で、これ以上は入力できないんだな。これを改良してより多くの独立な変数を使うことを考えるんだな。

C:\>perl -le "sub f{($a,$b,$c,$d)=map{rand}@S[0..9]; return $d*$_**3+$c*$_**2+$b*$_+$a;} for(1..10){$f=&f($_); print \"$_ $f\";}"
1 1.01864624023438
2 2.65805053710938
3 31.4973754882813
4 5.29510498046875
5 135.414398193359
6 117.433990478516
7 191.104675292969
8 240.653472900391
9 701.856262207031
10 420.729797363281
C:\>

最初の改良例はこんな感じなんだな。確かにf(x)の表記は単純になったけど、その分だけmap{}から受ける配列が複雑になってプラマイゼロの内容なんだな。どうにかしてもう一つ余分な変数上の例では$eもう一つ上の例では$S[4]をどうにかしたいんだな。

[map{}を使え]データ処理

C:\>perl -le "sub f{@S=map{1+rand(0.1)}@S[0..3];return $S[3]*$_**3+$S[2]*$_**2+$S[1]*$_+$S[0]}for(-9..9){print $_.\" \".&f($_);}">a
C:\>

この後gnuplotで各変数が1.05に近ければうれしいんだな。

gnuplot> plot 'a', 'a' smooth csplines with lines,'a' smooth bezier,'a' using 1:2:(1.0) smooth acsplines
gnuplot> f(x)=d*x**3+c*x**2+b*x+a
gnuplot> fit f(x) 'a' via a,b,c,d
Final set of parameters            Asymptotic Standard Error
=======================            ==========================
a               = -1.53336         +/- 1.965        (128.1%)
b               = 0.818395         +/- 0.6023       (73.59%)
c               = 1.30882          +/- 0.0489       (3.736%)
d               = 1.0591           +/- 0.01028      (0.9706%)
correlation matrix of the fit parameters:
               a      b      c      d
a               1.000
b              -0.000  1.000
c              -0.747  0.000  1.000
d               0.000 -0.918 -0.000  1.000
gnuplot> plot 'a', 'a' smooth csplines with lines,'a' smooth bezier,'a' using 1:2:(1.0) smooth acsplines,f(x)
gnuplot>

ものすごく違うところがあるんだな。非常に不遜ながら標準偏差を考えれば一応あっていそうな感じがするんだな。ところでプロットの結果はやはり、ベジェ曲線やスプライン補間のほうが上手く実験の結果を表していることに気が付くんだな。各関数の形は単純な形なのにこれはかなりがっかりな結果なんだな。

[ファイル編集] 表計算

Schwartzian Transform Methodについて書いてみようと思うんだな。まずは下のスクリプトを見てほしいんだな。

test_STM.pl

# Schwartzian Transform Method
# First Section --- Difinition of @LIST ---
# Difinition of @LIST
@LIST = ('1,21,4'  ,
         '5,33,43' ,
         '15,2,5' ,
         '12,15,21');
print "@LIST\n";
# Second Section --- Get Refference of each line in @LIST ---
# For each elements in @LIST
foreach (@LIST){
  # Split now-specificated element in @LIST by ",".
  # In @tmp, there are 3 elements. These are values.
  my @tmp = split(/,/,$_);
  # Get @tmp's refference by "[ ]".
  # In @tmp, there are 3 elements. These are refferences.
  my @tmp = [@tmp];
  # Add them to @tmp_LIST
  # In @tmp_LIST, 3 elements added each times. These are refferences.
  push @tmp_LIST,@tmp;
}
print "@tmp_LIST\n";
# Forrowing is the same working
# map{} gets forrowing array and returns the result of the statement in { }.
# @tmp_LIST = map{[split(/,/,$_)]} @LIST;
# print "@tmp_LIST\n";
# Third Section --- Sort @LIST by using derefference of @tmp_LIST ---
# $a and $b is refference of @LIST.
# And derefference them by operator ->[]. So $a->[2] and $b->[2] are values themselves.
# Sort them by values. Rewrite @tmp_LIST.
# Sort gets a forrowing array and returns a value of the array by criterion in {}.
# In @tmp_LIST, there are 4 elements. These are refferences.
#@tmp_LIST = sort{$a->[2] cmp $b->[2]} @tmp_LIST;
# If sorting them by number is needed, forrowing is sutable.
@tmp_LIST = sort{$a->[2] <=> $b->[2]} @tmp_LIST;
print "@tmp_LIST\n";
# Fourth Section --- Join them ---
# For each elements in @tmp_LIST
foreach(@tmp_LIST){
  # Get values themselves refferenced by $_.
  my @tmp = @$_;
  # Join each elements in @tmp by ",".
  my @tmp = join(',',@tmp);
  # Add them to @NEW_LIST.
  push @NEW_LIST,@tmp;
}
print "@NEW_LIST\n";
# Forrowing is the same working
#@NEW_LIST = map{join',',@$_} @tmp_LIST;
#print "@NEW_LIST\n";
# All sections can be written in one line.
# Forrowing is One line style about upper sections.
#@NEW_LIST = map{join',',@$_} sort{$a->[2] cmp $b->[2]} map{[split',']} @LIST;
#@NEW_LIST = map{join',',@$_} sort{$a->[2] <=> $b->[2]} map{[split',']} @LIST;
#print "@NEW_LIST\n";

例えば下のようにするとa.dat中の1カラムにxの値、2カラムに二次関数の値がセットされるんだな。

C:\>perl -le "sub f{($a,$b,$c)=(rand,rand,rand);return $a*$_**2+$b*$_+$c;} for(-9..9){$x=$_+rand;$f=&f($x);print \"$x $f\";}">a.dat
C:\>

結果を表示すると下のようになるんだな。

C:\>perl -le "@a=<>; print @a;" a.dat
-8.77401733398438 72.4348754882813
-7.83602905273438 5.97018432617188
-6.059326171875 35.9939270019531
-5.44882202148438 33.2612609863281
-4.21817016601563 9.92474365234375
-3.3221435546875 -1.31829833984375
-2.09671020507813 3.02935791015625
-1.600341796875 2.762939453125
-0.749908447265625 0.922332763671875
0.154327392578125 0.6827392578125
1.42169189453125 2.23629760742188
2.8875732421875 2.50311279296875
3.66021728515625 7.56057739257813
4.10379028320313 19.9759826660156
5.96383666992188 5.775146484375
6.0418701171875 17.5700378417969
7.32489013671875 35.4329223632813
8.97604370117188 31.3730163574219
9.09332275390625 29.8526916503906
C:\>

これを上の方法を使って2カラム目でソートしてみるんだな。

C:\>perl -le "@a=<>; @b=map{join' ',@$_}sort{$a->[1]<=>$b->[1]}map{[split/\s/]}@a; for(@b){print}" a.dat
-3.3221435546875 -1.31829833984375
0.154327392578125 0.6827392578125
-0.749908447265625 0.922332763671875
1.42169189453125 2.23629760742188
2.8875732421875 2.50311279296875
-1.600341796875 2.762939453125
-2.09671020507813 3.02935791015625
5.96383666992188 5.775146484375
-7.83602905273438 5.97018432617188
3.66021728515625 7.56057739257813
-4.21817016601563 9.92474365234375
6.0418701171875 17.5700378417969
4.10379028320313 19.9759826660156
9.09332275390625 29.8526916503906
8.97604370117188 31.3730163574219
-5.44882202148438 33.2612609863281
7.32489013671875 35.4329223632813
-6.059326171875 35.9939270019531
-8.77401733398438 72.4348754882813
C:\>

たったこれだけでソートできてしまうんだな。キモはmap{}を使うとこなんだな。これを使うとforeach{}文で配列にpushするような場合のスクリプトを短く書けるんだな。

[Perl] 多数のカラムでソート(複数キーソート)

#c.f. perl ソート 複数
@yy = map{join'<>',@$_}sort{($a->[0]cmp$b->[0]) or ($b->[2]<=>$a->[2]) or ($a->[1]cmp$b->[1])}map{[split/<>/]}@yy;

最初に1カラム目でソート、次に3カラム目でソート、最後に2カラム目でソートしているんだな。つまり、ソートの優先順位は1、3、2なんだな。例えばこんな感じに結果を得るんだな。

HTTP_ACCEPT<>*/*<>147
HTTP_ACCEPT<>text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5<>1
HTTP_ACCEPT_CHARSET<>Shift_JIS,utf-8;q=0.7,*;q=0.7<>1
HTTP_ACCEPT_ENCODING<>gzip, deflate<>140
HTTP_ACCEPT_ENCODING<>gzip,deflate<>1
HTTP_ACCEPT_LANGUAGE<>ja<>146
HTTP_ACCEPT_LANGUAGE<>ja,en-us;q=0.7,en;q=0.3<>1
HTTP_ACCEPT_LANGUAGE<>ja-jp<>1
HTTP_ACCEPT_LANGUAGE<>zh-tw<>1
HTTP_CACHE_CONTROL<>max-age=259200<>1
HTTP_CONNECTION<>Keep-Alive<>145
HTTP_CONNECTION<>keep-alive<>3

[Perl] ログファイルを見やすい形に整形

たとえば次のようなデータファイルがあったとするんだな。

HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)<>5
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90)<>39
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90; Lunascape 2.0.3)<>25
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)<>4
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.0.3705)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; InfoPath.1)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)<>9
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (R1 1.3); .NET CLR 1.1.4322)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; (R1 1.5); .NET CLR 1.1.4322) Sleipnir/2.00<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.0.3705; .NET CLR 1.1.4322)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.0.3705; .NET CLR 1.1.4322; .NET CLR 2.0.50727)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)<>14
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; InfoPath.1)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; InfoPath.2) Sleipnir/2.10<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; iebar)<>1
HTTP_USER_AGENT<>Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; istb 702)<>1
HTTP_USER_AGENT<>Mozilla/5.0 (Macintosh; U; PPC Mac OS X; ja-jp) AppleWebKit/312.5.1 (KHTML, like Gecko) Safari/312.3.1<>1
HTTP_USER_AGENT<>Mozilla/5.0 (Windows; U; Win 9x 4.90; ja-JP; rv:1.7.12) Gecko/20050919 Firefox/1.0.7<>1

<>で区切られたこのファイルを3カラム目でソートすることを考えるんだな。これは今までの話から次のようにすればいいことがわかるんだな。

C:\WINDOWS\デスクトップ>perl -le "@a=<>; @b=map{join' ',@$_}sort{$b->[2]<=>$a->[2]}map{[split/<>/]}@a; for(@b){print}" b.txt

[Perl] 表計算フィルタ

よくあるデータの形式として、1列目にxの値、2列目にyの値を出力されたデータファイルがあるんだな。これらのデータの組を読み込んで加工して、新しいファイルを作ることを考えるんだな。

とりあえずテストファイルとして、下の様にして標準出力1列目にxの値、2列目にexp(x)の値を出力してみるんだな。

D:\>perl -le "sub f(){return exp($_);} for(1..20){$f=&f($_); print \"$_ $f\";}"
1 2.71828182845905
2 7.38905609893065
3 20.0855369231877
4 54.5981500331442
5 148.413159102577
6 403.428793492735
7 1096.63315842846
8 2980.95798704173
9 8103.08392757538
10 22026.4657948067
11 59874.1417151978
12 162754.791419004
13 442413.39200892
14 1202604.28416478
15 3269017.37247211
16 8886110.52050787
17 24154952.7535753
18 65659969.1373305
19 178482300.963187
20 485165195.40979
D:\>

実行結果が確認できたからこれをパイプ処理でa.datに書き込むんだな。ここまででデータファイルができたんだな。

D:\>perl -le "sub f(){return exp($_);} for(1..20){$f=&f($_); print \"$_ $f\";}">a.dat
D:\>

次はこれを加工することを考えるんだな。-aオプションを使ってオートスプリットモードとし、各列の内容を特殊配列@Fに読み込むんで、これを加工するんだな。ここでは、入力ファイルa.datの1列目の逆数を取り、2列目の自然対数を取ったんだな。

D:\>perl -alne "$F[0]=1/$F[0]; $F[1]=log($F[1]); print \"$F[0] $F[1] \"" a.dat
1 1
0.5 2
0.333333333333333 3
0.25 4
0.2 5
0.166666666666667 6
0.142857142857143 7
0.125 8
0.111111111111111 9
0.1 10
0.0909090909090909 11
0.0833333333333333 12
0.0769230769230769 13
0.0714285714285714 14
0.0666666666666667 15
0.0625 16
0.0588235294117647 17
0.0555555555555556 18
0.0526315789473684 19
0.05 20
D:\>

少し見づらいけど、1行目には1/$x、2行目にはlog(exp($x))=$xが表示されていることがわかるんだな。

[数値計算] 最小二乗法フィルタ

あるデータファイルに記載されたxとyの関係(実験の測定値)が次の関数でを満たしていると仮定するんだな。y=a*x+b。これから最小二乗法でaとbを定める事を考えるんだな。例えばデータファイルは「xの値、スペース、yの値、改行」のような書式となっているとするんだな。

とりあえずデータファイルを次のようにして生成したんだな。

C:\>perl -le "sub f(){$a=1+rand(0.1);$b=1+rand(0.1);return $a*$_+$b;} for(1..20){$x=$_+rand(0.1);$f=&f($x);print \"$x $f\";}">a.dat
C:\>

これにより生成したa.datの内容を表示すると下のようになるんだな。

C:\>perl -pe "" a.dat
1.01757202148438 2.11520385742188
2.05708923339844 3.05591735839844
3.03453979492188 4.1234130859375
4.03664245605469 5.36311340332031
5.02697448730469 6.1601806640625
6.01442565917969 7.09348449707031
7.04530944824219 8.60143432617187
8.09518127441406 9.57536010742187
9.06552429199219 10.8480926513672
10.0904388427734 11.7131164550781
11.0158996582031 12.6625122070312
12.0860198974609 14.0559478759766
13.0393676757813 14.6789276123047
14.0699066162109 16.3958953857422
15.0349884033203 16.2184478759766
16.0701873779297 17.0652526855469
17.0621643066406 19.6688018798828
18.0716796875 19.8661254882813
19.0795959472656 20.2305358886719
20.0910125732422 22.4033935546875
C:\>

最小自乗法で必要な∑x_n*x_n、∑y_n*x_n、∑x_n、∑y_n、∑1を求めるために、それぞれのxについてx_n*x_n、y_n*x_nを求めるんだな。

C:\>perl -alne "push @F,$F[0]**2,$F[0]*$F[1]; print \"@F\";" a.dat
1.01757202148438 2.11520385742188 1.03545281890781 2.15237226504834
2.05708923339844 3.05591735839844 4.23161611416378 6.28629469611683
3.03453979492188 4.1234130859375 9.20843176696452 12.512661100179
4.03664245605469 5.36311340332031 16.2944823180232 21.6489712604787
5.02697448730469 6.1601806640625 25.2704724960123 30.9670710354299
6.01442565917969 7.09348449707031 36.173316009799 42.663235172173
7.04530944824219 8.60143432617187 49.6363852214907 60.5997665266134
8.09518127441406 9.57536010742187 65.531959865624 77.5142758373729
9.06552429199219 10.8480926513672 82.1837306887005 98.3436474527513
10.0904388427734 11.7131164550781 101.81695603975 118.190485248248
11.0158996582031 12.6625122070312 121.350045279599 139.488963893428
12.0860198974609 14.0559478759766 146.071876961821 169.880465706726
13.0393676757813 14.6789276123047 170.02510938421 191.403934223019
14.0699066162109 16.3958953857422 197.962272188895 230.688716966556
15.0349884033203 16.2184478759766 226.050876287976 243.844175735163
16.0701873779297 17.0652526855469 258.250922361771 274.241808308457
17.0621643066406 19.6688018798828 291.117450826801 335.592329389322
18.0716796875 19.8661254882813 326.5856067276 359.014256455899
19.0795959472656 20.2305358886719 364.030981510914 385.990450552516
20.0910125732422 22.4033935546875 403.648786218176 450.10686159052
C:\>

確認できたらこいつをパイプ処理でb.datに出力してするんだな。

C:\>perl -alne "push @F,$F[0]**2,$F[0]*$F[1]; print \"@F\";" a.dat>b.dat

次に各行の和とデータの数を出力するんだな。

C:\>perl -alne "$x+=$F[0];$y+=$F[1];$xx+=$F[2];$xy+=$F[3];$n=$.;END{print \"$x $y $xx $xy $n\";}" b.dat>c.dat
C:\>perl -pe "" c.dat
211.10451965332 241.895156860352 2896.4767310872 3251.13074341602 20 
C:\>

最後に、下のように行列計算を行って結果を出力するんだな。

[∑y_n*x_n]=[∑x_n*x_n ∑x_n][a]
[∑y_n    ] [∑x_n     ∑1  ][b]
C:\WINDOWS\デスクトップ>perl -alne "$d=$F[2]*$F[4]-$F[0]**2;@a=(($F[4]*$F[3]-$F[0]*$F[1])/$d,($F[2]*$F[1]-$F[0]*$F[3])/$d);END{print \"@a\";}" c.dat
1.04437437081074 1.07115034860561
C:\WINDOWS\デスクトップ>

1つ目がa、2つ目がbなんだな。自信がないのでgnuplotで確かめてみるんだな。

gnuplot> fit a*x+b 'a.dat' via a,b
Final set of parameters            Asymptotic Standard Error
=======================            ==========================
a               = 1.04437          +/- 0.01597      (1.529%)
b               = 1.07115          +/- 0.1922       (17.94%)
correlation matrix of the fit parameters:
               a      b
a               1.000
b              -0.877  1.000
gnuplot> print a
1.04437437082676
gnuplot> print b
1.07115034838608
gnuplot> plot 'a.dat',a*x+b

確かに近い値となっていることがわかるんだな。完成したのでGIFで出力しておくんだな。

gnuplot> set terminal gif
Terminal type set to 'gif'
Options are 'small size 640,480 '
gnuplot> set output 'a.gif'
gnuplot> plot 'a.dat',a*x+b
gnuplot>

[数値計算] 数値積分(ガウス積分)

use Math::Trig;
$a     = 1;
$x_max = 5;
$x_min = 0;
$I_r=(1*2**-1)*sqrt(pi()*$a**-1);
$f[$x] = exp(-$a*$x**2);
$x_div = 20000000;  #精度向上因子
$i_max = ($x_max-$x_min)*$x_div;
for($i = 0 ; $i < $i_max ; $i++ ){
  $dx    = 1/$x_div;
  $x     = $i*$dx;
  $y     = exp(-$a*$x**2);
  $I    += $y*$dx;
  $dI    = $I_r-$I;
  last if($dI<=0);
  print "$x\t$y\t$I\t$dI\n" if ($i%($i_max/10)==0);
 # sleep(1);
}
print "$x\t$y\t$I\t$dI\n";
print "$I_r\n" ;
exit;

C:\>perl gaus.pl
0       1       5e-008  0.886226875452758
0.5     0.778800783071405       0.461281050882873       0.424945874569885
1       0.367879441171442       0.74682416700966        0.139402758443098
1.5     0.105399224561864       0.856188421260223       0.0300385041925354
2       0.0183156388887342      0.882081416220737       0.00414550923202095
2.5     0.00193045413622771     0.885866298666317       0.000360626786440998
3       0.00012340980408668     0.886207373263146       1.95521896119155e-005
3.5     4.78511739212901e-006   0.88622629189962        6.33553137507903e-007
3.92599695      2.02312551357165e-007   0.886226925452761       -3.10862446895044e-015
0.886226925452758
C:\>

C:\WINDOWS\デスクトップ>perl gauss.pl
5e-008  0.886226875452758
0.0500000500009228      0.836226875451835
0.100000050002361       0.786226875450397
0.150000050003798       0.73622687544896
0.200000050005236       0.686226875447522
0.250000050006674       0.636226875446084
0.300000049980356       0.586226875472402
0.350000049954038       0.53622687549872
0.400000049927721       0.486226875525037
0.450000049901403       0.436226875551355
0.500000049875085       0.386226875577673
0.550000049904278       0.33622687554848
0.600000049933472       0.286226875519286
0.650000049962665       0.236226875490093
0.700000049991858       0.1862268754609
0.750000050021052       0.136226875431706
0.800000050050245       0.0862268754025128
0.850000050079438       0.0362268753733195
0.8862269       1       0.88622695010059        -2.46478322196708e-008
0.886226925452758
C:\WINDOWS\デスクトップ>

C:\WINDOWS\デスクトップ>perl -le "$a=1; $x=1; for(0..10){ $x=$_; $y += exp(-$a*$x**2); print$y};"

[数値計算] 有理数の積と浮動小数点演算

C:\>perl -e "@d=(1,2,3,4); $c=$d[0]/$d[1]+$d[2]/$d[3]; $a=($d[0]*$d[3]+$d[2]*$d[1])/($d[1]*$d[3]); print \"$c $a\";"
1.25 1.25
C:\>

C:\>perl -e "@d=(1,2,3,4); @r=&d(@d); print $r[0]/$r[1]; sub d(){ $s=$_[0]*$_[3]+$_[2]*$_[1]; $i=$_[1]*$_[3]; return ($s,$i);}"
1.25
C:\>

C:\>perl -le "for(1..10){@r=&d(($_,$_+1,$_+1,$_+1)); print \"$r[0] $r[1]\";} sub d(){return $_[0]*$_[3]+$_[2]*$_[1],$_[1]*$_[3];}"
6 4
15 9
28 16
45 25
66 36
91 49
120 64
153 81
190 100
231 121
C:\>

C:\>perl -le "for(1..20){@d=($_++,$_++,$_++,$_++); @r=&d(@d); print \"@d @r\";} sub d{return $_[0]*$_[3]+$_[2]*$_[1],$_[1]*$_[3];}"
1 2 3 4 10 8
2 3 4 5 22 15
3 4 5 6 38 24
4 5 6 7 58 35
5 6 7 8 82 48
6 7 8 9 110 63
7 8 9 10 142 80
8 9 10 11 178 99
9 10 11 12 218 120
10 11 12 13 262 143
11 12 13 14 310 168
12 13 14 15 362 195
13 14 15 16 418 224
14 15 16 17 478 255
15 16 17 18 542 288
16 17 18 19 610 323
17 18 19 20 682 360
18 19 20 21 758 399
19 20 21 22 838 440
20 21 22 23 922 483
C:\>

下のようにやっても同じなんだな。

C:\>perl -le "for(1..20){@d=($_..$_+3);@r=&d(@d);print \"@d @r\";} sub d{return $_[0]*$_[3]+$_[2]*$_[1],$_[1]*$_[3];}"

等差数列の計算

C:\>perl -e "$a=1; $d=1; for (1..100) { $S+=$a+($_-1)*$d; } print $S"
5050
C:\>

これは少し便利かも知れないぞ。でも少し便利なだけ。等差数列には和の公式があるから。それを使ったほうが断然早い。特に1から10000000000間での計算とかやらせたとき。それにこの数が大きすぎると「数が大きすぎるぞコラ」メッセージが出る。例えばこんな感じに。

C:\>perl -e "$a=1; $d=1; for (1..100000000000000000) { $S+=$a+($_-1)*$d; } print $S"
Range iterator outside integer range at -e line 1.
C:\>

それよりもlオプションを使って、各項の値anとそのときの和Snを表示したほうがうれしいかもしれないな。例えばこんな風に。

C:\>perl -le "$a=1; $d=1; $an=0; for (1..10) { $an=$a+($_-1)*$d; $S+=$an; print"$an"."_"."$S";} print $S"
1_1
2_3
3_6
4_10
5_15
6_21
7_28
8_36
9_45
10_55
55
C:\>

それにしてもprint文の中でスペースはどう考えればいいのだろう。それはこうすればいいのだ。

C:\>perl -le "$a=1; $d=1; $an=0; for (1..10) { $an=$a+($_-1)*$d; $S+=$an; print "$an".' '."$S";} print $S"
1 1
2 3
3 6
4 10
5 15
6 21
7 28
8 36
9 45
10 55
55
C:\>

等比数列の計算

等差の次は等比ということで。代わり映えはしませんが。

D:\>perl -e "$a=1;$r=1;for (1..100) {$S+=$a*$r**($_-1);} print $S"
100

-10から10まで足し算の式とその結果

ただのお遊びですな。範囲演算子でマイナスが使えるんですねぇ。ちなみに文字を足し算しても0にしかなりません

D:\>perl -e "for (-10..10) {print; $_!=100 && print '+'; $n+=$_;} print '='.$n"
-10+-9+-8+-7+-6+-5+-4+-3+-2+-1+0+1+2+3+4+5+6+7+8+9+10+=0

アルファベットを範囲演算子で表示する2

D:\>perl -e "for (a..z,A..Z,0..9) { print $_ }"
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789

こんな使い方もあるんだと思った作品へぇ。

アルファベットを範囲演算子で表示する1

どっちが美しいかは好みですが。wオプションをつけないで実行すると致命的なエラー以外はエラー表示を抑止してくれるんだな。例えば下の1番目と2番目はwオプション無しと有りの場合を示するんだな。エラーを修正したものが3番目なんだな。3番目ははっきり言って冗長なんだな。まぁ1番目の方法でもうまいこと出力できているから良いといえばそれまでなんだけど。

C:\>perl -e "print (a..z,A..Z,0..9)"
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
C:\>perl -we "print (a..z,A..Z,0..9)"
print (...) interpreted as function at -e line 1.
Unquoted string "a" may clash with future reserved word at -e line 1.
Unquoted string "z" may clash with future reserved word at -e line 1.
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
C:\>perl -we "print join'',('a'..'z',A..Z,0..9)"
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
C:\>

文字列を改行せずに表示する

C:\>perl -e "print "'ww'";"
ww
C:\>

例えば、echoコマンドではこのようなことはできないんだな。下のようなコマンドを打つとその下のように必ず改行されて表示されるんだな。通常のファイル追記の場合はさほど問題はない(自動的に改行されたほうがよい)けど、困るときも時々あるんだな。

C:\>echo ww
ww
C:\>

unixの場合は\nを含めることで改行の可否が選択可能だというような話も聞いたことがあるけど、Windowsの場合はあまり親切なechoコマンドではないようなんだな。

文字列を複数行表示する

D:\>perl -e "print \"xxx\nyyy\nzzz\n\";"
xxx
yyy
zzz
D:\>

lオプションを使うのもいいけど、こっちのほうが汎用的でいいかも。複数行を一気に表示したいときに使えるんだな。ここまでくるとUNIXのechoコマンドにずいぶんと近づいてきたという感じなんだな。

注意が必要な文字

D:\>perl -e "print \"!"#$%&'()=~|-^\`{@[+*};:]<>?_,./\";"
!#0&'()=~|-^`{@[+*};:]<>?_,./
D:\>

変数展開ルール

D:\>perl -e "$n=ss; print \"ww$n\n\";"
wwss
D:\>

上でも書いたけど、エスケープすることで変数展開できるようになるんだな。上のコマンドはPerlに下のように解釈されているんだな。書き下してみると変数展開やメタ文字の解釈が行われるのもぜんぜん不思議じゃないんだな。

$n=ss; print "ww$n\n";

例えば、エスケープしないと変数展開されないどころか、コンパイルもうまくできないんだな。

D:\>perl -e "$n=ss; print "ww$n\n";"
Backslash found where operator expected at -e line 1, near "$n\"
        (Missing operator before \?)
syntax error at -e line 1, near "$n\"
Execution of -e aborted due to compilation errors.
D:\>

これに対してコーテーションにすると変数展開もされないし、メタ文字の解釈もされないんだな。

D:\>perl -e "$n=ss; print 'ww$n\n';"
ww$n\n
D:\>

範囲演算子で文字らしいASCII文字を表示する

D:\>perl -e "for (0x20..0x7E) { print chr($_); }"
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
D:\>

上の結果はあまり美しくないんで制御文字を取っ払ってみたんだな。これはいざとなれば文字コードとchr関数で文字を表現できることを示唆しているんだな。たとえば、上と同じような出力を得ようとして下のようにするとエラーが出ていることがわかるんだな。

D:\>perl -e "print \" !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~\";"
syntax error at -e line 1, near "\]"
Execution of -e aborted due to compilation errors.
D:\>

これは以下のようにすると解決できるんだな。

D:\>perl -e "print \" !\".'\"'.\"#\$%&'()*+,-./0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\";"
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
D:\>

解決するといってもこのコマンドは長すぎて、WindowsMeのMS-DOSプロンプトでは入力できないんだな。入力バッファの最大サイズは255バイトよりも増やせない事がその理由なんだな。Windows2000やWindowsXPなんかのコマンドプロンプトは入力バッファサイズに足かせがないから入力できるんだな。といってもここで注目すべきなのは、エスケープの仕方なんだから結果が見えていればいいんだな。さて、円マークでエスケープしたダブルクヲートに挟まれた文字のうちで唯一挙動の違うのは、ダブルクヲートなんだな。こいつだけはシングルクヲートで囲んで文字列連結で出力するしかなさそうなんだな。これ以外の文字は通常のエスケープがそのまま適応できるようなんだな。

[文字出力]Wide character in print at -e line 1.に困ったら

C:\>perl -e "binmode(STDOUT,':utf8'); print map{chr($_)}(0x00..0x1ff);"
C:\>

文字列を改行せずにファイルに書き込む

D:\>perl -e "print "'ww\n'";">test.txt

Windowsのechoコマンドの引数をパイプ処理でファイルに書き込む(D:\>echo "aaa" > test.txt)と必ず改行が後ろにつくけど、こうすると改行なしでファイルに書き込める。問題は複数の行を一度に書き込むにはどうするかだな。

改行コードをつけて文字列をファイルに書き込む。

D:\>perl -l -e "print "'ww'";">test.txt

ActivePerlなのかWindowsの仕様かとにかくprint文の中に\nを書き込んでも改行されないようだ。と言うことは改行するためだけに何行もprint文を書かねばならんのか。

アルファベットや数字以外をどう書くか

D:\>perl -e "print "'!\"#$%&\'()=-~^|\`@{[+;*:}]<,>.?/_\\'";"
!"#$%&'()=-~^|\`@{[+;*:}]<,>.?/_\

問題はどうやって1文字分のスペースを表現するかだな。

ファイルの内容を表示する3

D:\>perl -pe "" test.html
<html><head><title>PerlTest</title></head>
<body>PerlTestBody</body>
</html>
D:\>

ファイルの内容を表示するだけならこれで十分かも。-pオプションをつけてperlを起動すると、-eオプションで指定した1行スクリプトをwhikeループ中に実行し、次のループの前処理を行なうcontinue文の中でprint文を実行するんだな。つまり下のように解釈されたんだな。

while (<>) {
} continue {
  print;
}

ファイルの内容を加工して表示する(Google 検索結果から不要な情報を切る)

例えばsite:blog.mag2.com perlとかsite:www.mag2.com perlとかで検索した結果をtxtで保存してこれからマッチする行を取り出す。

C:\WINDOWS\デスクトップ> perl -lne "if(s/^((www|blog).mag2.com\/(m\/|m\/log\/)[0-9]*(.html|[0-9]*))( - [0-9])//){print'http://'.$1;}" mag.txt>mag2.txt
C:\WINDOWS\デスクトップ>

ファイルの内容を表示する2

C:\>perl -p -e 'print' test.txt

-pで入力ファイルを指定、-eの後に続くはスクリプト文。print文を囲むのはシングルクヲート。ダブルにすると多分うまくいかない。

ファイルの内容を表示する1

C:\>perl -p -e 'print;' test.txt

print文の最後にセミコロンをつけてもうまくいく。

ファイルの内容を1行につき2回表示する

C:\>perl -p -e "print;" test.txt

ダブルコーテーションにすると全ての行を2回づつ表示するのなんでだろ。

ファイルの内容に行番号を付加してを表示する

C:\>perl -p -e "print "$o++"."':'";" test.txt

メールサーバにログイン(受信せず)

use Net::POP3;
my $server = 'pop.mail.yahoo.co.jp';
my $pop3  = Net::POP3->new($server) or die "Can't not open account.";
my $account  = 'ACCOUNT';
my $password = 'PASSWD';
my $count = $pop3->login($account, $password);
   $pop3->quit;

D:\>perl -MNet::POP3 -e "$pop3 = Net::POP3->new('pop.mail.yahoo.co.jp');$pop3->login('ACCOUNT','PASSWD');$pop3->quit;"
D:\>

メール送信

use Net::SMTP;
$smtp = Net::SMTP->new('smtp.mail.yahoo.co.jp');
$smtp->mail('SENDERADDRESS');
$smtp->to('GETTERADDRESS');
$smtp->data("To: My Dearest User\r\n\r\nA simple test message.\r\nIs anything wrong?\r\n")
$smtp->quit;
exit;

c:\>perl -MNet::SMTP -e "$s=Net::SMTP->new('smtp.mail.yahoo.co.jp');$s->mail('SEND');$s->to('GET');$s->data(\"\nMessage\n\");$s->quit;"

このままではWinMEのMS-DOSプロンプトでは文字数制限に引っかかるんだな。一応の解決策としては、バッチファイル中にこのプログラムを書き込んで使うという方法なんだな。でもそんなことするくらいなら、plファイルに書き込んでおいて実行するほうがずっと賢いんだな。

グロブとは何ぞや

C:\WINDOWS\デスクトップ>perl -e "$L=Hello; @L=(1,2,3,4); *s=*L; print \"$s\n\"; print \"$s[1]\";"
Hello
2
C:\WINDOWS\デスクトップ>

一体グロブとは何ぞや。

*s = *L;

こうすることでLという名前の付いた変数($L)、ハッシュ(@L)、配列(%L)、サブルーチン(&L)をそれぞれ、sという名前の付いた変数($s)、ハッシュ(@s)、配列(%s)、サブルーチン(&s)をとして参照できるんだな。つまり、ものすごく長い名前の変数($verylooooooooooooooooooooongname)を作っても、グロブでこの変数名と短い名前を対応付けておくことで、長い変数名を何回も使わなくてもよくなるということ。

C:\>perl -e "$verylooooooooooooooooooooongname = \"longlong\"; *s = *verylooooooooooooooooooooongname; print $s;"
longlong
C:\>

書き下せば

$verylooooooooooooooooooooongname = "longlong";
*s = *verylooooooooooooooooooooongname;
print $s;

ということ。

スカラ変数に対するリファレンスのいろは

D:\>perl -e "$word = \"A\"; $ref_word = \$word; print $ref_word;"
SCALAR(0x1555d70)
D:\>

こういうことがわざわざファイルを作らなくてもいいということが一行スクリプトのうれしい点かも。まぁそれはおいといて。上は変数$wordに文字列Aを代入して、変数$wordのリファレンス(メモリアドレス)を取得して、これを表示しているんだな。つまりこんな感じなんだな。

$word     = "A";
$ref_word = \$word;
print $ref_word;

変数名の前につけた\のことをリファレンス演算子と呼ぶんだな。この演算子の付いたスカラ変数の中身は変数と対応したメモリアドレスになっているんだな。

D:\>perl -e "$word = \"A\"; $ref_word = \$word; print $$ref_word;"
A
D:\>

こんな風にしてみるとまた違った出力が得られるんだな。こいつは書き下すと下のような感じになるんだな。

$word     = "A";
$ref_word = \$word;
print $$ref_word;

リファレンスの含まれる変数の前にドルマーク$を加えて出力するとリファレンスの指し示す変数の内容が出力されるんだな。

[perl] リファレンスに関するテスト(1)

リファレンスとは何ぞやということがわかっていなかったので、テストコードを書いてみた。なんとなくわかった気がする。それでもわからなきゃData::Dumperでも使ってなってことだ。

@LoL = ( ["00", "01"], ["10", "11", "12"], ["20"] );
  print $LoL[1][1];
#  11
#    $ref =\@LoL;
#    print $ref;
@value = @LoL;
print "\n";
foreach my $ref_array (@value){ 
print $ref_array;
 foreach (@$ref_array){ 
    print $_.","; 
 } 
 print "\n"; 
}
print @LoL;
#  ARRAY(0x83c38)ARRAY(0x8b194)ARRAY(0x8b1d0)
exit;

[perl] リファレンスに関するテスト(2)

リファレンスとは何ぞやということがわかっていなかったので、テストコードを書いてみた。

# generate unnamed array by [ ]@LoL = ( ["1" , "21", "21" ],
                ["5" , "33", "43" ],
                ["12", "15", "21" ] );
# in array @LoL, thera are references of each element quarted by [ ]print "@LoL\n";# that is why, each refferance $_ operated ->[0] means the real value of 1,5,12# and, operated ->[1] and ->[2] are understanded in the same way.foreach (@LoL){
        print $_."\t".$_->[0]."\t".$_->[1]."\t".$_->[2]."\n";
}# to sort values on 3rd column, How to?# first, get values and refferences on 3rd column# and generte hash %column like key:refference value:value.foreach (@LoL){
        $column{$_} = $_->[2];
}print %column;print "\n";# second, sort values in hash and get the rasult in array @column_sorted.# third, foreach my $value (sort {$a<=>$b} values %column){
        foreach my $key ( keys %column ){
                if ( $value eq $column{$key} ){
                        $value2 = delete $column{$key};
                        print "$value2\t$key\n";
                        push @LoL2,$key;
                        last;
                }
        }
}print "@LoL2\n";# on the end here is a sorted LoL by the numberes on 3rd columnforeach my $ref (@LoL2){
        foreach (@LoL){
                if ($_ eq $ref){
                        print $_."\t".$_->[0]."\t".$_->[1]."\t".$_->[2]."\n";
                        last;
                }
        }
}
exit;

リファレンスでどうしようもなくなったらDumperを使え(test_reference.pl)

#!/usr/bin/perl -w
#test_reference.pl
use strict;
my @LoL = ( ["00", "01"], ["10", "11", "12"], ["20"] );
use Data::Dumper; #for using Dumper()
print Dumper(@LoL);
exit;

D:\test>perl -w test_reference.pl
$VAR1 = [
          '00',
          '01'
        ];
$VAR2 = [
          '10',
          '11',
          '12'
        ];
$VAR3 = [
          '20'
        ];

お手軽にhttpリクエストをダンプします。

C:\>perl -MHTTP::Daemon -e "warn HTTP::Daemon->new(LocalPort =>80)->accept->get_request->as_string"
GET / HTTP/1.1
Connection: Keep-Alive
Accept: */*
Accept-Encoding: gzip, deflate
Accept-Language: ja
Host: 219.209.188.79
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90; Lunascape 2.0.3)

HTTP::Daemonで簡単なhttpサーバ

use HTTP::Daemon;
use HTTP::Status;
my $d = new HTTP::Daemon;
$d = new HTTP::Daemon
  LocalAddr => '',
  LocalPort => 80;
print "Please contact me at: <URL:", $d->url, ">\n";
while (my $c = $d->accept) {
  while (my $r = $c->get_request) {
  warn $r->as_string;
    if ($r->method eq 'GET' and $r->url->path eq "/") {
        $c->send_file_response("./Dd21.txt");
    } else {
        $c->send_error(RC_FORBIDDEN)
    }
  }
  $c->close;
  undef($c);
}
exit;

D:\test>perl -w http_deamon_deamon.pl
Please contact me at: <URL:http://eizi/>
GET / HTTP/1.1
Connection: Keep-Alive
Accept: */*
Accept-Encoding: gzip, deflate
Accept-Language: ja
Host: 219.209.188.83
If-Modified-Since: Tue, 27 Sep 2005 08:00:00 GMT
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Win 9x 4.90; Lunascape 2.0.3)

httpリクエストをダンプする

InetSpy (+ 横取り丸)Proxomitronのいずれかでやってましたが、今日LindowsOS開発日誌見ていたらおもしろいの見つけました。

お手軽にHTTPプロキシサーバをたてます。(not work on ActivePerl)

$ perl -MHTTP::Proxy -e 'HTTP::Proxy->new(port => 8080)->start'

HTTP::Proxyでエラー以外のログを有効する方法

エラー以外のログを有効にしたい場合は以下のような感じです。ただし、ActivePerlでは使えないようです。

$ perl -MHTTP::Proxy=:log -e '$p=HTTP::Proxy->new(port => 8080);$p->logmask(ALL);$p->start;'

FS2HTML

D:\>perl -i.bak -p -e "s/^(.*)\n/<p>$1<\/p>\n/g" a.html
D:\>perl -i.bak -p -e "s/^<p>!!!(.*)<\/p>\n/<h1>$1<\/h1>\n/g" a.html
D:\>perl -i.bak -p -e "s/^<p>\s(.*)<\/p>\n/<div>$1<\/div>\n/g" a.html
D:\>

telnetは付加、Perlは可。このとき1行スクリプトをどう動かすか

telnetの使えないサーバで、Perlで書かれたcgiが動くサーバがある。ここで、一行スクリプトを動かすにはどうすればよいか。これを考える。

PerlShell.cgi

#!/usr/bin/perl
print "Content-Type: text/html\n\n";
print "<HTML>\n";

[文字操作] パスワードジェネレータ

> perl -e "for(1..32){print chr(int(rand(127-33))+33)}"
th#&KSlwl-e"o@TD/\;n&N3?~uRhyZbQ
> perl -e "for(1..32){print chr(int(rand(127-33))+33)}"
>%wh2WQ_maL6.bi)wBzt$_4wW10t}DBp

わかりにくい。わかりにくすぎて覚えられない。でも破るのは難しそうだ。範囲演算子を使えば何とかなるんじゃないかということで、下のように変えてみたんだな。先に言っとくけどID取得なんかにも使えるんだな。というわけで、実際にやってみた例。たとえばYahoo.comのYahoo! IDは"ID may consist of a-z, 0-9, underscores, and a single dot (.)"出なければいけないそうな。そこで第1段階でこんな感じにしてみたんだな。

> perl -e "unshIFT @F,(a..z),(0..9),'_','.'; print @F;"
abcdefghijklmnopqrstuvwxyz0123456789_.

つまりIDに使える文字(アルファベットの小文字と0から9までの数字とアンダーバーとピリオド)を配列@Fに代入したんだな。次に配列の添え字をランダムに選ぶことによって@Fから1文字選ぶことを適当な回数繰り返せばよいということなんだな。最終的には下のような感じになるんだな。配列の最後の添え字に1足す理由は次のような感じ。rand関数は、ゼロから引数未満の数を返すので、1足さないと配列の最後の内容(ここではピリオド)は出力されないから。

> perl -e "unshift @F,(a..z),(0..9),'_','.'; for(1..70){print $F[int(rand($#F+1))]}"
rnl5_.kenfntt5lujl7l2p_.r0ph5575u0nvclw7f4tsxcf1fysv0grxqmf_.hho4ekzzvn3a

> perl -e "@F=(a..z,0..9,qw(, . _)); print map{$F[rand $#F+1]}(0..16);"
5gdlsyjkvyoda9wos

まぁこういうものは必要になると急激に使用頻度が増えるもので、ふとした瞬間に使いたくなるってこともある。んで、また書いてしまった。

perl -e 'while($i<30){$j=0;while($j<8){$_=chr int rand(127); if(m/[a-z]/){print; $j++;}}print "\n";$i++;}'

これで30個の適当な9文字の文字列を生成してくれる。前よりもコードが長くなっていたり非効率になっている。今回はこれでご勘弁を。

ランダムな文字列を生成するString::Random - Unknown::Programming

環境変数のチェック

> perl -le "map{print qq/$_ $SIG{$_}/}keys %SIG"
> perl -le "map{print qq/$_ $ENV{$_}/}keys %ENV"

範囲演算子でASCII文字を表示する

テストとしてやってみたんだな。範囲演算子は数を一つずつ増やし、各コード値に対応したASCII文字をchr関数で返すんだな。制御文字まで含まれているので出力がおかしくなる。chr関数の引数には10進数も取れるので下の2つは全く同じ出力。どちらも、ASCII文字の0番目から127番目の文字(全部で128文字)を出力しているんだな。

> perl -e "print map{chr}(0..127)"
> perl -e "print map{chr}(0x00..0x7F)"

兎に角人間様がわかる文字だけを出力したい時は下のようにするといい。出力する範囲を換えただけだけど、範囲を変えるときは16進数で書いたほうがわかりやすいかもしれない。

> perl -e "print map{chr}(0x20..0x7e)"
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~

人間様が理解できるといえば、あとは改行になるのかなぁ。改行が0x0aなのか0x0dなのか0x0a0x0dなのかは宗教戦争なので適当に0x0aだと考えれば、下のようにかける。

$ perl -e "print map{chr}(0x0a,0x20..0x7e)'
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~

[psl]ASCIIコード一覧表

モジュールの存在チェック

> perl -e "use Net::POP3;"

例えばNet::POP3モジュールがインストールされているかを上のように入力してチェックするんだな。これで何にも表示されずにプロンプトに戻ったらインストールされているということなんだな。インストールされていない場合はperlのライブラリディレクトリの下に指定されたモジュールが無いことを示すメッセージが出る。エラーを見ればわかるけど@INCにライブラリを探すディレクトリが収められているので下のようにすれば何がインストールされているかわかる。

> perl -e "print map{join qq/\t/,map{m|([^/]*)$|}<$_/*>}@INC" | more

これだと表示が1画面に収まらないのでパイプ処理でmoreに渡している。気になるなら下のようにもできる。ただこの場合マッチするもの以外は表示されない。例えば下の例では*.pmと*.plは表示されるが、*.txtは表示されない。

> perl -e "print map{join qq/\t/,map{m|([^/]*\.p[ml])$|}<$_/*>}@INC"
abbrev.pl       AnyDBM_File.pm  assert.pl       attributes.pm   attrs.pm
AutoLoader.pm   AutoSplit.pm    autouse.pm      B.pm    base.pm Benchmark.pm
bigfloat.pl     bigint.pl       bigint.pm       bignum.pm       bigrat.pl
bigrat.pm       blib.pm ByteLoader.pm   bytes.pm        bytes_heavy.pl  cacheout
.pl     Carp.pm CGI.pm  charnames.pm    complete.pl     Config.pm       constant
.pm     CPAN.pm ctime.pl        Cwd.pm  DB.pm   DBM_Filter.pm   dbm_filter_util.
pl      diagnostics.pm  Digest.pm       DirHandle.pm    dotsh.pl        Dumpvalu
e.pm    dumpvar.pl      DynaLoader.pm   Encode.pm       encoding.pm     English.
pm      Env.pm  Errno.pm        exceptions.pl   Exporter.pm     fastcwd.pl
Fatal.pm        Fcntl.pm        fields.pm       FileCache.pm    FileHandle.pm
filetest.pm     find.pl FindBin.pm      finddepth.pl    flush.pl        getcwd.p
l       getopt.pl       getopts.pl      hostname.pl     if.pm   importenv.pl
integer.pm      IO.pm   less.pm lib.pm  locale.pm       look.pl Memoize.pm
newgetopt.pl    NEXT.pm O.pm    Opcode.pm       open.pm open2.pl        open3.pl
        ops.pm  overload.pm     perl5db.pl      PerlIO.pm       POSIX.pm
pwd.pl  re.pm   Safe.pm SDBM_File.pm    SelectSaver.pm  SelfLoader.pm   Shell.pm
        shellwords.pl   sigtrap.pm      Socket.pm       sort.pm stat.pl Storable
.pm     strict.pm       subs.pm Switch.pm       Symbol.pm       syslog.pl
tainted.pl      termcap.pl      Test.pm Thread.pm       threads.pm      timeloca
l.pl    UNIVERSAL.pm    utf8.pm utf8_heavy.pl   validate.pl     vars.pm vmsish.p
m       warnings.pm     Win32.pm        XSLoader.pmDB_File.pm   fix_4_os2.pl
LWP.pm  MD5.pm  OLE.pm  Tk.pm   URI.pm  Win32.pm

フィルタリングに正規表現を使用し、マッチしたものだけを表示させている。ディレクトリ直下に含まれるモジュールしか表示されない。map{}でディレクトリの部分をフィルタリングしている。これはreaddirを使わないで書こうとしたためだ。opendir readdir closedirとすると1行スクリプトと言うには長すぎるからね。

[処理制御] 10秒間処理を停止する

もっとも問題なのはこの手の処理がWindowsに標準でついていないことじゃないかな。昔はプロセスの起動と終了を監視するプログラムを作ったもんだ。まぁそんなに厳密にならなくていい場合はsleep文で済ませてしまえばいい。perlの一行スクリプトでそんなことができるなんていい時代になったもんだ。

> perl -e "sleep(10)"

単独ではほとんど意味ない。でも、Windowsのバッチファイル中で使うと少しいいことあるかもしれない。なぜなら、バッチファイルの処理分岐は別ウィンドウで起動されるプログラムの終了コードを判別しないからだ。つまり、バッチプログラムはMS-DOSプロンプトに処理結果を返すプログラムについては、終了後に先のプログラムの結果を利用することができるが、そうでない場合はただのアプリケーションランチャとしてしか使えない。したがってアプリケーションAが終了するまでに十分な時間を上のように書くことでsleepさせて、その後に別のアプリケーションBを起動することもできる。

思いついた使い方としてはラーメンタイマーなんだな。下のように書いてみた。

> perl -le "for(1..6){sleep(3); print scalar localtime;}print qq/\a/x10;"
Sun Mar 26 01:57:20 2006
Sun Mar 26 01:57:22 2006
Sun Mar 26 01:57:26 2006
Sun Mar 26 01:57:29 2006
Sun Mar 26 01:57:31 2006
Sun Mar 26 01:57:35 2006

100分の1秒までこだわりたいなら次のようにもできる。カップラーメン作るのに100分の1秒までこだわらなくても上の例よりも短くかけてほとんど同じ効果をもたらすのでこちらの方がいいかもしれない。こちらはプログラム的にはあまりよろしくないが、3分待つにはどうでもいいことだ。よろしくないのはprint文に続くtimesをスカラーとして評価する時に無理やり0を足し算することでこれをなしている点。本来ならばscalar timesとするべきかも。でもこの方が短いので文字数制限のあるコマンドプロンプトではそのほうがいいかも。

> perl -le "for(1..6){sleep(3); print 0+times;}print qq/\a/x10;"
3.08
6.1
9.07
12.09
15.11
18.07

あわせ技でこんなのもありかな。timesのスカラー評価に同じ手法を使った。

> perl -le "for(1..6){sleep(3); print join' ',map{scalar localtime $_}(time,times+15*60*60);}print qq/\a/x10;"
Sun Mar 26 02:48:10 2006 Fri Jan  2 00:00:03 1970
Sun Mar 26 02:48:13 2006 Fri Jan  2 00:00:06 1970
Sun Mar 26 02:48:16 2006 Fri Jan  2 00:00:09 1970
Sun Mar 26 02:48:19 2006 Fri Jan  2 00:00:12 1970
Sun Mar 26 02:48:22 2006 Fri Jan  2 00:00:15 1970
Sun Mar 26 02:48:25 2006 Fri Jan  2 00:00:18 1970

上の例だと時間が決まっているばあいはいいけど、時計のようには使えない。時計にするだけなら簡単なのでここでは何秒かに1回新しく表示を切り替える時計を作ってみようと思う。

> perl -le "while(sleep 3){print scalar(localtime).qq/\a/x2;}"
Mon Mar 27 21:50:16 2006
Mon Mar 27 21:50:19 2006
Mon Mar 27 21:50:22 2006
Mon Mar 27 21:50:25 2006
Terminating on signal SIGINT(2)

3秒に1回新しい時刻を出力している。10分に1回で十分なときはsleep 600とすればいい。ついでにビープ音もならしてている。10分に1回づつ何かするけどコンピュータから目を離しておきたい場合なんかにも音で知らせてくれればありがたい。常にディスプレイとにらめっこする必要が無いからうれしい。でもストップウォッチ的に使うには多少問題外があるとおもう。精度も悪いし、操作性もよくない。

何行にも表示されてうっとうしい場合はフラッシュ($|=1)とキャリッジリターンの出力(\x0d)で解決。\rとかを使うとプラットフォームごとに異なるスクリプトにしないと使えなくなるかも。

$ perl -e '$|=1; while(sleep(1)){print scalar(localtime)."\x0d"}';

[時刻表示] シンプルな時刻表示によるラーメンタイマー

30秒ごとに時刻表示しているんだな。下のラーメンタイマーよりもずっとシンプルでわかりやすいと思うんだな。キモはlocaltimeをスカラ変数で評価すること。わざわざ関数を作らなくてもいいのでこの技は一行スクリプト以外でも使える。できるまでの間コンソールから目を離せないというのは不便なので、最後にビープ音を鳴らしているんだな。print文で\aを出力するとビープ音がなるんだな。

>　perl -le "for(-6..0){print scalar localtime; $_ ? '' : last; sleep 30;} print qq/\a/x3;"
Mon Mar 27 22:55:00 2006
Mon Mar 27 22:55:30 2006
Mon Mar 27 22:56:00 2006
Mon Mar 27 22:56:30 2006
Mon Mar 27 22:57:00 2006
Mon Mar 27 22:57:30 2006
Mon Mar 27 22:58:00 2006

でもラーメン食べようと思って、コンソールに向かって上を入力し始めたら回りは引くだろうな。ラーメンタイマーだけならこれで十分なんだけどさ。

> perl -e "sleep 180; print qq/\a/x3;"

[時刻表示] 今何時?

とりあえず今何時か知りたいとき下のようにするんだな。localtimeを素で理解できる人はすごいと思うけど、多分そんな人はいないだろうな。でもlocaltimeをスカラー変数で評価すれば、僕にもわかる文字列で結果を返してくれるんだな。例えば下のように。

>perl -e "print scalar localtime;"
Tue Feb 14 23:36:13 2006

Windowsは上手いこと現在時刻を表示する方法がなかったからこれは結構重宝すると思うんだな。とにかく重要なことはscalar(localtime($_))として、$_に適当な自然数を代入することなんだな。上の場合はlocaltimeの引数としてtimeが与えられているんだな。だから、下のようにもできるんだな。

>perl -e "print scalar localtime 0;"
Thu Jan  1 09:00:00 1970

localtimeの引数はこの時刻からの経過秒を示すんだな。

[文字列出力] 変数を含む複数行文字列を標準出力に出力する普遍的な方法

つまりどうすればunixのechoコマンドがエミュレートできるかと言うことである。シングルコーテーションもダブルコーテーションもperlが括られた内容を文字列ですよと言って解釈するためのタグ付けのようなものに過ぎない。またPerlはややこしくなるのを防ぐためにシングルコーテーションとダブルコーテーションの代替手段を備えている。それは"STRING"の代わりにqq/STRING/、'STRING'の代わりにq/STRING/とすることだ。これに対してcommandプロンプトはダブルコーテーションを読み替えられるほど柔軟にできてはいない。だから下の2つは全く同じ結果を返す。

> perl -e "print 'Hello World!!';"
Hello World!!
> perl -e "print q/Hello World!!/;"
Hello World!!

これだけだと実行後の改行も入らないし普遍的とはいえない。では改行や変数の内容を含めるにはどうするか。perlスクリプトを外部ファイルから呼び出す場合には、改行はprint "\n"、変数の内容はpeint "$Hello"、とする。したがって、先の変換則に従えば下のようにかける。

> perl -e "$Hello='Hello'; print qq/$Hello\nWorld!!\n/;"
Hello
World!!

普遍的と銘打つにはもう一声必要だ、それはqq//やq//で囲まれる文字列の中に/が含まれてしまう場合だ。例えば下のような場合、期待した結果を返さない。なぜならperl君はいったいどこまでがprint文の引数なのかわからなくなってしまうからだ。ちなみにsyntax errorとは何かと言うことについても講釈せねばなるまい。一般にコンパイラってのは字句解析、構文解析と処理を進めていく(覚え方は"自分が1番"でしたっけ?)けど、このときの最初のステップはクリアしたけど2番目の構文解析で躓いたために、以降の作業が行えませんでしたと言うことである(日本人の書く英字論文は査読の段階でsyntax errorが多発するらしい、単語は書いてあるけど構文の使い方がおかしいからなに言ってんだかわかんない状況。)。つまり、print文の引数指定の方法(引数の使い方)がおかしいと言うことである。少なくとも僕はそう思っている。

> perl -e "print q/http://www.google.com/;"
syntax error at -e line 1, near "/;"
Execution of -e aborted due to compilation errors.

これはperl一般にいえることだが、/で囲むようにされている場合/が区切り文字(デリミタ)として使用されている。だから囲まれた内容に区切り文字を含めてはいけない。そんな場合は区切り文字自体を変えてしまえばいいたとえば下のようにかけば期待した結果が得られる。

> perl -e !print q!http://www.google.com!;"
http://www.google.com/

だからと言って下のようにはかけない。理由は先に述べた通り区切り文字!が囲まれた文字列Hello World!!の中に含まれてしまうからだ。

> perl -e "print q!Hello World!!!;"
syntax error at -e line 1, near "q!Hello World!!"
Execution of -e aborted due to compilation errors.

上に述べたようにこれを解決するには区切り文字を変更してしまえばいい。つまり下のような感じにすると言うことだ。区切り文字に使える文字は様々なので内容に適した物を選べばいい。

> perl -e "print q#Hello World!!#;"
Hello World!!

これらの心はただ一つ。-eオプションの後に続く引数はダブルコーテーションで囲み、ダブルコーテーションで囲まれた文字列ではダブルコーテーションもシングルコーテーションも使わずにqq//やq//で置き換える、内容に区切り文字/が含まれる場合は区切り文字字体を変更する、ということである。

[文字列出力] 最も基本的な方法

最もベーシックなやり方なんだな。これをコンパイラは下のように理解しているんだな。

print 'ww';

したがって、変数展開やメタ文字解釈は行われないんだな。例えば、変数やメタ文字を含めても下のようになってしまうんだな。

> perl -e "$xx = yy; print 'ww$xx\n';"
ww$xx\n
>

コンパイラからすれば、下のような文を処理しているわけだから、当然といえば当然なんだな。

print 'ww$xx\n';

[perl] なぜだかわからん

> perl -e "$|=1;while(1){$i++;if($t!=times){print qq#$i\t$t\t#;$i=0;$t=times;}}"
1               78      0.16    478     0.22    591     0.27    579     0.33
369     0.38    790     0.44    426     0.49    308     0.55    284     0.6
658     0.66    283     0.71    500     0.77    519     0.82    812     0.88
259     0.93    470     0.99    590     1.04    720     1.1     562     1.15
591     1.21    638     1.26    797     1.32    798     1.37    287     1.43
812     1.48    412     1.54    432     1.59    691     1.65    536     1.7
442     1.76    695     1.81    604     1.87    645     1.92    517     1.98
590     2.03    370     2.09    754     2.14    600     2.2     252     2.25
728     2.3     602     2.36    467     2.41    641     2.47    589     2.52
335     2.58    251     2.63    733     2.69    691     2.74    784     2.8
404     2.85    329     2.91    599     2.96    198     3.02    554     3.07
499     3.13    141     3.18    378     3.24    823     3.29    294     3.35
201     3.4     650     3.46    698     3.51    341     3.57    674     3.62
285     3.68    656     3.73    721     3.79    594     3.84    534     3.9
769     3.95    531     4.01    455     4.06    780     4.12    796     4.17
293     4.23    411     4.28    822     4.34    496     4.39    788     4.45
825     4.5     136     4.56    609     4.61    551     4.67    492     4.72
518     4.78    417     4.83    754     4.89    495     4.94    346     5
518     5.05    502     5.11    601     5.16    419     5.22    739     5.27
526     5.33    703     5.38    566     5.44    ^C
634     5.49    Terminating on signal SIGINT(2)
>

[perl] 丸め込み誤差、コーシー判定で発散することが自明の数列も計算精度で収束する

もちろんコーシー判定の結果が正しいのである。しかし、16桁の精度しか出ないので収束してしまう。例えば、一般項が1/iの数列(a_i=1/i)の無限級数はコーシー判定より正の無限大に発散する。ただし、第n部分和をコンピュータで単純にn回足し算を行って求めるとおかしなことが起こる。次の状態を考える。i=10^{16}=>a_i=10^{-16}このとき第n部分和の正確な値はわからない、しかし、少なくとも1以上の値である。なぜなら、数列の初項が1であり、各項は正の値のみを取るから。第10^{16}-1部分和で取られるであろう最大の精度はコンピュータの計算精度と同じ16桁、言い換えれば、小数点以下15桁目までが出力される。これに第10^{16}項目が足されるわけだが、第10^{16}項目は小数点以下16桁目に始めて0で無い数字が現れる。したがって、足し算しても第10^{16}部分和に影響を及ぼさない。したがって第10^{16}部分和と第10^{16}-1部分和は等しいとして出力される。ゆえに、第10^{16}-1部分和以降の部分和はいつまでたっても第10^{16}-1部分和と同じ値となる。したがってコンピューターで第n部分和を計算させるとその値は収束してしまう。

  | 1/3                   => 0.333333333333333
+ | 1/10^{16}             => 0.0000000000000001
  +---------------------------------------------
    (3+10^{16})/3*10^{16} => 0.333333333333333

> perl -wle "while(1){$S+=(++$i)**-1; print join qq#\t#,($i,$S,log($i),(times)[0]) if $i%10**6==0;}"
1000000 14.392726722865 13.8155105579643        6.15
2000000 15.085873653425 14.5086577385242        15.71
3000000 15.4913386781999        14.9141228466324        22.03
4000000 15.7790207089847        15.2018049190842        29.99
5000000 16.0021642352986        15.4249484703984        38.61
6000000 16.1844857754261        15.6072700271923        47.13
7000000 16.3386364433484        15.7614207070196        57.12
8000000 16.4721678270444        15.8949520996441        68.71
9000000 16.5899508557555        16.0127351353005        75.36
10000000        16.6953113658573        16.1180956509583        85.74
11000000        16.7906215411161        16.2134058307626        93.43
12000000        16.8776329143183        16.3004172077523        103.64
13000000        16.9576756187865        16.3804599154258        111.61
14000000        17.0317835881946        16.4545678875795        119.02
15000000        17.1007764573005        16.5235607590665        127.15
16000000        17.1653149763541        16.5880992802041        139.46
17000000        17.2259395963306        16.6487239020205        147.09
18000000        17.2830980085365        16.7058823158604        152.8
19000000        17.3371652283451        16.7599495371307        161.87
20000000        17.3884585214171        16.8112428315183        167.8
Terminating on signal SIGINT(2)
>

[perl] ダイヤモンド演算子でdirの代替

> perl -we "print map{$_.\"\t\".scalar(localtime((stat)[9])).\"\n\"}('.','..',<./*>)"
.       Wed Aug 16 17:05:44 2000
..      Wed Aug 16 16:35:38 2000
./a.bat      Sat Feb 18 19:30:08 2006
./a.pl       Tue Feb 14 02:35:22 2006
./a.txt      Sat Feb 18 19:35:58 2006
./b.txt      Sat Feb 25 00:18:58 2006
>

何でもかんでもmap{}を使えばよいと言うものでもない。map{}を使うよりも美しい場合もあると思う。下のほうが美しいSolutionだとは思いませんか。

> perl -wle "foreach('.','..',<./*>){print qq/$_\t/.scalar(localtime((stat)[9]))}"

[perl] ストップウォッチ

ラップタイムはPause/Break、再度時間を進める場合はEnter、停止はCtrl+C

> perl -le "while(1){print scalar times;}"

[perl] 現在時刻の表示

windowではdateコマンドがないので、単純に現在時刻表示して、終了。これができない windows はストレス。

> perl -we "print scalar(localtime);"
Fri Feb 17 21:20:46 2006
C:\>

[perl] 現在時刻を1秒単位で表示

現在時刻を表示する方法がわかったら、これを1秒単位にしてみる。行を削除できればデジタル時計になるんだけど、それは無理でしょ、一回printバッファから出た情報をどうやって書き換えればいいの。

> perl -wle "for(1..10){print scalar(localtime); sleep 1;}"
Fri Feb 17 22:25:51 2006
Fri Feb 17 22:25:52 2006
Fri Feb 17 22:25:53 2006
Fri Feb 17 22:25:54 2006
Fri Feb 17 22:25:55 2006
Fri Feb 17 22:25:56 2006
Fri Feb 17 22:25:57 2006
Fri Feb 17 22:25:58 2006
Fri Feb 17 22:25:59 2006
Fri Feb 17 22:26:00 2006
>

[スカラー評価]デジタル時計

> perl -wle "while(1){system cls; print scalar(localtime); sleep 1;}"
Fri Feb 17 22:31:25 2006
Terminating on signal SIGINT(2)
>

[条件判定]if文の代替

3番目の例について言えば、条件判定にif文を使うのは遅くなる原因だそうな。この場合、\$aがゼロか、\$bがゼロか、\$cがゼロか、という判定をif文で書くのではなく、演算子を使って記述した方が早いということ。変数を||でつないだ場合は左から評価を始めて最初に現れた0でない数字を返す。変数を&&でつないだ場合は左から評価を始めて最初に現れた0を返す。

> perl -wle "print 0||3||1; print 3||1||0; print 1||3||0;"
3
3
1
> perl -wle "(\$a,\$b,\$c)=(0,3,1); \$d=\$a||\$b||\$c; print \$d;"
3
> perl -wle "\@a=map{int rand 3}(0..20); print \@a; print eval(join'||',\@a);"
222112121101120001212
2
> perl -wle "\@a=map{int rand 3}(0..20); print \@a; print eval(join'&&',\@a);"
210100122012201210021
0
>

単体ではほとんど意味をなさないが、このような条件判定は初期値の設定に使える。例えば、引数にディレクトリを取り、そのディレクトリの内容を表示するプログラムを考えてみる。内容を表示したいディレクトリ$dirに下のように代入させることができる。

$dir = $ARGV[0] || './';

ただし、この場合は$ARGV[0]の内容が0や空文字列だった場合には上手くいかない。言い換えれば、0というディレクトリの内容を表示することはできないということだ。もちろん引数に'./0'と指定すれば問題はないが、それではユーザビリティに欠けるというものだ。そんな場合は下のようにするとよいだろう。言い換えれば、引数が指定されていてなおかつ引数の内容が空文字列でない場合、引数をそのまま$dirへ代入、これ以外の場合は、カレントディレクトリを$dirに代入する、ということだ。こうすれば引数に0を指定されたり、コマンドの後に無駄な空白をつけたおかげで引数が定義されてはいるものの意味のない引数(空文字列)だった場合にもまともな結果を返すことができる。

$dir = (defined $ARGV[0] && $ARGV[0] ne '') ? $ARGV[0] : './';

[perl] Linux 上の Perl で書いた 1 行スクリプト

ここまでは Activeperl を対象に 1 行スクリプトを書いてきたが、これからは Linux で動く Perl もしくは Cygwin 上で動く Perl で 1 行スクリプトを書こうと思う。

[linux] 総和の方向で結果が異なるのは仕方ない。

その理由はやはり丸め込み誤差だろうな誤差を小さくするためにはどうすればいいのだろう。

$ perl -wle 'for($i=1;$i<=10**8;$i++){$S+=$i**-1;} print join qq#\t#,($i,$S,(times)[0]);'
100000001       18.9978964138477        103.31
$ perl -wle 'for($i=10**8;$i>=1;$i--){$S+=$i**-1;} print join qq#\t#,($i,$S,(times)[0]);'
0       18.9978964138532        157.2
$

判定と 2 重 for でどっちが早いのか

これは宿題

たとえば、for ブロックの中で、10 回に 1 回出力したいとき、ブロックの最後に if( $i % 10 == 0){print;} とかすると思う。これはよく紹介されている手法だが、スピード的にはどうかと思った。だって、100 回ループさせたら、100 回チェックが行われるわけで、そのうちの 90 回は出力されない。もしループ回数が多くなって、より出力の回数が減ったら、さらに無駄な判断を繰り替えすことになる。もったいなくないか。

$  perl -wle 'for($i=1;$i<=10**7;$i++){$S+=$i**-1; if($i%10**6==0){ print join qq#\t#,($i,$S,(times)[0]);} }'
1000000 14.3927267228648        1.25
2000000 15.0858736534248        2.49
3000000 15.4913386781997        3.73
4000000 15.7790207089843        4.98
5000000 16.0021642352982        6.22
6000000 16.1844857754256        7.47
7000000 16.338636443348 8.71
8000000 16.4721678270439        9.96
9000000 16.5899508557549        11.2
10000000        16.6953113658567        12.46
$ perl -wle 'for($j=0;$j<10;$j++){ $s=1+$j*10**6; $e=($j+1)*10**6; for($i=$s;$i<=$e;$i++){$S+=$i**-1;} print join qq#\t#,($i,$S,(times)[0]);}'
1000001 14.3927267228648        0.96
2000001 15.0858736534248        1.92
3000001 15.4913386781997        2.88
4000001 15.7790207089843        3.84
5000001 16.0021642352982        4.81
6000001 16.1844857754256        5.77
7000001 16.338636443348 6.73
8000001 16.4721678270439        7.68
9000001 16.5899508557549        8.64
10000001        16.6953113658567        9.6

$ cat test.pl
#!/usr/bin/perl
$a = 100;
$b = 10**6;
$ab= $a*$b;
for($k=0;$k<1000;$k++){
        $c = (times)[0];
        for($i=0; $i<$a; $i++){
                print ((times)[0]-$c);
                print "\t";
                for($j=0; $j<$b; $j++){
                        #$a_j = $i * $b + $j;
                        $a_j++;
                        #print "$a_j ";
                }
        }
        $c = (times)[0];
        for($i=0; $i<$ab; $i++){
                if(0==$i % $b){
                        print ((times)[0]-$c);
                        print "\t";
                }
        }
        print "\n";
}
$ nohup nice perl test.pl > test.dat &
$ cat test.plt
#!/usr/bin/gnuplot
!perl -alne 'map{$S[$_]+=@F[$_]}(0..$#F);$i++; END{print join"\n",map{$_/$i}@S;}' test.dat > test2.dat
set xlabel "output setp [times]";
set ylabel "CPU time [sec]";
set grid
set terminal svg
set output "test.svg"
set key left top
plot    "<perl -ne 'print if 1 .. 100' test2.dat" title "if()",\
        "<perl -ne 'print if 101 .. 200' test2.dat" title "double for()"

改行コードの変換 (nkf の代替)

nkf は改行コードと文字コードの変換によく使う。unix、mac、windows それぞれのシステムにおける改行コードは決まっているので、それらにおける改行コードが具体的に何か知らなくても下のような感じで使えば、改行コードの変換が出来る。

$ nkf --unix hoge.c > tmp.c
$ nkf --mac hoge.c > tmp.c
$ nkf --windows hoge.c > tmp.c

このようにすることで、改行コードを unix や mac や windows のものにして hoge.c の内容を tmp.c にリダイレクトできる。これを perl で代替するには (それぞれのシステムの改行コードを具体的に知らなければならないが) 下のようになる。

$ perl -pe 's/\x0D\x0A|\x0D|\x0A/\x0A/g;' hoge.c > tmp.c
$ perl -pe 's/\x0D\x0A|\x0D|\x0A/\x0D/g;' hoge.c > tmp.c
$ perl -pe 's/\x0D\x0A|\x0D|\x0A/\x0D\x0A/g;' hoge.c > tmp.c

もらったファイルの改行コードで悩むことって、*nix 使っている限りあまりないのだけれど、自分のシステムの改行コードに合わせるには下のようにする。置換の変換先を \n つまりシステム標準の改行コードにするということだ。

$ perl -pe 's/\x0D\x0A|\x0D|\x0A/\n/g;' hoge.c > tmp.c

cpan にモジュールとかありそうなものだけど、まぁ手書きでも出来ないこともない。重要なのは置換元の並び順は先頭から評価されるため、置換前の改行コードの並び順が \x0D\x0A|\x0D|\x0A の順番でないとうまく動作しないということ。-p で print; 付きの各行読み込み。s// で置換、Win か Mac か Unix の改行コードを Unix の改行コードに。読み込みは hoge.c、標準出力をリダイレクトして tmp.c に。リダイレクト先と入力を別にしておくことに注意。リダイレクト先を hoge.c にしてしまうと hoge.c の内容がクリアされてしまう。

次のような 3 つの入力を置換することを考える。

in:
This is a pen.\x0D\x0A
This is a pen.\x0D
This is a pen.\x0A

このとき、それぞれの変換は次のように進んでいると思われる。変換の評価ポイントが一文づつずれていく。評価ポイント上の文字が変換前の文字列とマッチするか評価する。変換前の文字列のプライオリティは \x0D\x0A が最高なので、評価ポイント上の文字 + 次の 1 文字でまず評価され、この文字列が \x0D\x0A でない場合、評価ポイント上の文字を評価する。

This is a pen.\x0D\x0A の場合
|------------*####
This is a pen.\x0D\x0A  -->  This is a pen.\x0D\x0A
|------------*
This is a pen.\x0D\x0A  -->  This is a pen.\x0D\x0A
|-------------****####
This is a pen.\x0D\x0A  -->  This is a pen.\x0A
|-----------------*#
This is a pen.\x0A      -->  This is a pen.\x0A
This is a pen.\x0D の場合
|------------*####
This is a pen.\x0D      -->  This is a pen.\x0D
|------------*
This is a pen.\x0D      -->  This is a pen.\x0D
|-------------****#
This is a pen.\x0D      -->  This is a pen.\x0D
|-------------****
This is a pen.\x0D      -->  This is a pen.\x0A
|-----------------*#
This is a pen.\x0A      -->  This is a pen.\x0A
This is a pen.\x0A の場合
|------------*####
This is a pen.\x0A      -->  This is a pen.\x0A
|------------*
This is a pen.\x0A      -->  This is a pen.\x0A
|-------------****#
This is a pen.\x0A      -->  This is a pen.\x0A
|-------------****
This is a pen.\x0A      -->  This is a pen.\x0A
|-----------------*#
This is a pen.\x0A      -->  This is a pen.\x0A

こんな感じだ。最初の評価が 2 文字ということがポイントだと思う。\x0D の 1 文字の評価のプライオリティが最高だと、\x0D\x0A がまず \x0A\x0A に変換されてしまい、このときの変換ポイントが次の評価で次に進み、期待通りの結果が得られない。

s/\x0D|\x0D\x0A|\x0A/\x0A/g; の場合
out:
This is a pen.\x0A\x0A
This is a pen.\x0A
This is a pen.\x0A

今回のネタは、nkf が導入されていないシステムで改行コードを変更しようとしたことが発端である。そもそも nkf は日本生まれなので、今回作業に躓いたサーバでは管理者が日本人でなかったためか nkf が導入されていなかった。でも、海外の人はどうやって改行コードの変換を行っているのだろう、ところ変われば品変わるのかな。

自分しか編集しないファイルの場合は改行コードを気にすることはほとんどないが、だれかとやり取りする場合は結構気にする。全然改行のないテキストをメモ帳で見て、ああこの人はどうやってテキストを編集しているのだろうかと本気で悩んだことがあった。Web を作ったときにアップロードの前後でファイルサイズが異なっていることがかなり気になったことがあった。そんなこともあったということで。

文字コードの変更

結論的には nkf 入れるのがもっとも素直でよいと思う。しかし nkf が無いような場合、iconv で文字コードを変換するのだけれど、iconv には nkf -guess のような文字コード判定をしてくれるような機能が付いてはいない。そのため、たくさんの文書を一気に変更する場合だと使いにくい。nkf 無でも perl 位はあるだろう、ということで perl の 1 行スクリプトを書いてみた。まずは適当に作ったファイル hoge.txt を euc-jp に変換してみる。

$ perl -MEncode -MEncode::Guess -pe '$_=encode("euc-jp",decode("Guess",$_));' hoge.txt > hoge_euc-jp.txt
$ nkf -guess hoge_euc-jp.txt
EUC-JP

たしかに euc-jp に変換されているが、この 1 行スクリプトは入力ファイルが euc-jp の場合にはうまく変換されない。

$ nkf -guess hoge.txt
UTF-8
$ perl -MEncode -MEncode::Guess -pe '$_=encode("utf8",decode("Guess",$_));' hoge_euc-jp.txt > hoge_euc-jp_utf8.txt
No appropriate encodings found! at /usr/local/lib/perl/5.8.8/Encode.pm line 170

その理由は Encode:Guess が "By default, it checks only ascii, utf8 and UTF-16/32 with BOM." というルールになっているからだ。つまり、入力ファイルの文字コードが euc-jp の場合を想定して "Guess" が行われないため、文字コード判定に失敗してしまうわけだ。これを回避するためには Encode::Guess の set_suspect メソッドで入力ファイルの文字コードとして可能性のあるものを挙げておく。

$ perl -MEncode -MEncode::Guess -pe 'BEGIN{Encode::Guess->set_suspects(qw/euc-jp/);} $_=encode("utf8",decode("Guess",$_));' hoge_euc-jp.txt > hoge_euc-jp_utf8.txt
$ nkf -guess hoge_euc-jp_utf8.txt
UTF-8

これで適切な変換が行われた。当然ながらこのままでは shiftjis とか iso-2022-jp とかの場合にはやはりエラーが出る。入力ファイルとして日本語という足かせを付けて置くならば、可能性のある文字コードは euc-jp shiftjis 7bit-jis iso-2022-jp 位を考えれば十分だろう。set_suspect メソッドの引数にこれらの配列を渡せば「入力ファイルが日本語で書かれた文書」の文字コードの変更を自動的に行う 1 行スクリプトとなるはずだが、そうは問屋がおろさない。

$ perl -MEncode -MEncode::Guess -pe 'BEGIN{Encode::Guess->set_suspects(qw/euc-jp shiftjis 7bit-jis iso-2022-jp/);}  $_=encode("utf8",decode("Guess",$_));' hoge_euc-jp.txt > hoge_euc-jp_utf8.txt

例えば下のようなスクリプトを使って、文字コードの相互変換テストしてみるとやはりエラーが出る。

$ cat hoge.txt
日本語入力のテスト
$ cat enctest.sh
for to in utf8 euc-jp shiftjis 7bit-jis iso-2022-jp
do
        e="\$_=encode('${to}',decode(\"Guess\",\$_));"
        #e="print '${to}';"
        #perl -le "$e"
        perl -MEncode -MEncode::Guess -pe "$e" hoge.txt > hoge_${to}.txt
        echo -n "hoge_${to}.txt: "
        nkf -guess hoge_${to}.txt
done
for from in utf8 euc-jp shiftjis 7bit-jis iso-2022-jp
do
        echo -n "hoge_${from}.txt: "
        nkf -guess hoge_${from}.txt
        for to in utf8 euc-jp shiftjis 7bit-jis iso-2022-jp
        do
                #e="'\$_=encode(\"${to}\",decode(\"Guess\",\$_));'"
                e="BEGIN{Encode::Guess->set_suspects(qw/euc-jp shiftjis 7bit-jis iso-2022-jp/);} \$_=encode('${to}',decode(\"Guess\",\$_));"
                #perl -MEncode -MEncode::Guess -pe $e hoge_${from}.txt > hoge_${from}_${to}.txt
                perl -MEncode -MEncode::Guess -pe "$e" hoge_${from}.txt > hoge_${from}_${to}.txt
                echo -n "hoge_${from}_${to}.txt: "
                #echo $e
                nkf -guess hoge_${from}_${to}.txt
        done
done
exit
$ sh ./enctest.sh
hoge_utf8.txt: UTF-8
hoge_euc-jp.txt: EUC-JP
hoge_shiftjis.txt: Shift_JIS
hoge_7bit-jis.txt: ISO-2022-JP
hoge_iso-2022-jp.txt: ISO-2022-JP
hoge_utf8.txt: UTF-8
hoge_utf8_utf8.txt: UTF-8
hoge_utf8_euc-jp.txt: EUC-JP
hoge_utf8_shiftjis.txt: Shift_JIS
hoge_utf8_7bit-jis.txt: ISO-2022-JP
hoge_utf8_iso-2022-jp.txt: ISO-2022-JP
hoge_euc-jp.txt: EUC-JP
hoge_euc-jp_utf8.txt: UTF-8
hoge_euc-jp_euc-jp.txt: EUC-JP
hoge_euc-jp_shiftjis.txt: Shift_JIS
hoge_euc-jp_7bit-jis.txt: ISO-2022-JP
hoge_euc-jp_iso-2022-jp.txt: ISO-2022-JP
hoge_shiftjis.txt: Shift_JIS
hoge_shiftjis_utf8.txt: UTF-8
hoge_shiftjis_euc-jp.txt: EUC-JP
hoge_shiftjis_shiftjis.txt: Shift_JIS
hoge_shiftjis_7bit-jis.txt: ISO-2022-JP
hoge_shiftjis_iso-2022-jp.txt: ISO-2022-JP
hoge_7bit-jis.txt: ISO-2022-JP
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_utf8.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_euc-jp.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_shiftjis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_7bit-jis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_iso-2022-jp.txt: ASCII
hoge_iso-2022-jp.txt: ISO-2022-JP
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_utf8.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_euc-jp.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_shiftjis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_7bit-jis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_iso-2022-jp.txt: ASCII

つまり、入力ファイルを見ただけでは 7bit-jis か iso-2022-jp なのかわからんといわれているわけだ。これはそんなに不思議なことではない。というのも、hoge.txt には半角カタカナは含まれないため、それを変換した hoge_7bit-jis.txt にも hoge_iso-2022-jp.txt にも含まれない、従って「JIS X 0201 片仮名」で半角カタカナに割り当てられるようなビット列が含まれない。また、7bit-jis の「JIS X 0201 片仮名」(いわゆる半角カタカナ) を iso-2202-jp では定義していない。そのため、これらのいわゆる半角カタカナの含まれないファイルの文字コードを guess しても 7bit-jis と iso-2022-jp の区別が付かないのである。

では、半角カタカナの含まれる utf8 のファイルを先のスクリプトを通して iso-2022-jp に変換するとどうなるのか。この結果は半角カタカナが全角カタカナに変換される。また、7bit-jis に変換するとどうなるか。この結果は半角カタカナの部分がおかしなことになってしまった。うーんよくわからんな。テストしてみたコードは下のような感じ。

$ cat hoge.txt
日本語入力のテスト
ﾆﾎﾝｺﾞﾆｭｳﾘｮｸﾉﾃｽﾄ
$ sh enc.sh
hoge_utf8.txt: UTF-8
hoge_euc-jp.txt: EUC-JP
hoge_shiftjis.txt: Shift_JIS
hoge_7bit-jis.txt: ISO-2022-JP
hoge_iso-2022-jp.txt: ISO-2022-JP
hoge_utf8.txt: UTF-8
hoge_utf8_utf8.txt: UTF-8
hoge_utf8_euc-jp.txt: EUC-JP
hoge_utf8_shiftjis.txt: Shift_JIS
hoge_utf8_7bit-jis.txt: ISO-2022-JP
hoge_utf8_iso-2022-jp.txt: ISO-2022-JP
hoge_euc-jp.txt: EUC-JP
shiftjis or euc-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_euc-jp_utf8.txt: UTF-8
shiftjis or euc-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_euc-jp_euc-jp.txt: EUC-JP
shiftjis or euc-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_euc-jp_shiftjis.txt: Shift_JIS
shiftjis or euc-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_euc-jp_7bit-jis.txt: ISO-2022-JP
shiftjis or euc-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_euc-jp_iso-2022-jp.txt: ISO-2022-JP
hoge_shiftjis.txt: Shift_JIS
hoge_shiftjis_utf8.txt: UTF-8
hoge_shiftjis_euc-jp.txt: EUC-JP
hoge_shiftjis_shiftjis.txt: Shift_JIS
hoge_shiftjis_7bit-jis.txt: ISO-2022-JP
hoge_shiftjis_iso-2022-jp.txt: ISO-2022-JP
hoge_7bit-jis.txt: ISO-2022-JP
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_utf8.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_euc-jp.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_shiftjis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_7bit-jis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_7bit-jis_iso-2022-jp.txt: ASCII
hoge_iso-2022-jp.txt: ISO-2022-JP
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_utf8.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_euc-jp.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_shiftjis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_7bit-jis.txt: ASCII
7bit-jis or iso-2022-jp at /usr/local/lib/perl/5.8.8/Encode.pm line 170
hoge_iso-2022-jp_iso-2022-jp.txt: ASCII

とりあえず今日はここまで。なんだかよくわからないことになってしまった。とりあえず guess 機能のチェックからはじめよう。

Hello world と表示させる

さて、最も単純に考えると下のようになる。

$ perl -e 'print "Hello World!!\n";'

もう少し短くしたければ -l オプションで print 文と fprint 文の最後に \n を自動的に付加させる。下の 2 つは同じことである。

$ perl -le 'print "Hello World!!";'
$ perl -e '$\="\n"; print "Hello World!!";'

シェルの違いシステムの違いでスクリプトが動かなくなることがたまにある。これを解決するために文字列リテラル中の半角スペースの代わりに \x20 を使う。\x20 は ASCII コードにおける半角スペース (SP) を 16 進数であらわした (20) もの。

$ perl -le 'print "Hello\x20World!!";'

今回のネタはシステムの違いをいかに吸収して 1 行スクリプトを書くかについて考えているときに思い浮かんだ。

[rename] ファイルの名前を一括変換

いや、あえて Perl をつかって表現する必要はどこにもないのだけれど、そんなことも可能だよということで。おそらくこのシリーズはネタ切れのタイミングで続くな。まずは普通にやってみる。mv コマンドのほうが短いし、はっきり言ってメリットは無い。

$ mv hoge.txt hage.txt
$ perl -le 'print rename("hoge.txt", "hage.txt");'

このままだと面白くない、File::Rename モジュールを使おう。無い場合は CPAN から導入してくれと管理者にでも頼んでくだされ。まずは上と同じことをモジュールを使ってやってみる。

$ perl -MFile::Rename -le 'print File::Rename::rename("hoge.txt", "hage.txt");'

File::Rename モジュールはただの use 文では組み込み関数 CORE::rename をオーバーライドしてくれないので、File::Rename モジュールの rename 関数を呼ぶ場合には枕詞をつけて明示的に rename 関数を呼ばなければならない。もし、下のように書いた場合は CORE::rename を使っていることになる。

$ perl -MFile::Rename -le 'print rename("hoge.txt", "hage.txt");'

rename 組み込み関数を qw() でオーバーライドしてみる。オーバーライドは何回も renme 関数を呼ぶ場合には効果的だが、今回のように 1 回だけ呼ぶ場合にはメリットがあまり無い。

$ perl -le 'use File::Rename qw(rename); print rename("hoge.txt", "hage.txt");'

File::Rename::rename には一括変換の機能もあるので、もう少しブリコってみよう。例えば、カレントディレクトリの中に 100 個の .jpg がありこれらを .jpeg に変える場合、mv コマンドを 100 回たたく代わりに 1 行スクリプトで 1 回で終わらせる。

perl -e 'use File::Rename qw(rename); @F=<*>; rename(@F,sub{s/\.jpg$/.jpeg/},1);'

これでカレントディレクトリ中の .jpg でファイルネームが終わるファイル全てを .jpeg で終わるようにリネームできる。<*> はカレントディレクトリのファイル全て、rename 関数に与える引数を絞るにはここで grep{} するほうがいいと思う。@F は適当な名前の一時的配列だが、rename 関数の中の @F を <*> に変えるをエラーがでるので注意。rename 関数の第 3 引数は詳細な出力をさせるオプショナルなフラグ、1 だと詳細出力それ以外は出力なし。

[unlink] ファイルを一括削除

ファイルを選んで消そう、削除しようと思う。

$ rm hoge.txt
$ perl -le 'print unlink("hoge.txt");'

これで OK。前使ったダイヤモンド演算子を使ってワイルドカード指定してみる。

$ rm *.txt
$ perl -le 'print unlink(<*.txt>);'

やはり、シェル本来の機能を使ったほうがいい。もう少しトリッキーな例を挙げてみよう。

$ find . -regex '^[A-Z][0-9]{4}.*\.txt$' -print0 | xarg -0 rm
$ perl -le '@F=grep{m/^[A-Z][0-9]{4}.*\.txt$/}<*>; print unlink(@F);'

これでカレントディレクトリのファイルの内、1 文字目がアルファベットの大文字でその後ろの 4 文字が数字で最後が .txt でおわるファイルを削除する。これはシェルでは面倒だろうとおもったが、find であっさり解決。更新日時とかファイルタイプとかで篩い分けしてもシェルに軍配があるような気がする。

シンボリックリンク

まぁ Perl をつかって貼ることもないんだけれど。perl でも出来るよということで。

$ perl -e 'symlink("hoge","hage")'

n 進数

ここまでくるとほとんど 1 行で書くメリットなどほとんどないように思われる。でも、自分の思考をすぐに書け、これを確かめられるのはとてもよいことだとと思う。その点において、あえてファイルにしなくてもシェルでかき始められる 1 行スクリプトは結構役に立つと思う。まぁ能書きはおいといて 10 進数から 20 進数へ変換してみた。

$ perl -le 'print join(" ",&sin(130344445,20)); sub sin{my $s=shift @_; my $p=shift @_; my $i=0; do{push(@a, $s%$p); $s=int($s/$p); $i++;}while($s!=0); return reverse @a;}'
2 0 14 13 1 2 5

|      i              =      a_0 * n ^ 0     +     a_1 * n ^ 1     +     a_2 * n ^ 2     + ...
|     (i) / n ^ 0     =     (a_0 * n ^ 0     +     a_1 * n ^ 1     +     a_2 * n ^ 2     + ...) / n ^ 0
|     (i) / n ^ 0     =      a_0 * n ^ 0     +     a_1 * n ^ 1     +     a_2 * n ^ 2     + ...
| mod((i) / n ^ 0, n) =  mod(a_0 * n ^ 0     +     a_1 * n ^ 1     +     a_2 * n ^ 2     + ..., n)
| mod((i) / n ^ 0, n) =  mod(a_0 * n ^ 0, n) + mod(a_1 * n ^ 1, n) + mod(a_2 * n ^ 2, n) + ...
| mod((i) / n ^ 0, n) =      a_0             +     0               +     0               + ...
| mod((i) / n ^ 0, n) =      a_0
|      i - a_0 * n ^ 0              =     a_1 * n ^ 1     +     a_2 * n ^ 2     + ...
|     (i - a_0 * n ^ 0) / n ^ 1     =    (a_1 * n ^ 1     +     a_2 * n ^ 2     + ...) / n ^ 1
|     (i - a_0 * n ^ 0) / n ^ 1     =     a_1 * n ^ 0     +     a_2 * n ^ 1     + ...
| mod((i - a_0 * n ^ 0) / n ^ 1, n) = mod(a_1 * n ^ 0     +     a_2 * n ^ 1     + ..., n)
| mod((i - a_0 * n ^ 0) / n ^ 1, n) = mod(a_1 * n ^ 0, n) + mod(a_2 * n ^ 1, n) + ...
| mod((i - a_0 * n ^ 0) / n ^ 1, n) =     a_1             +     0               + ...
| mod((i - a_0 * n ^ 0) / n ^ 1, n) =     a_1
|      i - a_0 * n ^ 0 - a_1 * n ^ 1              =      a_2 * n ^ 2     + ...
|     (i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2     =     (a_2 * n ^ 2     + ...) / n ^ 2
|     (i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2     =     (a_2 * n ^ 0     + ...)
| mod((i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2, n) = mod((a_2 * n ^ 0     + ...), n)
| mod((i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2, n) = mod((a_2 * n ^ 0, n) + ...
| mod((i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2, n) =      a_2             + ...
| mod((i - a_0 * n ^ 0 - a_1 * n ^ 1) / n ^ 2, n) =      a_2

| i = a_0 * n ^ 0 +  a_1 * n ^ 1 +  a_2 * n ^ 2  + ...
| i = a_0 * n ^ 0 + (a_1 * n ^ 0 +  a_2 * n ^ 1  + ...) * n ^ 1
| i = a_0 * n ^ 0 +  a_1 * n ^ 0 + (a_2 * n ^ 0  + ...) * n ^ 2
| i = a_0 * n ^ 0 +  a_1 * n ^ 0 +  a_2 * n ^ 0 (+ ...) * n ^ 3

コーヒーの色は水色

「1000cc バイクの色は青、ツツジの色は灰色、フリースの色は白、オフィスの色は空色」コーヒーの色は水色というネタを読んで、じゃぁ探してみようという気になった。HTML の色指定で使えるアルファベットは a-f の 6 種類、これを 6 つ並べるとこんな感じ。まぁ、どれが意味あるアルファベットかは人間様が判断するのだけれど。

$ perl -e '@F=qw(a b c d e f); for($i=0;$i%lt;6*6*6*6*6*6;$i++){@a=&sin($i,6); $#a=6; @a=reverse @a; foreach(@a){print "$F[$_]"}print"\n";} sub sin{my $s=shift @_; my $p=shift @_; my @a=(); my $i=0; do{push(@a, $s%$p); $s=int($s/$p); $i++;}while($s!=0); return @a;}'| head
aaaaaaa
aaaaaab
aaaaaac
aaaaaad
aaaaaae
aaaaaaf
aaaaaba
aaaaabb
aaaaabc
aaaaabd

で、まず考えてしまったのが、6 重の for ループ。これだと 1 行スクリプトとしては長すぎ。ということで、6 進数を考えて 6 の n 乗の係数をそれぞれの桁として使う。これで解決。

出力が多すぎなので考え方逆に。単語辞書から 6 文字の単語だけ抽出、意味は大文字が小文字になったところで変わらないので小文字に正規化。sort | uniq で重複削除

$ perl -lne 'while(m/(\w+)/g){print lc $1}' edict | perl -ne 'if(m/^\w{6}$/){print;}' | sort | uniq | less

16 進数で表せる 0 から f までの文字でそれ以外の文字と形が似ているものをピックアップすると下のようになる。

0 - O,D,o
1 - I,l
2 - z,Z
3,4,5
6 - b
7,8,9,a
b - 6
c,d,e,f
A,B,C
D - 0
E
c0ffee - coffee

右から左への変換を行い、変換後の文字列が [0-9a-fA-F]{6}となれば OK である。ただし、変換前は全部小文字になっているので、右は全部小文字にしておく。また、b を 6 にする変換は必要ない。変換しなくても 16 進で表せるから。同様に 6 を b にする変換と 0 を D にする変換も。したがって必要な変換はこんな感じ。

tr/odilz/00112/;

一気に全部やって篩にかけるにはこんな感じ。

$ perl -lne 'while(m/(\w+)/g){print lc $1}' edict | perl -ne 'if(m/^\w{6}$/){print;}' | sort | uniq | perl -ne 'chomp; $a=$_; tr/odilz/00112/; if(m/^[0-9A-Fa-f]{6}$/){print "$a\t$_\n";}' | less

で、篩にかけた結果、残ったのが下。初めのカラムが変換前で 2 番目のカラムが色コードである。3 カラム目には適当な意味を手作業で付けた。

1000cc  1000cc  排気量
289bce  289bce  ?
800000  800000  ?
abelia  abe11a  《植物》ツクバネウツギ属の低木  スイカズラ科の植物
ablaze  ab1a2e  輝いている、燃え立っている、興奮している
acacia  acac1a  《植物》アカシア
accede  acce0e  継ぐ、継承する、就く、就任する、権力の座に就く
acidic  ac101c  酸っぱい、酸の、酸性の
adelie  a0e11e  南極の地名
albedo  a1be00  アルベド◆太陽の光を地球が反射する割合。
alcedo  a1ce00  カワセミ
allele  a11e1e  対立遺伝子
allied  a111e0  同盟している
azalea  a2a1ea  ツツジ
babble  babb1e  せせらぎ（の音）
baddie  ba001e  悪役、悪者◆映画などに登場する
balboa  ba1b0a  バルボア◆パナマの貨幣単位
ballad  ba11a0  民間伝承の物語詩、バラード形式の詩・曲、歌謡、民謡
baobab  ba0bab  《植物》バオバブ
beefed  beefe0  強化?
befall  befa11  〔災難・異変などが〕起こる、生じる
belief  be11ef  信仰、信条
belize  be112e  ベリーズ(中米の国)
biblid  b1b110  ?
bifida  b1f10a  二叉
billed  b111e0  くちばしのある
biloba  b110ba  《植物》イチョウ◆学名
bladed  b1a0e0  ブレード［刀］の付いた
bobbed  b0bbe0  ショートカットの、断髪の
bodice  b001ce  女性用胴着
bodied  b001e0  ～な体を持つ
boiled  b011e0  ボイルした、ゆでた、煮た
cabala  caba1a  密教、神秘的教義
caddie  ca001e  《ゴルフ》キャディー、使い走りや雑用をする人
calico  ca11c0  キャラコ、キャリコ、更紗、サラサ
called  ca11e0  ～と呼ばれている
celiac  ce11ac  セリアック病患者
celica  ce11ca  神々しい、天上の
celled  ce11e0  ～細胞の［を持つ］
cicada  c1ca0a  《虫》セミ
cobble  c0bb1e  敷石、栗石、丸石、玉石
coffee  c0ffee  コーヒー
coiled  c011e0  ひもなどでグルグル巻きにされた
collie  c0111e  コリー◆スコットランド原産の牧羊犬
cooled  c001e0  冷却される
coolie  c0011e  クーリー、日雇い労働者◆インド、中国での
dabble  0abb1e  〔戯れ程度に〕水を跳ねかける
dacelo  0ace10  ワライカワセミ
daidai  0a10a1  ?
dazzle  0a221e  輝くもの、まぶしい光、まぶしさ、輝き
decade  0eca0e  10年間、10年
decide  0ec10e  決定する、決心する、決意する
decode  0ec00e  〔符号化された情報の〕復号、デコード
decola  0ec01a  ?
deface  0eface  ～の外観を損なう
defile  0ef11e  ～の美観を損なう、汚す、不潔にする
docile  00c11e  従順な、素直な、おとなしい、御しやすい
doodle  00001e  いたずら書き
ebcdic  ebc01c  拡張2進化10進コード(extended binary coded decimal interchange code)
edible  e01b1e  食料品、料理、食事
efface  efface  〔絵・文字・痕跡などを〕こすって消す、削除する
eiffel  e1ffe1  エッフェル
elodea  e100ea  カナダモ(植物)
fabled  fab1e0  寓話として名高い、伝説的な
facade  faca0e  〈フランス語〉表面、外観、外見、一面、うわべ、見せかけ
facial  fac1a1  美顔術
facile  fac11e  手軽な、容易な、たやすく得られる、軽快な、軽薄な、器用な
failed  fa11e0  失敗した、不成功に終わった
feeble  feeb1e  体力の弱った、弱々しい、か弱い、力がない、もろい
fiddle  f1001e  《楽器》フィドル、バイオリン
filial  f111a1  子供の、子供としてふさわしい
filled  f111e0  一杯詰まった、満杯の、充満した、詰め物をした
fizzle  f1221e  弱く消えてしまうようにシューと音を出す
fleece  f1eece  フリース◆ポリエステル起毛の合成繊維。
folded  f010e0  折られた、折り畳まれた
fooled  f001e0  だまされれる
icicle  1c1c1e  つらら、氷柱
iodide  10010e  ヨウ化物
labial  1ab1a1  唇音
lablab  1ab1ab  (植物)フジマメ
laddie  1a001e  若いの
leaded  1ea0e0  有鉛の
leafed  1eafe0  葉のある
liable  11ab1e  〔法的に〕責任がある、責任を負うべき、～を免れない
libido  11b100  《精神分析》リビドー、性的衝動、性欲
lidded  1100e0  〔容器などに〕ふたのある
loaded  10a0e0  荷物を積んだ
locale  10ca1e  現場、場所
office  0ff1ce  事務所
zodiac  2001ac  十二宮図、黄道帯、獣帯

意味が取れないものがいくつか混じっているが後は目で抜く。とりあえず下にまとめた。

意味の取れる色のリスト
1000cc	1000cc	応用が利きそう。
acacia	acac1a	《植物》アカシア、色との対応が付いていたらすごい。
allele	a11e1e	対立遺伝子、lがそれぞれ1に対応している。でも、単語がなじみなさすぎ
azalea	a2a1ea	ツツジ、実物との対応
babble	babb1e	せせらぎ（の音）、実物との対応
balboa	ba1b0a	バルボア◆パナマの貨幣単位、2箇所変化
baobab	ba0bab	《植物》バオバブ、1箇所変化
befall	befa11	〔災難・異変などが〕起こる、生じる、2箇所変化
cabala	caba1a	密教、神秘的教義、1箇所変化
cobble	c0bb1e	敷石、栗石、丸石、玉石、2箇所変化
coffee	c0ffee	コーヒー、1箇所変化
doodle	00001e	いたずら書き、ほとんど原形とどめず
efface	efface	〔絵・文字・痕跡などを〕こすって消す、削除する、一切変化なしの完全形
feeble	feeb1e	体力の弱った、弱々しい、か弱い、力がない、もろい、1箇所変化
fleece	f1eece	フリース◆ポリエステル起毛の合成繊維。、1箇所変化
locale	10ca1e	現場、場所、3箇所変化
office	0ff1ce	事務所、2箇所変化
zodiac	2001ac	十二宮図、黄道帯、獣帯、ほとんど原形とどめず。

使えそうなのは 1000cc、azalea、cabala、coffee、fleece、office ぐらいか。ということで最初の話に戻る。

MD5 とか SHA1 でハッシュ計算

これもあえて Perl でしなくてもいいことなのだけど、ごくたまに MD5 とか SHA1 のハッシュを求めんといかん状況に追い込まれることがある。ごくたまにしかない状況のためにいちいち探してインストールしてというのはあまり好きじゃない。ということで、あるメッセージのハッシュ値を計算させるには下のようにする。

$ perl -le 'use Digest::MD5 qw(md5_hex); print md5_hex("admin");'
21232f297a57a5a743894a0e4a801fc3
$ perl -le 'use Digest::SHA1 qw(sha1_hex); print sha1_hex("admin");'
d033e22ae348aeb5660fc2140aec35850c4da997

MD5 のモジュールはすでにインストール済みだったが、SHA1 はインストールされてなかったので導入した。

1 行で CPAN モジュールの導入

うちのサーバなので、勝手にモジュールのインストールが可能だ。このような場合は何をするにも楽なのだ。root になって Diget::SHA1 を導入してみる。

# cpan -i Digest::SHA1

1行とかこだわらなければ

# cpan
cpan> install Digest::SHA1
cpan> quit

あえてタイプ数の多い方法を使いたければ

# perl -MCPAN -e shell

こんな感じで OK。perl ってのはすごいね。きっと Windows だろうが Linux だろうが、perl の世界にはいってしまえば OS 間の差異は取り払われてしまうのかもしれない。まぁそれはそれとて、導入できたか確認とバージョンの確認をしてみよう。下の 2 つは同じこと、失敗しているとここでエラーメッセージが出る。

$ perl -MDigest::SHA1 -le 'print $Digest::SHA1::VERSION;'
$ perl -MDigest::SHA1 -le 'print Digest::SHA1->VERSION;'

よくあるバージョン確認の方法は上の 2 つ。つまり、モジュールを use してモジュール内の $VERSION 変数を参照する方法。バージョンチェックの 3 番目は下のような感じ。長くなった割にあまり面白くないが、モジュールを読み込まないので多少メモリの節約になるかもしれない。

$ perl -MExtUtils::MakeMaker -le 'print MM->parse_version(shift)' /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/Digest/SHA1.pm

たった 1 つのモジュールのバージョンをチェックするだけなら MakeMaker をつかうのはもったいない。モジュールのリストとバージョンをチェックするには下のようにするとよさげ。MakeMaker を使う方法では、実際にモジュールを読み込んでいるわけではないので (use とか require で) コンパイルが通るかどうかまではわからない。

$ perl -MExtUtils::MakeMaker -MFile::Find -le 'find(sub{$a=$File::Find::name; if(m/pm$/){print MM->parse_version($a)."\t".$a}},@INC);' | less

当然といえば其の通りだが勝手にどんどんインストールしてしまうとトラブルが起きる。うちの etch では「apt-get update 後 (perl のアップグレード含む) の perl プログラムが軒並み下のエラーメッセージを出して終了する」というトラブルが起きた。

# apt-get update
# apt-get upgrade
# cpan(例えば。)
Errno architecture (i486-linux-gnu-thread-multi-2.6.18-6-k7) does not match executable architecture (i486-linux-gnu-thread-multi-2.6.18-6-686) at /usr/local/share/perl/5.8.8/Errno.pm line 11.
Compilation failed in require at /usr/local/share/perl/5.8.8/CPAN.pm line 1107.
BEGIN failed--compilation aborted at /usr/local/share/perl/5.8.8/CPAN.pm line 1107.
Compilation failed in require at /usr/local/bin/cpan line 175.
BEGIN failed--compilation aborted at /usr/local/bin/cpan line 175.
Can't call method "has_usable" on an undefined value at /usr/local/share/perl/5.8.8/CPAN/HandleConfig.pm line 502.
END failed--call queue aborted at /usr/local/bin/cpan line 175.

たしか、apt-get upgrade のときに perl を upgrade していたような気がする。んで、upgrade の前には cpan コマンドでいくつかのモジュールを install & update していた。Errno.pm でまずだめになっているようなのでどこにあるか探すと 2 つ出てくる。

$ locate Errno.pm
/usr/lib/perl/5.8.8/Errno.pm
/usr/local/share/perl/5.8.8/Errno.pm

Errno architecture とか言ってくるのはどっちだと言うことで grep

# grep "Errno architecture" /usr/lib/perl/5.8.8/Errno.pm /usr/local/share/perl/5.8.8/Errno.pm
/usr/local/share/perl/5.8.8/Errno.pm:   die "Errno architecture (i486-linux-gnu-thread-multi-2.6.18-6-k7) does not match executable architecture ($Config{'archname'}-$Config{'osvers'})";

ということで/usr/local/share/perl/5.8.8/Errno.pm を読みに言っている様子。じゃぁ @INC の順番を調べる。なぜかワンライナーはいけるようで下のような感じ。

# perl -e 'print "@INC"'
/etc/perl /usr/local/lib/perl/5.8.8 /usr/local/share/perl/5.8.8 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl .

なるほど。やはりこの順番でよみにいってるのだな。2 つの Errno.pm のバージョンチェック

# grep "VERSION" /usr/lib/perl/5.8.8/Errno.pm /usr/local/share/perl/5.8.8/Errno.pm
/usr/lib/perl/5.8.8/Errno.pm:our (@EXPORT_OK,%EXPORT_TAGS,@ISA,$VERSION,%errno,$AUTOLOAD);
/usr/lib/perl/5.8.8/Errno.pm:$VERSION = "1.09_01";
/usr/lib/perl/5.8.8/Errno.pm:$VERSION = eval $VERSION;
/usr/local/share/perl/5.8.8/Errno.pm:our (@EXPORT_OK,%EXPORT_TAGS,@ISA,$VERSION,%errno,$AUTOLOAD);
/usr/local/share/perl/5.8.8/Errno.pm:$VERSION = "1.10";
/usr/local/share/perl/5.8.8/Errno.pm:$VERSION = eval $VERSION;

つまり、version 1.10 のほうを読みに行っているのね。それはおそらく cpan コマンドで更新されたものだな。ということでこちらを Errno.pm から Errno.pm.org にリネーム

# mv /usr/local/share/perl/5.8.8/Errno.pm{,.org} -i

で、cpan を走らせてみる。

# cpan
cpan shell -- CPAN exploration and modules installation (v1.9301)
ReadLine support enabled
cpan[1]>

走るな。じゃぁいままでだめだったプログラムを走らせて見る。

$ perl ./hoge.pl

走ったか。全く良くわからんがリネームでこのトラブルは回避できた予感。今回のトラブルは cpan がインストールするディレクトリと apt-get がインストールモジュールのディレクトリが違うことで起こってしまったと思われる。同じにしたらしたで問題ありなのでとりあえずこの状態で様子見運用します。

cpan のダウンロード先変更

まずは今の設定をチェックする。

# cpan
cpan> o conf urllist
        ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/
cpan> o conf urllist pop ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/
cpan> o conf urllist push http://ftp.riken.jp/lang/CPAN/
cpan> o conf urllist
        http://ftp.riken.jp/lang/CPAN/
cpan> o conf commit
cpan> q

変更が出来たらその設定済みの内容を Config.pm に反映する。再度 cpan を起動して設定内容が破棄されていないかどうかを確認。

# cpan
cpan> o conf urllist
        http://ftp.riken.jp/lang/CPAN/

html エスケープ

html を直に書くとき、> を > に書き換えたりする。これを HTML エスケープというのかは知らないが、タグにはさまれた内容に含めていけないものを含めてもよい形に変換することをぼくは HTML エスケープと呼んでいる。これを 1 行でしてみよう。

$ perl -pe 'BEGIN{use HTML::Entities qw(encode_entities);} encode_entities($_,"<>&");' hoge.txt
$ perl -MHTML::Entities -pe 'encode_entities($_,"<>&");' hoge.tex

こんな感じで標準出力にエスケープされた内容が表示される。BEGIN{} ブロックで HTML::Entities をロードして、この中でユーザ空間の encode_entities を HTML::Entities::encode_entities に差し替える。-p オプションで hoge.txt の内容をいちいち出力、出力前にエスケープ処理を行う。モジュールをよく読めばその下のようにもかける。このように出力されたものを pre の中に含め、ブラウザで表示させると、エスケープ前の文字列が見える。

CGI.pm を使うという手もある。CGI.pm は確か何もしなくても導入してあったと思う。色々入れすぎて訳わかんなくなってるけど。例えば下のような感じ、こちらのほうが短くてすむので少しうれしゅうございますだ。でも、これだとうまくいかない場合がある。やはり正攻法は encode_enities だろう。

$ perl -MCGI -pe '$_=CGI::escapeHTML($_);' hoge.tex

URL エンコードと URL デコード

hoge.txt はテキストファイル。日本語とか英語とか空行とか改行とか <>&" とかごちゃ混ぜに入っている。

$ cat hoge.txt
日本語
eigo
<
>
&
"
$ perl -MCGI::Util -pe '$_=CGI::Util::escape($_);' < hoge.txt
%E6%97%A5%E6%9C%AC%E8%AA%9E%0Aeigo%0A%0A%3C%0A%3E%0A%26%0A%22%0A%0A%0A

変換された内容を見てみるとなんとなく正しく変換されているようだ。元に戻すには下のようにする。

$ perl -MCGI::Util -pe '$_=CGI::Util::escape($_);' < hoge.txt > hoge_escape.txt
$ perl -MCGI::Util -pe '$_=CGI::Util::unescape($_);' < hoge_escape.txt
日本語
eigo
<
>
&
"

ところでこういう処理のこと URL エンコード、URL デコードっていうのは正しいのかな。それとも URL エスケープ、URL アンエスケープって言うのが正しいのかな。

バブルソート

暇ではないが、暇と認めたくはないが、本当は全く持って暇でもなんでもないのでけれど、暇だと思いたい。小人閑居して不全をなす。バブルソートをあえて 1 行で書く必要など全くないのだけれど、これも腐りきった脳髄の刺激のためにやっておく必要があるだろう。

$ perl -le '@F=qw(8 4 3 7 6 5 2 1); for($i=0;$i<@F;$i++){for($j=1;$j<@F-$i;$j++){print "@F | $i $j"; if($F[$j]<$F[$j-1]){@F[$j-1,$j]=@F[$j,$j-1];}}} print "@F";'
8 4 3 7 6 5 2 1 | 0 1
4 8 3 7 6 5 2 1 | 0 2
4 3 8 7 6 5 2 1 | 0 3
4 3 7 8 6 5 2 1 | 0 4
4 3 7 6 8 5 2 1 | 0 5
4 3 7 6 5 8 2 1 | 0 6
4 3 7 6 5 2 8 1 | 0 7
4 3 7 6 5 2 1 8 | 1 1
3 4 7 6 5 2 1 8 | 1 2
3 4 7 6 5 2 1 8 | 1 3
3 4 6 7 5 2 1 8 | 1 4
3 4 6 5 7 2 1 8 | 1 5
3 4 6 5 2 7 1 8 | 1 6
3 4 6 5 2 1 7 8 | 2 1
3 4 6 5 2 1 7 8 | 2 2
3 4 6 5 2 1 7 8 | 2 3
3 4 5 6 2 1 7 8 | 2 4
3 4 5 2 6 1 7 8 | 2 5
3 4 5 2 1 6 7 8 | 3 1
3 4 5 2 1 6 7 8 | 3 2
3 4 5 2 1 6 7 8 | 3 3
3 4 2 5 1 6 7 8 | 3 4
3 4 2 1 5 6 7 8 | 4 1
3 4 2 1 5 6 7 8 | 4 2
3 2 4 1 5 6 7 8 | 4 3
3 2 1 4 5 6 7 8 | 5 1
2 3 1 4 5 6 7 8 | 5 2
2 1 3 4 5 6 7 8 | 6 1
1 2 3 4 5 6 7 8

できて当たり前だぎゃね。まぁ今回は配列要素の入れ替えの勉強になったからよしとしよう。C 言語だとこんな感じの書き語って許されてたんだっけかなぁ。たしか一時変数に保存して上書きするという方法でやっていたような気がする。

stat で ls の代わり

やってみそ

$ perl -le 'foreach(<*>){print join("\t",stat(),$_);}'

やってみた、これ以上書くとなんだかせっかくの 1 行のメリットが失われる感があるのでやめておこう。それぞれのカラムが何を意味しているのかは調べてほしい。stat 系のモジュールは結構たくさんある。出力を ls っぽくしてくれるものとか。やっぱり考えることはみな同じだなぁ。

ディレクトリを作れ

カレントに test というディレクトリをつくるにはこんな感じ。でも、コマンドで mkdir -p のようにしてやるような多重階層のディレクトリ作成は無理っぽい。どっかのモジュールにあったような気がするんだけれど思い出せん。

$ perl -e 'mkdir("test");'

1 行で平均値

それぞれのコラムに対応した平均値を求めてみる。入力ファイルは 5 コラムで 4 行のタブ区切りテキストで下のような感じ。

$ cat hoge.dat
1       2       3       4       5
6       7       8       9       10
11      12      13      14      15
16      17      18      19      20

で、下のようにして平均値を出力した。重要なのは、hoge.dat の最後に改行がないということ。最後に改行があると、最後に $i が 5 となるため、正確でない値がでる。

$ perl -alne 'map{$S[$_]+=@F[$_]}(0..$#F);$i++; END{print join"\t",map{$_/$i}@S;}' hoge.dat
8.5     9.5     10.5    11.5    12.5

特定の行のみ出力 (head の代替)

head の代替をするなら下のような感じ。

$ head -n 100 hoge.dat
$ perl -ne 'print if 1 .. 100' hoge.dat

行数を知っていれば tail の代替もできる。行数が 200 行として最後から 50 行を出力するならば下のような感じ。

$ tail -n 50 hoge.dat
$ perl -ne 'print if 251 .. 200' hoge.dat

gnuplot と組み合わせるとかなり便利な感じ。

文字列の検索 (grep の代替)

hoge が含まれる行を表示する。-p オプションを使わないのがミソ。-p オプションは常に出力が必要な場合に付ける。1 行 if 文の書き方がわかれば 2 行目でも同じこと。

$ perl -ne 'if(m/hoge/){print;}' file
$ perl -ne 'print if /hoge/' file

大文字小文字の区別を無視するなら、m//i で下のようにする。これだと Hoge も HOGE も hOgE にも引っかかる。

$ perl -ne 'if(m/hoge/i){print;}' file
$ perl -ne 'print if /hoge/i' file

perl で google PageRank を取得する

あるサイトの PageRank を知りたいと思ったときに GoogleToolbar を入れなくてもわかる方法がある。其の方法とは google toolbar が叩いている URL をブラウザなりで叩くことだが、この場合には pagerank を調べてたいサイトに対応したチェックサム (ch=) の計算が必要になる。この計算と受信した内容をパースしてくれるモジュールが WWW::Google::PageRank。

$ perl -MWWW::Google::PageRank -e 'print scalar WWW::Google::PageRank->new->get("http://www.google.com/");'

UNIX time が「1234567890」になる時間

$ perl -le 'print scalar localtime 1234567890'
Sat Feb 14 08:31:30 2009

1行スクリプトをスクリプトファイルにする

1行スクリプトと言っても、何回も使うならいちいち入力するのは面倒なので同等の機能を持ったスクリプトファイルにしましょう。説明は日本語 perl texinfo - Optionに詳しい。とにかく、1行目にperlのパス-Mと-e以外のオプションがある場合はそれを続け、-Mがある場合は2行目にuseを置いて其の後に-M以降、3行目に-e ''で括った中身を書けばOKのような感じ。ためしに以前書いたhtmlエスケープの1行スクリプトをスクリプトファイルにしてみる。ターゲットは下のような感じ。

$ perl -MHTML::Entities -pe 'encode_entities($_,"<>&");' hoge.tex

これは下のように書き下せる。

$ cat htmlescape.pl
#!/usr/bin/perl -p
use HTML::Entities;
encode_entities($_,"<>&");
$ chmod +x htmlescape.pl
$ mv htmlescape.pl ~/bin/

これに名前htmlescape.plを付けて、実行属性を加えて、パスの通った場所においておけばいつでも使える。使い方は下のような感じ。

$ ./httpescape.pl hoge.tex

せっかく1行でかけるのだからbashのaliasにしてしまうのが一番楽なのかも知れん。そういえば、#!から始まる行のことをシェバング行と呼ぶとか呼ばないとか。で、#シャープと!バングでシェバングだとか。

[Perl] -pオプション

-pオプションをつかって下のように書いた場合。

$ perl -pe 's/a/b/g' file

これを書き下すと下のようになるそうだ。

while(<>){
        s/a/b/g; # '...' の中身
        print;
}

まぁ多少わかりにくいかも知れんので、正確さは失われるがもっと書き下してみた。

open IN, "file"; # 引数
while(<IN>){
        $_ =~ s/a/b/g; # '...' の中身
        print $_;
}
close IN;
exit;

[perl] 1 行スクリプト覚書 with Active Perl

目次

test_STM.pl

PerlShell.cgi

[linux] 総和の方向で結果が異なるのは仕方ない。

判定と 2 重 for でどっちが早いのか

改行コードの変換 (nkf の代替)

文字コードの変更

Hello world と表示させる

[rename] ファイルの名前を一括変換

[unlink] ファイルを一括削除

シンボリックリンク

n 進数

コーヒーの色は水色

MD5 とか SHA1 でハッシュ計算

1 行で CPAN モジュールの導入

cpan のダウンロード先変更

html エスケープ

URL エンコードと URL デコード

バブルソート

stat で ls の代わり

ディレクトリを作れ

1 行で平均値

特定の行のみ出力 (head の代替)

文字列の検索 (grep の代替)

perl で google PageRank を取得する

UNIX time が「1234567890」になる時間

関連記事

perl

一行

1 行

Active Perl

1 行野郎

1 行スクリプト

一行野郎

一行スクリプト

One-Liner

One Liner

ソーシャルブックマーク

日付の近い記事

ChangeLog