Perl に関する Tips


リファレンス本

  • CGI&Perlポケットリファレンス - 技術評論社
    • 雑多な並べ方だが、他に良いものが見つからなかった。
  • HTML&XHTML&CSS辞典 - 秀和システム
    • 必須でしょー。
    • とりあえずHTML4.01とCSS2.1に対応すべく

CPAN モジュールをインストールする

  • Perlにはモジュールインストール機能があるみたい。
    perl -MCPAN -e shell
    install <MODULENAME>
  • CentOSではyumでいろいろ探せるから、そっちからインストールした方がスマート?
    • CentOS 6系では「とりあえずメジャーどころ」がまとめられている perl-core
      perl
      perl-Archive-Extract
      perl-Archive-Extract
      perl-Archive-Tar
      perl-CPAN
      perl-CPANPLUS
      perl-Compress-Raw-Bzip2
      perl-Compress-Raw-Zlib
      perl-Compress-Zlib
      perl-DBD-SQLite
      perl-DBI
      perl-DBIx-Simple
      perl-Digest-SHA
      perl-ExtUtils-CBuilder
      perl-ExtUtils-Embed
      perl-ExtUtils-MakeMaker
      perl-ExtUtils-ParseXS
      perl-IO-Compress-Base
      perl-IO-Compress-Bzip2
      perl-IO-Compress-Zlib
      perl-IO-Zlib
      perl-IPC-Cmd
      perl-Locale-Maketext-Simple
      perl-Log-Message
      perl-Log-Message-Simple
      perl-Module-Build
      perl-Module-CoreList
      perl-Module-Load
      perl-Module-Load-Conditional
      perl-Module-Loaded
      perl-Module-Pluggable
      perl-Object-Accessor
      perl-Package-Constants
      perl-Params-Check
      perl-Parse-CPAN-Meta
      perl-Pod-Escapes
      perl-Pod-Simple
      perl-Term-UI
      perl-Test-Harness
      perl-Test-Simple
      perl-Time-HiRes
      perl-Time-Piece
      perl-devel
      perl-libs
      perl-parent
      perl-version
    • HTTP通信を行うLWP::Simple は perl-libwww-perl
    • warningやエラーを表示するCarpはperl-Carp-clanとperl-CGI

root権限がないサーバでCPANモジュールを無理矢理(?)動かしたい

  • root権限がないので、CPANもyumもrpmも動かせない、/usr/libにpmを勝手に置くなどもってのほかなサーバでとにかくモジュールを動かしたい場合。
    • CPANとかからソースをダウンロードしてmakeしてコンパイルする。
    • できあがったlibディレクトリをスクリプトと同じディレクトリにコピーする。
    • スクリプトにuse libを書く。
      use lib './lib/';

ホスト名と IP アドレスを相互変換する (Socket)

use Socket;
# ホスト名→IPアドレス
$ipaddr = inet_ntoa(inet_aton("okkun-lab.rd.fukuoka-u.ac.jp"));
# IPアドレス→ホスト名
$hostname = inet_ntoa("133.100.30.28");

pingを撃つ(Net::Ping)

use Net::Ping;
use Time::HiRes;
# オブジェクト作成(ICMPで0.3秒間隔で飛ばす)
$objping = Net::Ping->new('icmp', 0.3);
# 応答時間を高解像度にする
$objping->hires();

# pingを撃つ
($res, $delay, $ip) = $objping->ping("192.168.0.1");

if($res) {
  print "responce from $ip (delay $delay ms)\n";
} else {
  print "no responce from $ip\n";
}

# 解放
undef $objping;

図形処理(GD)

  • 必要物品(CentOS 5)
    • yum install gcc-c++
    • yum install gd-devel libpng-devel libjpeg-devel
    • perl -MCPAN -e shell
      • install GD
  • 必要物品(CnetOS 6)
    • yum install perl-GD

図形を描画

use GD;

# HTTPヘッダ出力
print "Content-Type: image/png;\n\n";

# 画像サイズの定義
$img = new GD::Image(100, 100);
# 画像をインタレース化する
$img->interlaced('true');

# 色を定義
$white = $img->colorAllocate(255, 255, 255); # R, G, B
$black = $img->colorAllocate(0, 0, 0);
$green = $img->colorAllocate(0, 128, 0);
# 透過色を白として定義
$img->transparent($white);
# フォント(ttf)のパスを定義
$fontpath = './VL-PGothic-Regular.ttf';

