ここではperlの1行スクリプトを使用し、単一の機能をどれだけ短いスクリプトで表現できるかを模索していきます。Windowsのコマンドラインが非力なのは仕方ありません。GUIが売り物のWindowsですから。unixほどの高機能なシェルはいらないけど、unix使いに負けないくらいの仕事がしたい貴方に。単一の機能の集合がプログラムで、短い行で様々な機能を実現できればプログラムを書くのも楽になると思います。単一の機能を極限まで短くすることには、Perlの美学に通ずるものがあると思います。言い換えればここは、Perlの隅を針で突く、プロジェクトページです。
この稿はWindowsMe上でActivePerlを走らせたい人向けの情報です。しかし、シェルとしては非力なWindowsMeのcommandプロンプトでの結果を載せているため、多分Unix版のPerl上でも動くでしょう。perlの前についている>マークはWindowsのプロンプトマークです。今から行うのはActivePerlでの話なのでunixのBシェルやCシェルのプロンプトマークである$や%は使いません。
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";
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たたいたほうが速いって?そのとおり。ネタがなくなったって?そのとおり。
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:\>
D:\>perl -e "print <*.*>"
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
D:\>jperl -ne "tr/Ａ-Ｚａ-ｚ０-９（）？！/A-Za-z0-9()?!/;print;" original.txt > new.txt
だめぽ。jperlでしか動かんのかも。
D:\>perl -e "print sort(<>); exit;" c.txt
sortコマンドのエミュレートな感じかな。
D:\>perl -ne "push(@l, $_) unless $f{$_}++; END{print sort(@l);}" c.txt > ccc.txt
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にて展開、つまり文字列として展開しているんだな。
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
秀逸なのは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:\>
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;"
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
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";
}
}
例えば、空白で区切られた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\デスクトップ>
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]をどうにかしたいんだな。
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について書いてみようと思うんだな。まずは下のスクリプトを見てほしいんだな。
# 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するような場合のスクリプトを短く書けるんだな。
#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
たとえば次のようなデータファイルがあったとするんだな。
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
よくあるデータの形式として、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
等差の次は等比ということで。代わり映えはしませんが。
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
ただのお遊びですな。範囲演算子でマイナスが使えるんですねぇ。ちなみに文字を足し算しても0にしかなりません
D:\>perl -e "for (a..z,A..Z,0..9) { print $_ }"
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
こんな使い方もあるんだと思った作品へぇ。
どっちが美しいかは好みですが。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:\>
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なんかのコマンドプロンプトは入力バッファサイズに足かせがないから入力できるんだな。といってもここで注目すべきなのは、エスケープの仕方なんだから結果が見えていればいいんだな。さて、円マークでエスケープしたダブルクヲートに挟まれた文字のうちで唯一挙動の違うのは、ダブルクヲートなんだな。こいつだけはシングルクヲートで囲んで文字列連結で出力するしかなさそうなんだな。これ以外の文字は通常のエスケープがそのまま適応できるようなんだな。
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文字分のスペースを表現するかだな。
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;
}
例えば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\デスクトップ>
C:\>perl -p -e 'print' test.txt
-pで入力ファイルを指定、-eの後に続くはスクリプト文。print文を囲むのはシングルクヲート。ダブルにすると多分うまくいかない。
C:\>perl -p -e 'print;' test.txt
print文の最後にセミコロンをつけてもうまくいく。
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;
リファレンスの含まれる変数の前にドルマーク$を加えて出力するとリファレンスの指し示す変数の内容が出力されるんだな。
@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;
# 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;
#!/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'
];
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)
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)
InetSpy (+ 横取り丸)Proxomitronのいずれかでやってましたが、今日LindowsOS開発日誌見ていたらおもしろいの見つけました。
$ perl -MHTTP::Proxy -e 'HTTP::Proxy->new(port => 8080)->start'
$ perl -MHTTP::Proxy=:log -e '$p=HTTP::Proxy->new(port => 8080);$p->logmask(ALL);$p->start;'
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で書かれた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文字の文字列を生成してくれる。前よりもコードが長くなっていたり非効率になっている。今回はこれでご勘弁を。
> perl -le "map{print qq/$_ $SIG{$_}/}keys %SIG"
> perl -le "map{print qq/$_ $ENV{$_}/}keys %ENV"
テストとしてやってみたんだな。範囲演算子は数を一つずつ増やし、各コード値に対応した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{|}~
> 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行スクリプトと言うには長すぎるからね。
もっとも問題なのはこの手の処理が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 -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)
>
もちろんコーシー判定の結果が正しいのである。しかし、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 -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]))}"
ラップタイムはPause/Break、再度時間を進める場合はEnter、停止はCtrl+C
> perl -le "while(1){print scalar times;}"
> perl -we "print scalar(localtime);" Fri Feb 17 21:20:46 2006 C:\>
> 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)
>
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] : './';
ここまではActiveperlを対象に1スクリプトを書いてきたが、これからはLinuxで動くPerlもしくはCygwin上で動くPerlで1行スクリプトを書こうと思う。
その理由はやはり丸め込み誤差だろうな誤差を小さくするためにはどうすればいいのだろう。
$ 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
$
これは宿題
たとえば、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は改行コードと文字コードの変換によく使う。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機能のチェックからはじめよう。
さて、最も単純に考えると下のようになる。
$ 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行スクリプトを書くかについて考えているときに思い浮かんだ。
いや、あえて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だと詳細出力それ以外は出力なし。
ファイルを選んで消そう、削除しようと思う。
$ 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")'
ここまでくるとほとんど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ぐらいか。ということで最初の話に戻る。
これもあえて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はインストールされてなかったので導入した。
うちのサーバなので、勝手にモジュールのインストールが可能だ。このような場合は何をするにも楽なのだ。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.om.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> 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エスケープと呼んでいる。これを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
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言語だとこんな感じの書き語って許されてたんだっけかなぁ。たしか一時変数に保存して上書きするという方法でやっていたような気がする。
やってみそ
$ perl -le 'foreach(<*>){print join("\t",stat(),$_);}'
やってみた、これ以上書くとなんだかせっかくの1行のメリットが失われる感があるのでやめておこう。それぞれのカラムが何を意味しているのかは調べてほしい。stat系のモジュールは結構たくさんある。出力をlsっぽくしてくれるものとか。やっぱり考えることはみな同じだなぁ。
カレントにtestというディレクトリをつくるにはこんな感じ。でも、コマンドでmkdir -pのようにしてやるような多重階層のディレクトリ作成は無理っぽい。どっかのモジュールにあったような気がするんだけれど思い出せん。
$ perl -e 'mkdir("test");'
それぞれのコラムに対応した平均値を求めてみる。入力ファイルは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 -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と組み合わせるとかなり便利な感じ。
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
あるサイトの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/");'
$ perl -le 'print scalar localtime 1234567890' Sat Feb 14 08:31:30 2009
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にしてしまうのが一番楽なのかも知れん。そういえば、#!から始まる行のことをシェバング行と呼ぶとか呼ばないとか。で、#シャープと!バングでシェバングだとか。
-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;
