WEB+DB PRESS Vol.8
特集4 習うより慣れよう！今すぐできるPerl
第2章 Webアプリケーションを作ってみる -郵便番号検索アプリケーションの開発-

本文中以下について，誤りがありましたので，訂正いたします．
読者のみなさまにご迷惑をおかけしたことを深くお詫び申し上げます．
また，何名かの方には，間違いについてご指摘いただきありがとうございます．

・Apache::exitについて（86ページ左段 mod_perl使用上の注意．リスト3-○数字の14，16，17，19）
mod_perlを使用する際に不用意にexit()を使ってはいけないように書いていますが，CGIをシミュレートするApache::RunやApache::Registryの環境では，内部的にApache::exitを実行するようです．CGIでも動かすことを考えるとexit()のままにしておいた方が良いようです．

・Apache::DBIの宣言について（リスト3 左段 7行目）
DBへの接続を保持することを目的にApache::DBIを用いていますが，use Apache::DBIは，use DBIの前に宣言する必要があります．一般的には，httpd.confでperlModule Apache::DBIとし，スクリプト中には書かないほうが良いようです．

・DBDにおける検索件数について（リスト3 右段 $sth->rows）
DBIのドキュメントによれば，rowsは，ドライバ（DBD）によって，検索数を表すこともあればそうでないこともあり注意が必要とのことです．今回のPostgreSQL用のDBD（DBD::Pg）を使っている分には良いようですが，他のDBDを利用される場合は，自前でカウントする等の対処が必要な場合があるようです．

・DBへの接続（DBI->connect）について（リスト3-○数字の23）
DBIのドキュメントでは，接続（connect）の際に，AutoCommitを明示的に指定することが強く推奨されています．また，本文では，簡略化を目的にエラー処理を省略していますが，接続（connect）の際に，RaiseErrorの指定をしておくのが一般的のようです．

・バインドメカニズムについて（86ページ右段，20行目．リスト3-○数字の18，24〜27）
本文で述べましたように，リスト3-○数字の24〜27 のような処理をすれば，バインドメカニズムにより'（シングルクォーテーション）や"（ダブルクォーテーション）などの特殊文字を無効化することができるのですが，%と_（アンダーバー）については無効化することはできません．
したがって，リスト3-○数字の18 では，$input =~ /[<>&"';,.\%_]/のように，%や_もエスケープしておく必要があります．
詳しくは，IPA セキュリティセンターによる「セキュア・プログラミング講座」のこちらのページをご覧ください．



リスト3　serch.cgi修正版（赤字が修正部分）
（ダウンロード用ソースコードも差し替えました．zip　tgz） 
#!C:/perl/bin/perl.exe


use strict;
use CGI;
use Jcode;
use DBI;
#代わりに，Apacheの設定で行います．
#httpd.confに，「PerlModule Apache::DBI」と追加してください．
#この設定は，「LoadModule perl_module modules/mod_perl.so」
#より後に書く必要があります．

print "Content-type: text/html\n\n";
print "<html><head><title>検索結果</title></head><body>";

(my $item, my $input) = input();
my $key = check($item, $input);
(my $dbh, my $sth) = db_search($item, $key);
result($item, $input, $sth);
$sth->finish(); $dbh->disconnect();

print "</body></html>";

### 入力情報の取得 ###
sub input {
    my $query = new CGI;
    my $item = $query->param('item');
    my $input;

    if ($item eq "zipcode") {
        $input = $query->param('zipcode');
    } elsif ($item eq "address") {
        $input = $query->param('address');
    }
    return $item, $input;
}

### 入力チェック ###
sub check {
    my $item = shift;
    my $input = shift;

    if ($item eq "zipcode") {
        $input =~ s/-//;
        if ($input =~ /^$/) {
            print "郵便番号が入力されていません．";
            exit;
        } elsif ($input !~ /^[0-9]{3,7}$/) {
            print "郵便番号の入力に誤りがあります．";
            exit;
        }

    } elsif ($item eq "address") {
        if ($input =~ /^$/) {
            print "住所が入力されていません．";
            exit;
        } elsif ($input =~ /[<>&"';%_]/) {
            print "住所の入力に誤りがあります．";
            exit;
        } else {
            $input = jcode($input)->z2h;
        }
    }
    return $input;
}

### データベース検索 ###
sub db_search {
    my $item = shift;
    my $key = shift;
    my $sth;
    my $dbh = DBI->connect("dbi:Pg:host = localhost;
              dbname = Administrator","Administrator","",
              {RaiseError=>1, AutoCommit=>0})
              or die "データベースに接続できません．$DBI::errstr";

    if ($item eq "zipcode") {
        $sth = $dbh->prepare("select * from yuubin
            where zipcode like ? order by zipcode" );
        $sth->execute("$key%");
    } elsif ($item eq "address") {
        $sth = $dbh->prepare("select * from yuubin
            where address_kana like ? order by zipcode" );
        $sth->execute("%$key%");
    }
    return $dbh, $sth;
}

### 検索結果の画面表示 ###
sub result {
    my $item = shift;
    my $input = shift;
    my $sth = shift;

    if ($item eq "zipcode") {
        print "郵便番号が <b>", $input, 
            "</b> で始まるものを以下に示します．<br><br>";
    } elsif ($item eq "address") {
        print "住所に <b>", $input,
            "</b> を含むものを以下に示します．<br><br>";
    }

    if ($sth->rows == 0) {
        print "該当するデータはありません．";
    } else {
        print "検索件数：", $sth->rows, "<br>";
        print "<table>";
        print "<tr bgcolor=\"#a0a0ff\">
            <th>郵便番号</th><th>住所</th></tr>";
        my $bgcolor = "";

        while (my @row = $sth->fetchrow_array()) {
            if($bgcolor eq "#f0f0ff"){
                $bgcolor = "#d0d0ff";
            } else {
                $bgcolor = "#f0f0ff";
            }
            print "<tr bgcolor=\"$bgcolor\">";
            print "<td>", substr($row[0],0,3), "-",
                substr($row[0],3,4), "</td>";
            print "<td>", jcode($row[1])->sjis, "</td>";
            print "</tr>";
        }
        print "</table>";
    }
}