# 点 (X, Y, 色)
$img->setPixel(50, 50, $black);
# 線 (X1, Y1, X2, Y2, 色)
$img->line(0, 0, 99, 99, $black);
# 四角 (X1, Y1, X2, Y2, 色)
$img->rectangle(0, 0, 99, 99, $black);
# 円(中心X, 中心Y, 半径W, 半径H, 開始角度, 終了角度)
$img->arc(50, 50, 50, 50, 0, 360, $green);
# 塗りつぶし X, Y, 色)
$img->fill(50, 50, $green);
# 文字 (フォント, X, Y, 文字列, 色)
$img->string(gdMediumBoldFont, 10, 10, "Hello!!", $black);
# 日本語文字(TTF) (色, フォント(ttf)パス, サイズ(pt), 角度(deg), x, y, 文字列)
$img->stringFT($black, $fontpath, 10, 0,10,30,'あいうえお');
  # stringは左上座標、stringftは左下座標とのこと。

# 結果を PNG 形式でファイルに書き出す
open(OUT, "> test.png");
binmode(OUT);
print OUT $img->png;
close(OUT);
  • 日本語フォントが必要であればここがきれいでオススメ

GDに関する参考

PNG を結合する

use GD;
$w = 17;
$h = 25;
$newImage = new GD::Image($w * 6, $h);
for $num (split('', sprintf("%06d", $ARGV[0]))){
    open (PNG, "< $num.png");
    $numImage = newFromPng GD::Image(PNG);
    close PNG;
    $newImage->copy($numImage, $keta * $w, 0, 0, 0, $w, $h);
    $keta ++;
}
print $newImage->png;
  • GDが必要(後述)
  • gifcat.pl よりも4倍遅いらしいが、データ量は 1/4 らしい。

文字コード変換(Encode)

use Encode;
  • utf8→euc-jp(1)
    Encode::from_to($text, "utf8", "euc-jp" );
  • utf8→euc-jp(2)
    my $ftitle=encode('euc-jp', decode('utf-8', $text));
  • 文字コードは
    • shiftjis, euc-jp, utf8 などを指定できるとのこと
  • 参考

日本語パターンマッチング(use encoding 'utf8')

  • use utf8しないで正規表現で /^[ぁ-ゖ]$/ ならまだしも、全角判定をさせることができない。
    • use utf8すると今まで作ってたスクリプトやモジュールの修正が必要になる。
    • めんどくさがりやな人向け。
  • decode('utf-8', $string)して正規表現にかける。
    • ひらがな記述か判定する場合
      decode('utf-8', $string) =~ /^\p{Hiragana}+$/
    • decodeしたものに対してはUnicodeブロック表記\p{}が使える。
    • もしdecodeしたものを出力する場合はencodeしてあげること。
      encode('utf-8', $string)

ハッシュ関数(Digest::SHA1)

  • パスワードをハッシュ化して保存したいけどMD5ハッシュでは心許ないのでSHA1ハッシュを使いたい場合
  • インストール
    • yum install perl-Digest-SHA1-2.11-1.2.1
  • 使用例
    use Digest::SHA1 qw(sha1 sha1_hex sha1_base64);
    # SHA1バイナリ形式に変換
    $string_sha1 = sha1($string);
    # SHA1の16進形式に変換
    $string_sha1hex = sha1_hex($string);
    # SHA1のBASE64形式に変換
    $string_sha1base64 = sha1_base64($string);
      # SHA1->BASE64で返される文字数 : 27バイト
      # BASE64で使用される文字 : A-Za-z0-9\+\/=
  • 参考

