PERLメモ

仕事柄、しょっちゅういろんなCGIを書きます。そんな中でしょっちゅう使う小物をメモしています。
「車輪を再開発するな」「プログラマの 3 つの美徳は、無精、短気、傲慢」をモットーにコピペで使えるものを書き留めています。
僕の癖が強いものもありますがご容赦を。
KAIN = HIROKI KAGAMOTO

目次

２配列によるチェック

@FileBにあって@FileAにないものを@deffに集めろ 
@deff = grep{ !{map{$_,1}@FileA }->{$_}}@FileB;

ソート

組み込みのソート関数をそのまま使うと、文字列のソートになったりします。
同じ桁数のものは問題ないのですが、えてしてそうはいかないものです。
perlは文字と数値を暗黙に変換しますが、それが仇になる場合もあります。
ここでは明確に文字列と数のソートを記します。 
# 数字昇順
@BB=sort{$a <=> $b}@AA;

# 数字降順
@BB=sort{$b <=> $a}@AA;

# 文字列昇順
@BB=sort{$a cmp $b }@AA;

# 文字列降順
@BB=sort{$b cmp $a }@AA;
まぁ @BB=sort{$b cmp $a }@AA; と書かなくて
@BB= reverse sort{$a cmp $b }@AA; でもいけますが
関数からできた配列を関数へまた渡すより効率はいいのでこっちを使ってます。

リストシャッフル

配列をトランプをきるかのように混ぜて返す。
これは意外と難しい。もっとも効率の良いと思われるものが以下のものである。 
sub Shuffle{
    BEGIN{srand}
    my @OUT;
    push @OUT,splice @_,rand @_,1 while @_;
    return \@OUT;
    }
# 返値はリファレンス
返値はリファレンスには意味がある。
巨大な配列を配列のコピーで返してしまうとかなり処理的に時間がかかる。このルーチンでは受け取った配列をそのまま使って新しい配列を作りその配列のリファレンスを返すことによって不要な配列がメモリーを占領しコピーが行われることを防いでいる。 
# 使い方 上記 sub Shuffle は定義済みとする
# テスト用のデータを用意
@test="a".."z"; 

print @{&Shuffle(@test)};

CGIにおけるリダイレクト処理

CGIで処理後の定型のページをCGIで書き出すのはこうりつが悪い上に変更もしにくい。
動的処理ではない定型のものはHTMLで書かれるべきです。
このルーチンは処理後特定のページへ飛ばすものです。
sub redai{
    my $urlz=shift;
    print "Location:$urlz\n\n";
    exit;
    }

# 使い方
&redai('http://tech-web.net/');

ディレクトリーの一覧を習得したい

今データを格納しているサーバー上のディレクトリーのファイル名たちを参照したいときがある。
例えば、テキストファイルの一覧を@TxtFileに代入したい等。 
@txtfile=glob "*txt";
しかし、かったるいのでファイルハンドルのおもしろい特製を利用して簡単に書きたい。
# txtファイルをもってこい
@txtfile=<*txt>;

# すべてのファイルをもってこい
@txtfile=<*>;

