funini.com kei Perl

Perl

Love Perl?

Perlは「プログラム書こう」て動機のハードルが低いのがいいです。 ただ、掲示板くらいになるとそれなりの書き方を決めないと死にます。


$|=1;
print "hoge";

これで、printの後に一々flushしてくれるようになります。


sub rand_str(){
 $s = "";
 foreach(0..10){
 $s .= chr(rand()*26 + ord('a'));
 }
 return $s;
}


while (<>) {print "$1 " if(m/$(.+)¥s*:/) }


$SIG{ALRM} = sub { die "timeout" };


$a = "he";
@a = ("he", "she");
@a = grep {$_ ne $a} @a;
print @a;


sub gen_str(){
 $s = "";
 foreach(0..1000){
 $s .= chr(int(rand() * 26)+ord("a"));
 }
 return $s;
}


$t[0] = time();

@A;
foreach(0..100000){
 push(@A, gen_str());
}

$t[1] = time() - $t[0];
@B = sort @A;
$t[2] = time() - $t[1];

print "To generate: " . $t[2] . " sec, to sort: " . $t[1] . " sec¥n";

複数行にわたる置換とか (正規表現)


"は¥"みたいにエスケープしなくてもいい (しても実害ないみたいだけど)


複数行にわたるパターンを置換したい場合、
改行文字にもマッチさせたい場合、.だけではだめ。[¥s¥S]ってするのがお手軽。


edit.phpへのリンク及び、<form></form>にで囲まれた部分をすべて削除。
[s¥S]*?で最短一致になっている。


$s=""; while(<>){ $s .= $; } $=$s; s/([^<>]+?)<¥/a>/$1/g; s/<form [¥s¥S]+?<¥/form>/ /g; print;



### HTMLで、リストの順序(<ul>と</ul>の間)を入れ替え


while(<>){ $before .= $_; last if (m/<ul/); }

while(<>){ last if (m/<¥/ul/); $li = $; while(<>){ $li .= $; last if(m/<¥/li/); } push(@list_items, $li); } $after = $; $after .= $ while(<>);

print $before; print foreach(reverse(@list_items)); print $after;



### フォルダの各ファイルについて…する
opendirを使うと、ディレクトリ内の各ファイルについて処理をする、ということができます。 リネームとかにも便利です。

if (opendir(DIR, 'text/')){ @utexts = readdir(DIR); closedir(DIR); }


こうすると、text/内のファイル一覧が@utextsという配列に入ります。
この結果はソートされていません。名前順でソートするには、

@texts = sort { $a cmp $b} @utexts;


とするといいです。$aと$bは{}内だけで通用する変数で、いつも同じです。ソートを降順にしたければ、$aと$bを入れ替えます。ソートされた結果は@textsに代入されます。
これらのファイルについての処理は、foreachで書きましょう。 正規表現を使って、対象とするファイルを絞り込むのもよし。

foreach $file (@texts){ next if($file =‾ /^([0-9]{2})¥.txt$/); # 例えば、??.txtというファイル名にマッチしなければ捨てる open IN, "text/" . $file; #ファイル開く



### 一行スクリプト


perl -e "コマンド"


で、コマンドが実行されます。シェルで一行スクリプトを実行するのに便利。
awkとかsedだともっとスマートに書けそうだけど、perl覚えてるならそれ使っちゃった方が楽、かも。
- ls の出力をアルファベット順の逆順でprint。

ls | perl -e '@A=<>;for($i=$#A;$i!=-1;$i--){print $A[$i]}'



- 50%の確率で二つの出力を出したいとき

perl -e "print int(rand(2)) ? 'hi' : 'bye';"



- 電卓使いたいような。例えば2の32乗。

perl -e "print 1 << 31 "


最後の;は無くても動きますね。ということはperlの;は"文の区切り"であって、"文の終端"ではないのか!?

- 標準入力のhogeをfugaに置換

perl -e "while(<>){s/hoge/fuga/g;print} "



- psの結果の一行目を捨てて、残りの結果の1カラムと3カラム目を出力

ps | perl -e '<>;while(<>){@a=split; print "$a[0]¥t$a[3]¥n"} '



- <br />タグを全て改行(¥n)に置換

cat 変換前のファイル名 | perl -e 'while(<>){s|
|¥n|g;print}'



### faviconクローラー
aaa.comからzzz.comまでのアイコンを収集します。
タイムアウトは5秒です。

#!/usr/bin/perl

use LWP::Simple;

$thres = 3;

sub get_com($$){ my ($str, $depth ) = @_; if($depth == $thres){ print "Trying : $str ... "; my $page; eval { local $SIG{ALRM} = sub { die "timeout" }; alarm 5; $page = LWP::Simple::get("http://www.$str.com/favicon.ico"); alarm 0; }; alarm 0;

if($@) { if($@ =‾ /timeout/) { print "Timeout¥n"; next; } }

if( $page eq undef() ){ print "Undef¥n"; next; } $_= substr($page, 0, 200);

if(m/<html/i){ print "Html¥n"; next; } open OUT, "<favicon/$str.ico"; print OUT $page; close OUT; print "Wrote¥n"; } else { my $i; for($i = ord('a'); $i <= ord('z'); $i++){ get_com($str . chr($i), $depth + 1); } } }

get_com("", 0);



### 画像ファイルをリスト表示

- [サンプル](img_list/img_list.cgi)


#!/usr/bin/perl

$dir = ".";

print "Content-type:text/html¥n¥n"; if (opendir(DIR, $dir)) { foreach(readdir(DIR)) { image($_) if(/.+¥.(png|jpg|jpeg)$/i); } closedir(DIR); } print "¥n";