MySQLからデータを引っ張る(DBI)

  • MySQLへのアクセス
    • なんかもうファイルの入出力が面倒でならない人向けwww
  • MySQLサーバのセットアップ
  • モジュール
    • yum install perl-DBD-MySQL
  • use DBI;
    
    # MySQL DBI接続
    sub DBI_connect{
      $DBI_dsn = "DBI:mysql:DBname:mysql.example.com:3306";
        # DBI:DBMS名(MySQL):データベース名:SQLサーバホスト名:SQLサーバポート名
      $DBI_username = "kakukaku";
      $DBI_password = "sikajika";
      # 接続
      $DBI_dbh = DBI->connect($DBI_dsn, $DBI_username, $DBI_password);
      if(!$DBI_dbh) { &errorexit($dbh); }
      # 文字コード指定
      $DBI_dbh->do("SET NAMES utf8");
      return 0;
    }
    
    # MySQL DBI切断
    sub DBI_disconnect{
      $DBI_dbh->disconnect;
      return 0;
    }
    
    # SQL実行
    sub DBI_execute{
      # SQL文
      $strsql = "SELECT * FROM tablename;";
      # 文字列クォート(不正な文字をエスケープとか)
      $strsql = $DBI_dbh->quote($strsql);
      # SQL文実行
      $DBI_sth = $DBI_dbh->prepare($strsql);
      $DBI_sth->execute;
      
      # カラム数取得(この例では使ってないけど一応例として)
      $DBI_colnum = $DBI_sth->{NUM_OF_FIELDS};
      # カラム名への配列リファレンス
      $DBI_colname = $DBI_sth->{NAME};
      # データ件数
      $DBI_rownum = $DBI_sth->rows;
      
      # カラム名表示
      print "<table>\n  <tbody>\n    <tr>\n";
      foreach(@$DBI_colname) {
        print "      <th>$_</th>\n";
      }
      print "    </tr>\n";
      # データ表示
      while(@DBI_row = $DBI_sth->fetchrow_array) {
        print "    <tr>\n";
        foreach(@DBI_row) {
          print "      <td>$_</td>\n";
        }
        print "    </tr>\n";
      }
      print "  </tbody>\n</table>\n";
      # ステートメント(一連のSQL命令)終了
      $DBI_sth->finish();
      return 0;
    }
  • 参考
  • エラーが出る
    • apache(httpd)のerror_logに
      [Sat Mar 05 23:41:47 2011] [error] [client 192.168.1.2] DBI::db=HASH(0x14fexxxx)
      ->disconnect invalidates 1 active statement handle (either destroy statement han
      dles or call finish on them before disconnecting) at ./test_dbi.pl line xx., refe
      rer: http://192.168.1.1/~user/
      • 1つのSQL文に対して、そのステートメントの処理が完全に終了する前にdisconnectとか、他のSQL文を流してしまったのが原因。「まだ終わってねーよ」と言いたいらしい。
      • $DBI_sth->finish(); を入れましょう。

メールを送信する(Net::SMTP)

use Net::SMTP;
use Encode;

# SMTPサーバ
$Net_SMTP_host = 'smtp.sample.com';
# 送信者
$Net_SMTP_from = "送信者 <sender@sample.com>";
encode('MIME-Header', $tmp_str_mail_from);
# 受信者
$Net_SMTP_to = "受信者 <receiver@example.com>";
encode('MIME-Header', $Net_SMTP_to);
# 日時整形
@tmp_str_localtime = localtime(time);
@tmp_str_week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
@tmp_str_month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
  'Sep', 'Oct', 'Nov', 'Dec');
$Net_SMTP_date = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d +0900 (JST)",
  $tmp_str_week[$tmp_str_localtime[6]], $tmp_str_week[3],
  $tmp_str_month[$tmp_str_localtime[4]], $tmp_str_localtime[5]+1900,
  $tmp_str_localtime[2], $tmp_str_localtime[1], $tmp_str_localtime[0]);
# 件名
$Net_SMTP_subject = "テストメール送信中";
encode('MIME-Header', $Net_SMTP_subject);

# ヘッダ生成
$Net_SMTP_header = <<"MAIL_HEADER";
From: $Net_SMTP_from
To: $Net_SMTP_to
Sender: $Net_SMTP_from
Date: $Net_SMTP_date
Subject: $Net_SMTP_subject
Mime-Version: 1.0
Content-Type: text/plain; charset="UTF-8"
Content-Trensfer-Encoding: 8bit

MAIL_HEADER

# 本文生成
$tmp_str_mail_body = <<"MAIL_BODY";
 こんにちは、テストメールです。
MAIL_BODY

# 接続
my $Net_SMTP = Net::SMTP->new($Net_SMTP_host);
if(!$Net_SMTP) {
  die;
}
# 送信
$Net_SMTP->mail($Net_SMTP_from);
$Net_SMTP->to($Net_SMTP_to);
$Net_SMTP->data();
$Net_SMTP->datasend($Net_SMTP_header);
$Net_SMTP->datasend($tmp_str_mail_body);
$Net_SMTP->dataend();
$Net_SMTP->quit;

exit 0;

ファイルをアップロードする(cgi-lib.pl)

  • 画像とか添付ファイルだとか。
    • cgi-lib.plを使ってゆる〜く。
  • HTML
    <form action="index.cgi" method="post" enctype="multipart/form-data">
      <input type="file" name="attach" value="" size="30"><br>
      <input type="submit" name="" value="アップロード">
    </form>
    • enctypeは指定しないといけないらしい。
      • 特に他の引数があるとき。
  • Perl
    require './cgi-lib.pl';
    &ReadParse;
    print $in{'attach'};
    • inputで指定したnameの%inにバイナリでストアされる。
    • @inのどこかにファイルに関するContent-Typeがストアされる。

