インコの技術メモ
Perl
■ ハッシュ&配列を再帰的に文字コード変換
use Encode;
use Storable qw(store dclone);
sub _hash_2_utf8 {
my $self = shift;
my $hash = dclone($self);
if(ref($hash) eq 'HASH'){
for my $key(keys(%$hash)){
Encode::from_to($hash->{$key},'EUC-JP','UTF8') unless ref($hash->{$key});
$hash->{$key} = &_hash_2_utf8($hash->{$key}) if ref($hash->{$key});
}
}elsif(ref($hash) eq 'ARRAY'){
my $i=0;
foreach my $item (@$hash) {
Encode::from_to($hash->[$i],'EUC-JP','UTF8') unless ref($hash->[$i]);
$hash->[$i] = &_hash_2_utf8($hash->[$i]) if ref($hash->[$i]);
$i++;
}
}
return $hash;
}
■ かんたんなMySQLのプログラム
#!/usr/bin/perl
use strict;
use DBI;
use Data::Dumper;
my $dsn = "DBI:mysql:dbname:hostname";
my $dbUser = "username";
my $dbPass = "password";
my $dbh = DBI->connect($dsn, $dbUser, $dbPass);
# $dbh->do("SET NAMES sjis");
# ■ 検索
my $rows = $dbh->selectall_arrayref("SELECT * FROM hoge LIMIT 3", { Columns => {} });
# ■ 挿入
# my $query = "INSERT INTO hoge set hoge_id = '1'";
# my $rows = $dbh->do($query);
# ■ 更新
# my $query = "UPDATE hoge set hoge_value = 'xxxx' where hoge_id=1";
# my $rows = $dbh->do($query);
print "content-type: text/plain\n\n";
print "HHHHHHHHHHHHHHHHHHHH\n";
print Dumper $rows;
exit(0);
exit;
■ CPANのftp先
確認
o conf urllist
削除
o conf
o conf urllist pop 削除したい url名
o conf commit
追加
o conf
o conf urllist push 追加したい url名
o conf commit
■ プログラムの一時停止
１秒停止（秒単位）
sleep(1);
1.25秒停止（ミリ秒単位）
select(undef,undef,undef,1.25);
■ centos5 perl Image::Magickのインストール
↓これが一番簡単。
yum install ImageMagick-perl
■ PHPのerror_log()をPerlで
ソースの頭に以下を記述。
use Data::Dumper;
ソースのどこかに以下を記述。
sub _elog {
my $line = shift;
my $file = "/home/hoge/logs/elog";
open(OUT,">> $file");
print OUT Dumper($line);
close(OUT);
}
使いたいところで以下を記述。
&_elog("-------------------- 行数など --------------------");
&_elog($hoge);
リアルタイムで見る。
tail -f /home/hoge/logs/elog
■ ackの使い方
grep のPerl版です。非常に見やすい。
インストール
# cpan
cpan> install App::Ack
cpan> exit
普通に検索(絶対パス指定で再帰的に)
ack -w "hoge" /home/hoge/lib
前後3行も表示
$ ack -C3 -w "hoge"
ファイルだけ一覧
$ ack -l "hoge"
条件とマッチしない
$ ack -L "hoge"
■ CPANのフォースインストール
cpan -f Data::FormValidator
■ とりあえず入れておくもの
cpan> install Bundle::LWP
cpan> install Bundle::CPAN
cpan> install Crypt::SSLeay
cpan> reload CPAN
■ LWP::UserAgentで壷にはまる。
これ使っても'_rc' => '404',になる。
原因=ネームサーバの準備が出来てなかったので、ローカルのhostsに書いてテストしてたんだけど、サーバーの方はなにもしてなかったので、LWPとかで見に行くとき普通にこけてた。
サーバーのhostsにも名前解決を書き込んでやる。ネームサーバの設定が終わったら直しとくこと。
■ 変数の後ろに文字列をくっつける
「$model」の後ろに「_trace_」をくっつけたい場合。
my $name = qq|$model\_trace_|
qq{ }はダブルクォーテーションと同じ。{ }は他の非英数文字でも良い。
■ 正規表現でマッチしたものを抜き出して配列に格納
my @fid = $contents_i =~ m{fids\:(\d+\.(?:swf|3g2|3gp))\:fide}g;
■ 配列で重複しているものを削除
my %dup;
@fid = grep {!$dup{$_}++} @fid; #重複削除
■ リファレンスのマージ
[
'aaa@aaa.jp',
'0'
]
[
'bbb@bbb.jp',
'0'
]
みたいな配列のリファレンスで、多い方に少ないほうをマージするんだけど、$_->[0]が重複するやつは小さいほうを採用したい。
# ハッシュに変換して有効にしたい方を後から被せる
my %h1=();
for (@$mail_all){ $h1{$_->[0]}=0; }
for (@$mail_mon){ $h1{$_->[0]}=$_->[1]; }
# もとの形(配列のリファレンス)に戻す
my @rows;
foreach ( keys %h1 ) {
my $data_r;
$data_r->[0]=$_;
$data_r->[1]=$h1{$_};
push (@rows, $data_r);
}
my $rows=\@rows;
■ 固定長 頭 ゼロ埋め スペース埋め
my $num2 = sprintf( "%08d", $num1 ); # 8ケタ頭ゼロ埋め my $num2 = sprintf( "%.2f", $num1 ); # 小数点2ケタ my $str2 = sprintf( "%16s", $str1 ); # 頭半角スペース埋め
■ swfをバイナリで書き換えて表示・保存
#!/usr/local/bin/perl
use Data::Dumper;
# ファイルのパスとサイズ取得
my $swffile="../public_html/test.swf";
my $size = -s $swffile;
# 基ファイルの取得
open(IN, $swffile);
binmode(IN);
sysread(IN, $buf1, $size);
close(IN);
# 編集可能な状態へ
@data1 = unpack("H*", $buf1);
# 編集箇所はあらかじめ調べておかないといけません
$data1[0] =~ s/61626162/65656565/;
# 保存可能な状態へ
my $buf2 = pack("H*", @data1[0]);
# ブラウザで出力する場合
#print "Content-type: application/x-shockwave-flash\n\n";
#print $buf2;
# 複製する場合
my $outfilename='../public_html/test02.swf';
open(OUT,"> $outfilename");
print OUT $buf2;
close(OUT);
print "Content-type: text/html; charset=Shift_JIS\n\n";
print "変換完了";
exit(0);
■ LWP::Simple
バーチャルホスト立てた＆ＤＮＳ設定前に繋がるかどうかだけ見たり、ヘッダー情報を見てみたり。
perl -MLWP::Simple -e 'getprint "http://tomosuma.net/";'
perl -MLWP::Simple -e 'print get("http://tomosuma.net/")'
perl -MLWP::Simple -e 'print head("http://tomosuma.net/")'
■ Dumperでの大カッコ中カッコ
print Dumper $self->Value;
$VAR1 = [
{
'aaa' => '1',
'bbb' => '2',
'ccc' => '3',
'ddd' => '4',
'eee' => '5',
'fff' => '6'
}
];
↓
print Dumper $self->Value->[0]->{aaa};
$VAR1 = '1';
■ クラスの宣言
use CGI qw/:standard/; #useを忘れないようにね
my $q = new CGI;
■ クラスの宣言のところ
呼ぶ
my $dbsousa = new DBSousa;
呼ばれる
sub new {
my $class = shift;
my $self = {};
bless $self,$class;
return $self;
}
newの引数にはDBSousaが入っている。
my $class = shift → my $class = shift @_ → @_の中は[DBSousa,,,]
■ ' と "
''でくくった中の文字列：変数展開しない
""でくくった中の文字列：変数展開できる
■ @listの要素を表示
foreach (@list){
print "$_\n";
}
■ @listの要素をソートして表示
foreach (sort(@list)){
print "$_\n";
}
■ @listの要素を逆順に表示
foreach (reverse(@list)){
print "$_\n";
}
■ 数値としてソートする（順番、逆）
@list = sort{$a<=>$b}@list
@list = reverse(sort{$a<=>$b}@list)
■ 文字の置換え
文字列全体 =~ s/置換前/置換後/;
例）
#!/usr/bin/perl
$str = "He and I like cake and candy\n";
$str =~ s/and/AND/;
print $str;
$str = "He and I like cake and candy\n";
$str =~ s/and/AND/g;
print $str;
$str = "He and I like cake and candy\n";
$str =~ s/\band\b/AND/g;
print $str;
（実行結果）
He AND I like cake and candy
He AND I like cake AND cANDy
He AND I like cake AND candy
例２）\ を / に置換
$parsename =~ s#\\#/#g;
■ 区切り文字で区切られた文字列をリストに変換する
split(/区切り文字/, 文字列)
■ stat lstat
例）
C:\temp>type test.pl
$line = "a,b,c,d,e"; #コンマ区切り
@array = split(/,/, $line);
print "３つ目の要素は", $array[2],"です。\n";
C:\temp>perl test.pl
３つ目の要素はcです。
C:\temp>
stat の返却値
要素 意味
0 ファイルシステムのデバイス番号
1 i ノード番号
2 ファイルのモード
3 ファイルへのハードリンク数
4 ファイル所有者のユーザID
5 ファイル所有者のグループID
6 特殊ファイルのデバイス識別子
7 ファイルのサイズ（バイト単位）
8 最終アクセス時刻
9 最終変更時刻
10 最終 i ノード変更時刻
11 標準のファイルシステム入出力時の標準ブロックサイズ
12 ファイルに割り当てられてりるブロック数
■ ファイルの行数を調べる方法■
(1) 一行ずつ読み込む方法。
for ($i = 0; $i <= $#files; $i++) {
open(READ, "$files[$i]");
$data[$i][0] = $files[$i];
$data[$i][1] = 0;
while (<READ>) {
# 最初の行だけ記録する
if ($data[$i][2] eq '') { $data[$i][2] = $_; }
$data[$i][1]++;
}
close(READ);
}
(2) ファイルの内容を一度に読み込み、改行の数で行数を判定する方法。
for ($i = 0; $i <= $#files; $i++) {
open(READ, "$files[$i]");
$data[$i][0] = $files[$i];
read (READ, $str, (-s "$files[$i]"));
$data[$i][2] = substr($str, 0, index($str, "\n"));
$data[$i][1] = ($str =~ s|\n||g);
close(READ);
}
(3) ファイルの内容を一度に配列に読み込む方法。
for ($i = 0; $i <= $#files; $i++) {
open(READ, "$files[$i]");
$data[$i][0] = $files[$i];
@str = <READ>;
$data[$i][1] = $#str + 1;
$data[$i][2] = $str[0];
close(READ);
■ 特殊配列 @ARGV
@ARGV にはコマンドラインでスクリプトを実行したときの，スクリプトより後ろの引数のリストが収められている。配列 @ARGV を使うと，値をコマンドラインから直接スクリプトに渡すことができる。例えば次のようにコマンドラインから Perl を起動すると，
% perl script/merge.pl data/nihongoA.cha data/nihongoB.cha
実行中の merge.pl の @ARGV の値は ("data/nihongoA.cha", "data/nihongoB.cha") となっている。各要素には $ARGV[0], $ARGV[1] でアクセスできるので，次のようにスクリプト中でファイルを指定していたものも，
script/merge.pl
--------------------------------------------------
$fileA = "data/nihongoA.cha";
$fileB = "data/nihongoB.cha";
--------------------------------------------------
次のように書き換えることで，スクリプト自体は変更せずに，処理するファイルをコマンドラインから指定できるようになる。
--------------------------------------------------
$fileA = $ARGV[0];
$fileB = $ARGV[1];
--------------------------------------------------
■ ?:
@a = @b unless @a; #@aが空なら@bを@cにコピーする。
@a = @b ? @b : @c; #@bが空でなければ@bを、空なら@cを@aにコピーする。
■ TestSimpleとかMoeとか
確認はコマンドラインでないとできませんよ。
C:\Perl\bin>perl C:\Perl\test\TestSimple.cgi
C:\Perl\bin>perl C:\Perl\test\TestMore.cgi
あと「テストは間違っている時もある」だそうです。
■ 文字の結合
"cheese" . "cake" # "cheesecake"
"apple" x 3; # "appleappleapple"
■ 二項代入演算子
$hoge = $hoge + 3 のようにイコール記号の左右に同じ変数が現れる
ような式を簡潔に書くための短縮形を二項代入演算子という。
二項演算子*1の後ろにイコール記号を付けて表す。
下の各2行は全て等価
$hoge = $hoge + 3;
$hoge += $3;
$hoge $hoge ** 2;
$hoge **= 2;
$hoge = $hoge . "\n";
$hoge .= "\n";
これらの場合、代入というより加工という感じがする。
■ ブール値
Perlにはブール型（trueとfalse）というものがないらしい。
代わりに次のような規則を使って判定を行う。
1. 特別な値 undef は偽
2. 数値の0は偽、それ以外の数値は真
3. 空文字は偽、通常、それ以外の文字列は真
4. 文字列の'0'は数値の0と同じなので、偽
if ( true ) と if ( false ) はどちらも真*1になるので注意。
trueもfalseも文字列として判定されるから。
■ qwショートカット
Perlでは、シングルクォートやらカッコやらを省略してリスト値を記述する方法が用意されている。下の二つは全く同じ。
('apple', 'orange', 'grape', 'banana')
qw/ apple orange grape banana /
■ リストと配列
リストとは、スカラーの集合に順序をつけて並べたもの。
配列とは、リストを保持する変数のこと。
■ 配列のループ
foreach $hoge (qw/ NY LA MA /) {
print "$hoge\n";
}
結果
NY
LA
MA
■ スカラー、リスト
@people = qw( fred barney betty );
@sorted = sort @people; # リストコンテキスト
$number = 5 + @people; # スカラーコンテキスト
print "@sorted\n";
print "$number\n";
結果
barney betty fred
8
■ $_
foreach (1..10) {
print;
}
12345678910と表示される。cntとしても使えるわけだ。
■ サブルーチンの戻り値
最後にしたナニカを返すわけだけども、例えば最後の行がprint "終わったです。\n;だとした場合。
結果は１が返ってきます。
表示に成功しましたですよ、という意味の１らしいです。
■ サブルーチンと引数
sub max {
if ($_[0] > $_[1]) {$_[0];}
else {$_[1];}
}
$a = 41;
$b = 58;
@c = ($a, $b);
$hoge = &max(41, 58);
$mage = &max($a, $b);
$hige = &max(@c);
print "大きいのは$hogeです。\n";
print "大きいのは$mageです。\n";
print "大きいのは$higeです。\n";
結果
大きいのは58です。
大きいのは58です。
大きいのは58です。
$hoge = &max(45,32,69); # 69は無視
$sage = &max(28); # 2番目の引数はundef
print "$hoge\n";
print "$sage\n";
結果
45
28
-オプションを指定している場合、undefを比較に使うと警告が出る。
自分の@_を失うことなしに、別のサブルーチンに引数を渡せる。
■ コメント
# から後ろがコメント
=pod
この間がコメント
=cut
■ レキシカル変数
前にmyがついたやつ。
ローカル変数だと思いねぇ。（Perlの世界では厳密に言うと違うらしいけど）
perlではデフォルトで、全ての変数はプログラム中のどこからでもアクセスできるグローバル変数になっている。
myを使って宣言すると初めてルーチン内のプライベートが守られる。
localを使って宣言する方法もあり、それは完全にはプライベートが守られないそうです。
ややこしいので忘却するとす。
■ return
ほかの言語ではサブルーチンの終わりに置いて戻り値を返すために使う。
Perlでは何もしなくても、最後に評価された式の結果がreturnを使ったかのように、戻り値として返される。
ではなぜreturnがあるのか。一見あってもなくてもいいように思う。
けど、サブルーチンの途中で、値を返したい時もあるはず。
そういう時はreturn演算子を使う。
return演算子は、即座に値を返し、サブルーチンを抜ける。
■ プラグマ
プラグマとは、コードの扱いに対して、コンパイラに与えるヒントのようなもの。
例えば、
use strictプラグマは、全ての新しい変数はmyで宣言しなければならないとか。
use strictを指定すれば、変数名のタイプミスを防ぐことができるし、myで宣言することで、変数の有効範囲を限定して、プログラムのどこに間違いがあるかを、見つけやすくなる。
■ ブラウザーでのテスト
print "Content-type:text/html\n\n";
print "正常終了 ＿|?|○";
を必ずつけておこう。
ブラウザーが何もできなくてこけます。→Premature end of script headersとか
■ 現在時刻
my ($ss, $mn, $hh, $dd, $mm, $yy) = localtime(time);
$yy += 1900;
$mm++;
my $dttm = sprintf("%04d.%02d.%02d %02d:%02d:%02d", $yy, $mm, $dd, $hh, $mn, $ss);
↓
2006.03.30 17:31:03
■ 値に改行コードを含む CSV形式を扱う
while (my $line = <DATA>) {
$line .= <DATA> while ($line =~ tr/"// % 2 and !eof(DATA));
$line =~ s/(?:\x0D\x0A|[\x0D\x0A])?$/,/;
@values = map {/^"(.*)"$/s ? scalar($_ = $1, s/""/"/g, $_) : $_}
($line =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
# @values を処理する
}
■ ソート
# 数字昇順
@BB=sort{$a <=> $b}@AA;
# 数字降順
@BB=sort{$b <=> $a}@AA;
# 文字列昇順
@BB=sort{$a cmp $b }@AA;
# 文字列降順
@BB=sort{$b cmp $a }@AA;
■ 条件文
(1) if (条件式) {実行文}
(2) if (条件式A) {実行文A} else {実行文B}
(3) if (条件式A) {実行文A} elsif (条件式B) {実行文B} ... else {実行文x}
■ モジュールのインストール
C:\>cd perl\bin
C:\Perl\bin>ppm
ppm>install data-formvalidator
てな感じ
■ Config::Simple
テキストファイルからハッシュ（連想配列変数）をつくる。
a.txt
name1 : hoge1
name2 : hoge2
name3 : hoge3
name4 : hoge4
a.cgi
#!c:/perl/bin/perl
use Config::Simple;
Config::Simple->import_from("properties.txt", \%Config) or
die Config::Simple->error();
print "Content-type:text/html\n\n";
print "<html><head><meta http-equiv=\"content-type\" content=\"text/html;charset=Shift_JIS\">\n<title>Perlテスト< /title></head><body>";
print "へ(-。-)ノ";
print \%Config; print "";
print $Config{'name1'}; print "";
print "</body></html>";
exit;
↓
へ(-。-)ノ
HASH(0x275d04)
hoge1
■ myでの宣言
my $a; #１つのとき
my ($a, $b); #複数まとめて
my (@a, %b); #混在も可
my $a = 123; #宣言と同時に値を入れる
右辺が配列
@a = ("apple", "banana", "orange");
my $a = @a; #3（要素数）が入る
my ($a) = @a; #apple（一つ目の要素）が入る
my @a = (1, 2, 3); #まんま入る
右辺がリスト
my $a = ("apple", "banana", "orange");#orangeが入る
my ($a) = ("apple", "banana", "orange");#appleが入る
■ BEGIN END
BEGIN { 処理 } Perl がスクリプトが読み込むときに一度だけ「処理」が実行される。
END { 処理 } Perl が終了する直前に一度だけ「処理」が実行される。
■ defined
未定義で空白なのか、空白が設定されているのかを区別する。
定義済みの場合は"真"、未定義の場合は"偽"を返します。
if,while文などでは空白や0は偽として処理されるが、undefじゃなければ真にしてくれる。
■ マッチ
=~ 左が右に有るか無いか
yes =~ /yyyyessss/ #どこにyseがあっても良い
yes =~ /^yessss/ #前にyesが無いとダメ
yes =~ /yyyyes$/ #後ろにyesが無いとダメ
■ 変数とか
$ スカラー変数、数字とか文字とか単体
@ 配列変数。添え字つきのスカラー変数。
% 連想配列変数。ハッシュ。添え字が文字の配列。
& サブルーチン
\$ \@ \% \&
前に\がつくとそのアドレス。スカラー変数に代入できる。リファレンス。
このリファレンスを指し示すだけで参照代入、実行できたりするので色々使います。
■ 配列、ハッシュ、無名ハッシュの値
代入、或いは初期化。
@week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
@week = qw(Sun Mon Tue Wed Thu Fri Sat);
基本は上、qwはスペースを区切りとする、という機能を利用して代入したもの。
んで、１つ１つの要素の表示は
print $week[0],$week[1],$week[2],$week[3],$week[4],$week[5],$week[6];
０?６で７つね。
ハッシュは
%hash = ('結城博' => 36,'佐藤花子' => 22,'とむら' => 21,'高橋マモル' => 22);
print $hash{'結城博'},$hash{'佐藤花子'},$hash{'とむら'},$hash{'高橋マモル'};
添え字（添え文字）は配列が[]でハッシュが{}。
{}の中の''は有っても無くても良いようです。ある方が良いかな。
配列の全内容は添え字順にならんでるけど、ハッシュの方はバラバラです。添え文字のアイウエオ順と言うわけではないらしいです。
あと無名ハッシュ
$hash = {'結城博' => 36,'佐藤花子' => 22,'とむら' => 21,'高橋マモル' => 22};
$hashにはリファレンス（アドレス）が入ります。
だから値を見るときには
print "$$hash{'結城博'}";
■ リファレンスとは
値の格納されているアドレス。
変数に値が代入されたとき、その場所にはディスク上のどの位置にかかれているかという一片の情報と代入された値が記録される。
例えば、
$a = 4;
としたとき、$aには4という値と、それが書かれたアドレスが記憶される。
単純な使用方法ではアドレスが表に出ることは無いが、値が大きくなったり、複雑なデーター構造を使用したいときにはこのアドレスが使われる。
例えば、配列。
Perlでは配列は１次配列しかない。
２次配列を使用したければ、一時配列のアドレスを配列に持つことによって実現できる。
以下はその例。
#!c:/perl/bin/perl
#use strict;
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
print "Content-Type: text/html;charset=Shift_JIS\n\n";
@a = qw(1 2 3 4 5 6);
@b = qw(7 8 9 1 2 3);
$c[0] = \@a;
$c[1] = \@b;
print Dumper($c[0]),"";
print Dumper($c[0][1]),"";
print $c[0],"";
print $c[0][1],"";
print \$c[0],"";
print \$c[0][1],"";
↓
$VAR1 = [ '1', '2', '3', '4', '5', '6' ];
$VAR1 = '2';
ARRAY(0x275ca8)
2
REF(0x1627f40)
SCALAR(0x274fd0)
■ リファレンスの生成
前に\をつけて代入する。（\はバックスラッシュと言う時もある）
# 配列
$ref_array = \@list;
# ハッシュ
$ref_hash = \%hash;
# 関数
$ref_sub = \⊂
# グロブ
$ref_glob = \*glob;