sub image { print "
";}


超簡易スクリプト。$dirで指定されたディレクトリ内の画像ファイルをリスト表示します。
大きな画像を縮小表示したりとか、気の利いたことは何もしません。改造のたたき台にどうぞ。

### フォルダをランダムな名前にリネーム
lsがある環境でしか使えません。(関数探すのが面倒だったので…) 1/1000000くらいの確率で同じ名前が何回か出そうですが…

@A = ls -F;

foreach (@A){ chomp(); next unless(m/.*¥/$/); $new_fn = int(rand(1000000)); $cmd = "mv $_ $new_fn";

print $cmd . "¥n"; (いちおう出力確認)

$cmd; }



### tips
プログラム書いてて経験したことのメモ。
-

sub getDateStr(){ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $year += 1900; $mon++; $ret = sprintf("%d_%02d%02d_%02d%02d_%02d", $year, $mon, $mday, $hour, $min, $sec); return $ret; }



- CGIのデバッグには、

open ERR, ">>err.dat";print ERR "status = $status¥n" ;close ERR;


みたいな一行をコピー&ペーストして、エラーファイルを使うと便利。
最近はサブルーチン化してます。

sub err { open ERR, ">>err.dat"; print ERR join(';',@_)."¥n"; close ERR; chmod 0666, "err.dat"; }



- ファイルを

@temp = ;


みたく読み込んだとき、各要素($temp[0], $temp[1]...)には改行コード(普通は¥n)がぶら下がってるから注意。

- ハッシュのキーには'を使う癖を付けておくと、printの時に楽。

print OUT "value = $HASH{'name'}"


みたいに。

- もし$strがnullでないなら...というつもりで

if ($str) {


とすると、$str = "0"の時も弾かれるので注意。はまりました。

- for文で

for ($i = 1; $i <= 5; $i++ ){


って書いたとき、ループ終了後のiの値は6。(これはCも同じ) 何となくBASICの

for i = 1 to 5


のノリで書くと失敗します。
☆foreach $i(1..5)は終了時に多分$i=5です。

- 配列@listの長さっぽいものとして、という意味で$#listが使えますが、これの値は「長さ - 1」です。だから、@listの全ての要素についてループ、は

for($i = 0; $i <= $#list; $i++){


です。ま、foreach使えば関係ないけど...

- フォルダ内の各要素について、という処理は

if (opendir(DIR, ‾/imgs)) { @list = readdir(DIR); foreach(@list){ ($_にファイル名が入る) closedir(DIR); }



- 普通の時間→UNIXシステム時間 の変換。$monは通常の月から1引いた値なので注意。 (8月→"7")

use Time::Local; ($year,$mon,$mday,$hours,$min,$sec)=split(","); $time = timelocal($sec, $min, $hours, $mday, $mon - 1, $year); print "$time¥n";



- 掲示板とかのセーブファイルについて、CGIが自動的にdirerctoryを作るようにすると、中のファイルが消せなくなることがある。 だから、ファイル/フォルダを作ったら、chmodしておく...と、使う人には便利。ただ、セキュリティー上はまずそうなので、程々に。

open OUT ">hoge.dat"; chmod 0666 hoge.dat;



- perlでは一行if文やwhile文は、文の後に書く。Cなら

if(index == 3) printf("Hello¥n");


となるのは、

print "Hello¥n" if($index == 3);


となる。これを使うと

print while <>;


とかいう怪しい文も書ける。

- icon/以下のファイルから4つのpngファイルをランダムに選択。 選択したファイル(へのパス)は@imgsに格納

my $dir = 'icon/'; my @files; if (opendir(DIR, $dir)){ @files = readdir(DIR); closedir(DIR); } my @imgs; my $j = rand($#files + 1);

foreach $i (0..3){ do{ $_ = $files[($j++) % ($#files + 1)]; } while(! /¥.png$/); $imgs[$i] = $dir . $_; if(!-e $imgs[$i]){ $imgs[$i] = '';} }


普通にディレクトリをオープンすると、.と..もリストに含まれるので注意。

- テキストファイルを決まった行数で分割。

open(IN, $ARGV[0]); for($fn = 0; ; $fn++){ open(OUT, ">". $ARGV[0] . $fn); print "wrote file $fn¥n"; $count = 0; while($count++ < 500){ $tmp = ; if($tmp eq ''){ close IN; close OUT; exit(0); } print OUT $tmp; } close OUT; }



- 数字の連続、みたいなのは本当に書きやすい。

@A = (1,2..4,8..10);



- 回文判定

print pal($ARGV[1]) . "¥n";

sub pal{ $_ = $_[0]; return (2 > length()) ? 'true' : (m/^(.).$/ && m/^.(.)$1$/) ? pal($1) : 'false'; }


と書いたんだけど、実はCでもたいしたことないし。

int pl(char *s, char *e){ return (2 > e - s) ? 1 : (*s == *e) ? pl(s + 1, e - 1) : 0; }

int main(int argc, char *argv[]){ char *cp = argv[1]; if(pl(cp, cp + strlen(cp) - 1)) printf("true¥n"); else printf("false¥n"); return 0; }


多くの場合、これでも正しく動作する。

int pl(char *s, char *e){ return (2 > e-s) || ((*s==*e) && pl(s+1, e-1)); }

int main(int argc, char *argv[]){ char *cp = argv[1]; if(pl(cp, cp + strlen(cp) - 1)) printf("true¥n"); else printf("false¥n"); return 0; }



- {}で囲った値を変数に代入すると無名ハッシュへのリファレンスになるが、 ()で囲った配列の場合は実体になる。[]で囲むと無名配列へのリファレンスを取得できる。

$a = {0=>2}; @A = (0, 2); $b = [0, 2];