# 上位ディレクトリーのすべてのファイルをもってこい
@txtfile=<../*>;

ファイルを一気にスカラーに読み込みたい

通常ファイルを読み込んで処理する場合、一行一データであることが多いため
open(FILE,"hoge.txt");
chomp(@dat=<FILE>);
で@datにきれいに一行ずつの配列となったわけですが、一つのスカラーにまとめるとなると
open(FILE,"hoge.txt");
chomp(@dat=<FILE>);
$file=join "\n",@dat;
と無駄な書き方をしてみたりしたくなっちゃいます。だるいのでもっと簡単にやっちゃいましょう。
$/="";
open(FILE,"hoge.txt");
$file=<FILE>;
これで中身が一気に$fileに入りました。
気をつけなくては成らないのは $/=""; はすべてに影響しますので
{
    local $/="";
    open(FILE,"hoge.txt");
    $file=<FILE>;
}
としたほうがよろしいかも。サブルーチンや分岐のブレース(→{})内だけlocal化してみる。これはmyでは無い事に注意。
ちなみに例の何もないブレースは「一回だけ繰り返せ」の意味。

ファイルからランダムに一行出す

おみくじや占いを作るのに重宝する。 
open(FILE,"hoge.txt");
srand;
rand($.) < 1 && ($line = $_) while <FILE>;

全ての変数名を表示する

デバックにどんな変数名を使ってきたらみたい時がある。
今使いっている全ての変数を見れたらどんなに便利だろう…。
パッケージのシンボルテーブルは、パッケージ名に :: をつけたハッシュに格納される。だったらグローバル変数とされる%mainを読めば変数名が取れるんじゃないか。…と考えた。 
foreach my $k (sort keys %main::) {print "$k = $$k@$k%$k","\n" ;}
まだ未完だが、まぁつかえる?かな。
※実はスカラー変数ってオンザフライ(その場で)作る事ができる。$$kはその応用。

その場でスカラー変数を作る

※実はスカラー変数ってオンザフライ(その場で)作る事ができる。 
$WW='test';
$$WW='あーてすてす。';
print $test,"\n";

${$WW}='これもいっしょの動きをする。';
print $test;
コレはスカラー値も実は無名ハッシュになっている事の応用だったりする。
BadEffectiveだけどこんなんもできる。(無意味なので実際には使わないけどね) 
require "cgi-lib.pl"; &ReadParse;
for(keys %in){${$_}=$in{$_};}
# 受け取ったhtmlフォームからCGIへの変数においてnameの変数にvalueを代入している。
まぁよく%inを代入しなおしているCGIを見かけますが、無意味というか変数Copyにもプログラム的コストが化かかかっているのでよしたほうがいいです。

ハッシュのキーでソート

ハッシュデータをソート使いたい。まぁ配列に似た処理ができるわけです。
@keys=sort keys %hash;
使い方としては、キーにtimeとかが入ったデータを順番に処理したい・・・とかは 
@hash{1..9}=a..i;   # テストデータを作成
 
for(sort keys %hash){
    print "$_ = $hash{$_} \n"
    };
でも実際単純ソートは文字列ソートなので、数値的ソートを考えると 
@hash{1..9}=a..i;   # テストデータを作成
 
for(sort { $a <=> $b } keys %hash){
    print "$_ = $hash{$_} \n"
    };

ハッシュのキーと値を交換する(値が重複してはならない)

ハッシュのキーと値はひょいっと交換できるが値が重複していないことが前提となる。 
%hashB = reverse %hashA;
でも値が重複しているのを逆に利用してみる…!?

2つのハッシュをまとめる最も効率の良い方法。またはハッシュの更新

更新されていない値はそのまま残して、古いハッシュに新しいハッシュを上書きしたい。 
@Hash{A..Z}=a..z;
@NewHash{1..9}=1..9;

@Hash{ keys %NewHash }= values %NewHash; # ハッシュの上書き

for(keys %da){print "$_ = $da{$_}\n"}
@hash{1..9}=a..i;   # テストデータを作成
for(sort keys %hash){print "$_ = $hash{$_} \n"};

ハッシュの値でソート

ハッシュのキーでソートは楽なんですが、プログラムをいろいろやっていくうちにぶち当たる需要としてハッシュの値でソートがある。 
@keys = sort { $hash{$a} cmp $hash{$b} } keys %hash;

# 使い方の例
# %hash=("ああ" => 789,"いい" => 456,"うう"=> 123);
# @keys=sort {$hash{$a} cmp $hash{$b}} keys %hash;
# print @keys;
これは意外と超便利だったりします。

配列の一つごとの数値フィールドを指定しそれを比較してソートした配列を返す

何のことかわかりにくいのですが、これが必要になってくるんですよ。
ＣＳＶ等のカンマ区切りの何番目かのデータでソートしたい等、需要はいっぱい。 
sub Fsort{
    my $spritkey=shift;
    my $field=shift;
    my @in=@_;
    my @out;
    @out=map{$_->[0]}sort{$a->[1]<=>$b->[1]}
    map{[$_,(split /$spritkey/)[$field]]}@in;
    return \@out;} 

# 使い方
# @{&Fsort(区切り文字,フィールド番号,@配列)};
# フィールド番号は０からカウントね。

数字に３桁ごとのカンマを入れちゃう

物販システム(バスケットシステム)なんかつくってるとしょっちゅう使うものです。 
sub keta{
    my $yen=shift;
    1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;
    return \$yen;
    }
返値をリファレンスにしているのがミソ(return \$yen;)。この使い方が最強。
また@_なんか使って直接変数内を書き換えないのもポイント。表示するときだけカンマを打ちたいだけなのでね。使い方は…。 
sub keta{
    my $yen=shift;
    1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;
    return \$yen;
    }

$ONEDAN=19800;
print "この値段は￥${&keta($ONEDAN)}-.";
このやり方だと通常は無理な関数のダブルクォート内展開ができるんですな。

配列の最後の値をとりたい

まぁぱっと思いつくのは 
@test=1..10;
print $test[$#test];
なんですが、添字にマイナスを入れると最後から数えるのを利用して 
@test=1..10;
print $test[-1];
とかもできます。

カレンダーを作る

万年カレンダーを作ります。Blogとかに使ってます。 
print ${&Calendar(2003,8)};

# カレンダーの素
sub calc{
    my $year1=shift;
    my $month1=shift;
    my @days;my $i;
    $ENV{'TZ'}='JST-9';
    my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst)=localtime(time);
    my $uru1=int($year1/4)-int($year1/100)+int($year1/400);
    my $uru2=int(($year1-1)/4)-int(($year1-1)/100)+int(($year1-1)/400);
    my $uru=$uru1-$uru2;my $yzure=(($year1+$uru2)%7)+0;
    my @monthzure=(0,0,3,3,6,1,4,6,2,5,0,3,5);
    my $mzure=$monthzure[$month1];
    $mzure=$mzure+$uru if($month1 >2);
    my $zure=(($mzure+$yzure) % 7);
    my @monthday=(0,31,28,31,30,31,30,31,31,30,31,30,31);
    $monthday[2]=$monthday[2]+$uru;
    for($i=1;$i<=$zure;$i++){ #>
    push(@days,' ');
        }
    for($i=1;$i<=$monthday[$month1];$i++){ #>
    $i=' '.$i if $i<10; #>
    push (@days,$i);
        }
    return \@days;
    }


# カレンダー生成
# ${&Calendar(2003,8)};

sub Calendar{
    my $Yr=shift;
    my $Mn=shift;
    my @CALENDER=@{&calc($Yr,$Mn)};
    my $TodayZ;
    my ($Da,$Mo,$Ye)=(localtime(time))[3,4,5];
    $Mo++;
    $Ye+=1900;
    my $LINK=$0.'?C='.$Yr.'-'.$Mn.'&D=';
    my $Flag=0;

my $Calendar=<<__HTML__;
<TABLE border=0 cellspacing=0 cellpadding=0>
<TR><TD>${Yr}年${Mn}月
<TABLE border=0 cellspacing=1 cellpadding=1>
<TR>
<TD ALIGN="center"><FONT size="2" COLOR="red">日</FONT></TD>
<TD ALIGN="center"><FONT size="2">月</FONT></TD>
<TD ALIGN="center"><FONT size="2">火</FONT></TD>
<TD ALIGN="center"><FONT size="2">水</FONT></TD>
<TD ALIGN="center"><FONT size="2">木</FONT></TD>
<TD ALIGN="center"><FONT size="2">金</FONT></TD>
<TD ALIGN="center"><FONT size="2" COLOR="blue">土</FONT></TD>
</TR>
<TR>
__HTML__

while(@CALENDER){
    $Calendar.="</TR><TR>\n" and $Flag=0 if $Flag eq 7;
    my $DAYX=shift @CALENDER;
    $DAYX=~s/\s//g;
    if(($Yr eq $Ye)&&($Mn eq $Mo)&&($DAYX eq $Da)){
        $Calendar.=q{<TD ALIGN="center" bgcolor="#80ff80">};
    }else{
        $Calendar.=q{<TD ALIGN="center">};
        }

if($DAYX){
    $Calendar.='<A HREF='.$LINK.$DAYX.'>';
if($Flag eq 0){
        $Calendar.=q{<FONT COLOR="red">};
        }elsif($Flag eq 6){
        $Calendar.=q{<FONT COLOR="blue">};
        }else{
        $Calendar.=q{<FONT COLOR="black">};
    }
    $Calendar.=$DAYX;
    $Calendar.=q{</FONT>};
    $Calendar.=q{</A>};
    }else{
    $Calendar.='　';
    }
$Calendar.='</TD>';
$Flag++;
}
my $CNT=7-$Flag;
$Calendar.='<TD>　</TD>'x$CNT;
$Calendar.='</TR></TABLE>';
$Calendar.='</TD></TR></TABLE>';
return \$Calendar;
}
英数以外を除去
tr/0-9a-zA-Z//cd;

# 英数と_以外を除去
tr/\w//cd;
環境変数を表示する
for(sort keys %ENV){print $_.'='.$ENV{$_}."\n";}
間でらんだむ(文字の間もOK)
sub between_rand{
my $AA=shift; my $BB=shift; my @LIST=$AA..$BB;
return @LIST[int(rand($#LIST+1))];}
数字$yenに３桁ごとのカンマを入れちゃう
sub keta{
my $yen=shift;
1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;
}
同じディレクトリーのファイル名を拾得
$TEST=<*.html>;
@TEST=<*.html>;
print $TEST;
for(@TEST){print $_."\n";}
配列の一つごとの数値フィールドを指定しそれを比較してソートした配列を返す
# CSV等のカンマ区切りの何番目かのデータでソートしたい等に
# $スカラー='フィールドの区切りもじ';
# @{&Fsort($スカラー,フィールド番号,@配列)};
sub Fsort{
my $spritkey=shift;
my $field=shift;
my @in=@_;
my @out;
@out=map{$_->[0]}sort{$a->[1]<=>$b->[1]}
map{[$_,(split /$spritkey/)[$field]]}@in;
return \@out;}
配列を逆順
@BB = reverse @AA;
複数のファイルに特定のpatternという文字列があるか検索
while(<>){
if (?pattern?){print "found in $ARGV\n";}
} continue {reset if eof;}
文字列反転
$BB = reverse $AA;
10進16進数変換
sprintf,hexを使うと簡単です。10進数を16進数に変換したいときは、

$a = 255;
$a = sprintf "%X", $a;

とやると、$a には 255 が入ります。
また反対に、16進数を10進数に変換したいときは、

$a = hex $a;

です。
2値間のランダムを返す
print &between_rand(5,4);
sub between_rand{my @LIST=$_[0]..$_[1];return @LIST[rand($#LIST+1)]}
URL形式　文字列をエンコードとデコード
sub URLe{my $URLencode=shift;
$URLencode=~s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;
$URLencode=~s/\s/+/g;
return \$URLencode;}

sub URLd{
my $URLdecode=shift;
$URLdecode=~tr/+/ /;
$URLdecode=~s/%([a-fA-F0-9]{2})/pack("C",hex($1))/eg;
return \$URLdecode;}
localtime(time)の逆
> localtime(time)　という関数による1970年からの秒数を日付に変換できるが、
> その逆、任意日付を秒数に変換したい場合、どうすれば？

use Time::Local;
$time = timelocal($sec, $min, $hours, $mday, $mon, $year);