[WEB+DB PRESS]

WEB+DB PRESS Vol.8
��W4 �K��芵��悤�I��ł��Perl
��2�� Web�A�v��P�[�V��Ă݂� -�X�֔ԍ��A�v��P�[�V��̊J��-

�{��ȉ��ɂ��āC��肪��܂��̂ŁC��܂��D
�ǎ҂݂̂Ȃ��܂ɂ��f��Ƃ�[��l�ѐ\��グ�܂��D
�܂��C��̕��ɂ́C�ԈႢ�ɂ��Ă��w�E��肪�Ƃ��܂��D

�EApache::exit�ɂ��āi86�y�[�W��i mod_perl�g�p��̒��ӁD��X�g3-��14�C16�C17�C19�j
mod_perl��g�p��ۂɕs�p�ӂ�exit()��g��Ă͂��Ȃ��悤�ɏ��Ă��܂��CCGI��V�~��[�g��Apache::Run��Apache::Registry�̊��ł́C��I��Apache::exit��s��悤�ł��DCGI�ł��Ƃ��l��exit()�̂܂܂ɂ��Ă��ǂ��悤�ł��D

�EApache::DBI�̐錾�ɂ��āi��X�g3 ��i 7�s�ځj
DB�ւ̐ڑ��ێ��邱�Ƃ�ړI��Apache::DBI��p��Ă��܂��Cuse Apache::DBI�́Cuse DBI�̑O�ɐ錾��K�v��܂��D��ʓI�ɂ́Chttpd.conf��perlModule Apache::DBI�Ƃ��C�X�N��v�g��ɂ͏��Ȃ��ق��ǂ��悤�ł��D

�EDBD�ɂ��錟��ɂ��āi��X�g3 �E�i $sth->rows�j
DBI�̃h�L��g�ɂ��΁Crows�́C�h��C�o�iDBD�j�ɂ��āC��\��Ƃ��΂��łȂ��Ƃ��蒍�ӂ��K�v�Ƃ̂��Ƃł��D��PostgreSQL�p��DBD�iDBD::Pg�j��g��Ă��镪�ɂ͗ǂ��悤�ł��C��DBD�𗘗p��ꍇ�́C��O�ŃJ�E��g��铙�̑Ώ��K�v�ȏꍇ��悤�ł��D

�EDB�ւ̐ڑ��iDBI->connect�j�ɂ��āi��X�g3-��23�j
DBI�̃h�L��g�ł́C�ڑ��iconnect�j�̍ۂɁCAutoCommit�𖾎��I�Ɏw�肷�邱�Ƃ��Ă��܂��D�܂��C�{��ł́C�ȗ��ړI�ɃG��[��ȗ��Ă��܂��C�ڑ��iconnect�j�̍ۂɁCRaiseError�̎w��Ă��̂��ʓI�̂悤�ł��D

�E�o�C��h��J�j�Y��ɂ��āi86�y�[�W�E�i�C20�s�ځD��X�g3-��18�C24�`27�j
�{��ŏq�ׂ܂��悤�ɁC��X�g3-��24�`27 �̂悤�ȏ��΁C�o�C��h��J�j�Y��ɂ��'�i�V��O��N�H�[�e�[�V��j��"�i�_�u��N�H�[�e�[�V��j�Ȃǂ̓��ꕶ��𖳌��邱�Ƃ��ł��̂ł��C%��_�i�A��_�[�o�[�j�ɂ��Ă͖��邱�Ƃ͂ł��܂��D
��āC��X�g3-��18 �ł́C$input =~ /[<>&"';,.\%_]/�̂悤�ɁC%��_��G�X�P�[�v��Ă��K�v��܂��D
�ڂ��́CIPA �Z�L��e�B�Z��^�[�ɂ��u�Z�L��A�E�v��O��~��O�u��v��̃y�[�W��D

��X�g3�@serch.cgi�C��Łi�Ԏ��C��j
�i�_�E��[�h�p�\�[�X�R�[�h��ւ��܂��Dzip�@tgz�j

#!C:/perl/bin/perl.exe


use strict;
use CGI;
use Jcode;
use DBI;
#����ɁCApache�̐ݒ�ōs���܂��D
#httpd.conf�ɁC�uPerlModule Apache::DBI�v�ƒǉ����Ă��������D
#���̐ݒ�́C�uLoadModule perl_module modules/mod_perl.so�v
#����ɏ����K�v������܂��D

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;
}

### ���̓`�F�b�N ###
sub check {
    my $item = shift;
    my $input = shift;

    if ($item eq "zipcode") {
        $input =~ s/-//;
        if ($input =~ /^$/) {
            print "�X�֔ԍ������͂���Ă��܂���D";
            exit;
        } elsif ($input !~ /^[0-9]{3,7}$/) {
            print "�X�֔ԍ��̓��͂Ɍ�肪����܂��D";
            exit;
        }

    } elsif ($item eq "address") {
        if ($input =~ /^$/) {
            print "�Z�������͂���Ă��܂���D";
            exit;
        } elsif ($input =~ /[<>&"';%_]/) {
            print "�Z���̓��͂Ɍ�肪����܂��D";
            exit;
        } else {
            $input = jcode($input)->z2h;
        }
    }
    return $input;
}

### �f�[�^�x�[�X���� ###
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 "�f�[�^�x�[�X�ɐڑ��ł��܂���D$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 "�X�֔ԍ��� <b>", $input, 
            "</b> �Ŏn�܂���̂��ȉ��Ɏ����܂��D<br><br>";
    } elsif ($item eq "address") {
        print "�Z���� <b>", $input,
            "</b> ���܂ނ��̂��ȉ��Ɏ����܂��D<br><br>";
    }

    if ($sth->rows == 0) {
        print "�Y������f�[�^�͂���܂���D";
    } else {
        print "���������F", $sth->rows, "<br>";
        print "<table>";
        print "<tr bgcolor=\"#a0a0ff\">
            <th>�X�֔ԍ�</th><th>�Z��</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>";
    }
}