画像をアレコレする(Image::Magick)

  • 画像を
    • 拡大縮小
    • 形式変換
    • 圧縮
    • 簡易編集
  • GDよりもお手軽
    • しかし処理が少し遅い。
    • Perl CPANでインストールしてもうまくいかないことが多いので、CentOSの場合はyumでImageMagick-perl関連をインストールした方が楽。
      use Image::Magick;
      $image = Image::Magick->new();
      $image->Read('image.png');
      $image->Resize(width=>150, height=>150);
      $image->Write('png:newimage.png');

代表的なメソッド

  • リサイズ
    Resize(width=>150, height=>150)
    • アスペクト(縦横)比関係なし
  • 画像の情報取得
    Get('width', 'height', 'filesize', 'magick')
    • width(幅), height(高さ), filesize, magick(ファイル形式)を配列で返す
  • 画像の属性設定
    Set('magick'=>'jpg', 'quality'=>60)
    • magick(ファイル形式)をjpg(JPEG)にしたり、画質を60にしたり
  • 切り出し
    Crop('width'=>150, 'height'=>150, 'x'=>20, 'y'=>30)

あまり知られていないメソッド

  • DBとかアップロードで画像を取得して変数に格納していて、それを読み込ませたり書き出したり。
    $image = Image::Magick->new();
    $image->BlobToImage($icon);
    $image->Resize(width=>150, height=>150);
    $image->Set('magick'=>'jpg');
    $newicon = $image->ImageToBlob();

参考

log2(底が2のlog)する

  • 数学
    • log2(n) = loge(n) / loge(2)
    • 高校で習う数学でしたっけ?
      sub log2 {
        return log($_[0]) / log(2);
      }

配列をソートする

  • 配列をソート
    @sortedlist = sort {$a <=> $b} @list; # 昇順
    @sortedlist = sort {$b <=> $a} @list; # 降順
  • ハッシュのキーでソート
    @sortedlist = sort keys %hash;
  • ハッシュの値でソート
    @sortedlist = sort {$hash{$a} <=> $hash{$b$} } keys %hash;
  • 参考
    • sortは引数の配列やハッシュを直接操作するため、いじられたら困る場合は {$a <=> $b}のような作業用の変数を2つ使って操作させる。
    • keys %hashの場合はこの文節自体が作業用配列として扱われるので、作業用変数を省略しても問題ない。

文法チェック

  • コマンドライン上で文法チェック
    perl -wc (スクリプト名)
  • CGIのエラーをブラウザ上に表示する
    #!/usr/bin/perl
    BEGIN{ $| = 1; print "Content-type: text/html\n\n"; open(STDERR, ">&STDOUT"); }

Cookieを食べさせたり吐かせたり

  • Cookieでセッション管理
    • 一応CGI::Sessionがあるけど、HTTPヘッダやHTMLタグを独自に書きたい場合は使えないので、独自実装。
  • HTTPヘッダ中にSet-Cookie:行を入れる場合
    print << "HTTP_HEADER";
    Content-Type: text/html; charset=UTF-8
    Content-Language: ja
    Set-Cookie: id=$login_id session=$sess_id; domain=$WHICH_domain; path=$WHICH_path
    HTTP_HEADER
  • HTMLヘッダ中にmetaタグを入れる場合
    <meta http-equiv="Set-Cookie" content="id=$login_id session=$sess_id; domain=$WHICH_domain; path=$WHICH_path">
    • 項目名=値; を羅列する。日本語や記号はエンコードされるかも。
    • domain=test.example.com と path=/cgi-bin/test/ で、http://test.example.com/cgi-bin/test/ 以下で読み出せるCookieとなる
    • expires=Mon, 30-Mar-2011 01:11:00 GMT でcookieの有効期限。過去の日時を指定すると削除する。省略するとブラウザを閉じると削除。GMTしか指定できない。
  • 参考

アクセス時の情報を取得する

  • アクセス元URL(リファラ)
    $refurl = $ENV{'HTTP_REFERER'};
  • アクセスしてきたホスト・IP
    $host = $ENV{'REMOTE_HOST'};
    $addr = $ENV{'REMOTE_ADDR'};
    • ホストによってはどちらかが欠落することがあるので、必要に応じて Socket モジュールで相互補完する。

雑多なメモ