KENT-WEBトップ > 書籍執筆のご案内 > ワンランク上のPerl/CGIプログラミング

KENTと作る! ワンランク上のPerl/CGIプログラミング

・ 出版社:ソシム案内ページ
・ KENT 著 / B5変形判 / 392ページ
・ ISBN 978-4-88337-535-6 / 2007年3月23日発売
・ 定価2,940円(本体2,800円)

【購入先】 Amazon | cbook24
■目次
Chapter1 CGIの基礎知識
1-1 CGIとPerl
1-2 CGIプログラム設置作業の基本
1-3 Perl文法の基礎
1-4 CGIのセキュリティについて

Chapter2 掲示板を作る [サンプル]
2-1 掲示板を作ってみよう!

Chapter3 検索エンジンを設置する
3-1 検索エンジンを設置してみよう!

Chapter4 ファイルアップローダーを設置する [サンプル]
4-1 ファイルアップローダーを設置してみよう!

Chapter5 スケジュール管理システムを設置する
5-1 スケジュール管理システムを設置してみよう!

Chapter6 郵便番号検索システムを設置する  [サンプル]
6-1 郵便番号検索システムを設置してみよう!

Chapter7 ブログ風日記を設置する  [サンプル]
7-1 ブログ風日記を設置してみよう!

Chapter8 携帯メーラーを設置する
8-1 携帯メーラーを設置してみよう!
■特別収録 ■修正情報(誤植)

・ 書籍内容に誤植がありましたので、内容の変更をご報告いたします。

●変更前
public_html
  |
  +-- bbs /
       |   mtbbs.cgi [755]
       |   admin.cgi [755]
       |   regist.cgi [755]
       |   registkey.cgi [755]
       |   init.cgi [644]
       |
       +-- lib /
       |    |   jcode.pl [644]
       |    |   registkey.pl [644]
       |    |
       |    +-- data /
       |              addr.dat  [666]
       |              backnum.dat [666]
       |              index.dat [666]
       |              num.dat   [666]
       |
       +-- log [777]  /
       |
       +-- tmpl /
                 backnum.html
                 loglist.html
                 newform.html
                 thread.html
                 top.html

●変更後
public_html
  |
  +-- bbs /
       |        mtbbs.cgi [755]
       |        admin.cgi [755]
       |        regist.cgi [755]
       |        registkey.cgi [755]
       |        init.cgi [644]
       |
       +-- lib /
       |        jcode.pl [644]
       |        registkey.pl [644]
       |
       +-- data /
       |         addr.dat  [666]
       |         backnum.dat [666]
       |         index.dat [666]
       |         num.dat   [666]
       |
       +-- log [777]  /
       |
       +-- tmpl /
                 backnum.html
                 loglist.html
                 newform.html
                 thread.html
                 top.html
■付録プログラムの修正 (1) ブログ風日記

・ 記事を固定リンクで閲覧した際、後半記事が二重表示される。
・ カレンダの「日」をクリックした際にサーバエラーとなる。

diary.cgi

83及び133行目付近
●変更前
# 年月認識
if ($in{'ym'} =~ /^(\d{4})(\d{2})$/) {
	$calen_y = $1;
	$calen_m = $2;
} else {
	&error("不正なアクセスです");
}

●変更後
# 年月認識
if ($in{'ym'} =~ /^(\d{4})(\d{2})$/) {
	$calen_y = $1;
	$calen_m = $2;
} else {
	&msg_html("ERROR !", "不正なアクセスです");
}

238行目付近
●変更前
# 固定記事のとき
if ($mode eq "entry" && $com2)
    $com1 .= "<br>$com2";
}

●変更後
# 固定記事のとき
#if ($mode eq "entry" && $com2)
#    $com1 .= "<br>$com2";
#}

399行目付近
●変更前
if (!$in{'y'} || !$in{'m'}) {
	my ($m,$y) = (localtime(time))[4,5];

	$in{'y'} = $y + 1900;
	$in{'m'} = $m + 1;
}

●変更後
if ($in{'ym'} =~ /^(\d{4})(\d+)$/) {
	$in{'y'} = $1;
	$in{'m'} = sprintf("%02d", $2);

} elsif (!$in{'y'} || !$in{'m'}) {
	my ($m,$y) = (localtime(time))[4,5];

	$in{'y'} = $y + 1900;
	$in{'m'} = sprintf("%02d", $m+1);
}

init.cgi

# 掲示板タイトル
$title = '雑談@掲示板';

上記の変数で設定する部分は掲示板側に反映される部分がなく、設定箇所としては
無効な部分です。(そのままにしておいても特に動作上支障はありません)

(2) スレッド掲示板

・トリップを使って投稿する際にクッキー保存すると、トリップ変換後の名前がクッキーに残るため、 2回目以降◆が◇に変換されてしまう。

regist.cgi

48及び175行目付近
●変更前
# ホスト&時間&ID
my ($host, $date, $id) = &get_info;

●変更後
# ホスト&時間&ID
my ($host, $date, $id) = &get_info;

# 入力された名前を覚えておく
my $moto_name = $in{'name'};

122及び270行目付近
●変更前
# クッキー保存
if ($in{'cookie'} == 1) {
	&set_cookie($in{'name'}, $in{'email'}, $in{'cookie'});
} else {
	&set_cookie('', '', '');
}

●変更後
# クッキー保存
if ($in{'cookie'} == 1) {
	&set_cookie($moto_name, $in{'email'}, $in{'cookie'});
} else {
	&set_cookie('', '', '');
}

・返信数が $maxlog(初期値1000件)を超えたとき、スレッド名が現行ログに残ったままになる。(過去ログへの二重掲載)

regist.cgi

199行目付近
●変更前
# インデックス展開
local($new_idx, $flg, @idx);
open(DAT,"+< $datadir/index.dat");
eval "flock(DAT, 2);";
while(<DAT>) {
	my ($no,$date,$title,$res) = split(/<>/);

	if ($in{'no'} == $no) {

		$flg++;
		$res++;

		# sage
		if ($in{'email'} eq "sage" && !$full) {
			$_ = "$no<>$date<>$title<>$res<>\n";
		# age
		} else {
			$new_idx = "$no<>$date<>$title<>$res<>\n";
			next;
		}
	}
	push(@idx,$_);
}

if (!$flg) {
	close(DAT);

	&eroro("この記事は投稿できません");
}

# age
if ($new_idx && !$full) {
	unshift(@idx,$new_idx);
}

# インデックス更新
seek(DAT, 0, 0);
print DAT @idx;
truncate(DAT, tell(DAT));
close(DAT);

# ログ展開
local($i, $full, $newlog, @log);
open(DAT,"+< $logdir/$in{'no'}.cgi");
eval "flock(DAT, 2);";
while(<DAT>) {
	$i++;
	my ($no,$date,$title,$name,$eml,$com,$id,$host,$abon) = split(/<>/);
	$newlog = $no;

	push(@log,$_);

	# 最大レス超
	if ($i >= $maxlog) { $full = 1; }
}
# 記事No
$newlog++;
push(@log,"$newlog<>$date<><>$in{'name'}<>$in{'email'}<>$in{'comment'}<>$id<>$host<><>\n");

# ログ更新
seek(DAT, 0, 0);
print DAT @log;
truncate(DAT, tell(DAT));
close(DAT);

# 過去ログ行き
if ($full) {
	open(DAT,"+< $datadir/bknum.dat");
	eval "flock(DAT, 2);";
	my @back = <DAT>;
	seek(DAT, 0, 0);
	print DAT $new_idx;
	print DAT @back;
		truncate(DAT, tell(DAT));
	close(DAT);
}

●変更後
# ログ展開
local($i, $full, $newlog, @log);
open(DAT,"+< $logdir/$in{'no'}.cgi");
eval "flock(DAT, 2);";
while(<DAT>) {
	$i++;
	my ($no,$date,$title,$name,$eml,$com,$id,$host,$abon) = split(/<>/);
	$newlog = $no;

	push(@log,$_);

	# 最大レス超
	if ($i >= $maxlog) { $full = 1; }
}
# 記事No
$newlog++;
push(@log,"$newlog<>$date<><>$in{'name'}<>$in{'email'}<>$in{'comment'}<>$id<>$host<><>\n");

# インデックス展開
local($new_idx, $flg, @idx);
open(IDX,"+< $datadir/index.dat");
eval "flock(IDX, 2);";
while(<IDX>) {
	my ($no,$date,$title,$res) = split(/<>/);

	if ($in{'no'} == $no) {

		$flg++;
		$res++;

		# sage
		if ($in{'email'} eq "sage" && !$full) {
			$_ = "$no<>$date<>$title<>$res<>\n";
		# age
		} else {
			$new_idx = "$no<>$date<>$title<>$res<>\n";
			next;
		}
	}
	push(@idx,$_);
}

if (!$flg) {
	close(IDX);

	&eroro("この記事は投稿できません");
}

# ログ更新
seek(DAT, 0, 0);
print DAT @log;
truncate(DAT, tell(DAT));
close(DAT);

# 過去ログ行き
if ($full) {
	open(DAT,"+< $datadir/bknum.dat");
	eval "flock(DAT, 2);";
	my @back = <DAT>;
	seek(DAT, 0, 0);
	print DAT $new_idx;
	print DAT @back;
	truncate(DAT, tell(DAT));
	close(DAT);
}

# age
if ($new_idx && !$full) {
	unshift(@idx,$new_idx);
}

# インデックス更新
seek(IDX, 0, 0);
print IDX @idx;
truncate(IDX, tell(IDX));
close(IDX);

(3) 検索エンジン

・カテゴリページへ移動した後に検索をかけるとエラーとなる。

lib/list.pl

104行目及び208行目(共通箇所)
●変更前
<input type="submit" value="検索">

●変更後
<input type="submit" name="submit" value="検索">

・検索結果後、次ページボタンを押すとエラー表記になる。。

navi.cgi

16行目
●変更前
if ($in{'submit'}) {

●変更後
if ($in{'submit'} || $mode eq 'find') {

・管理画面から記事削除ができない。

admin.cgi

121行目
●変更前
# マスタDB更新
seek(DB, 0, 0);
print DB @data;
close(DB);

# データNo更新
foreach (@new) {
	$line .= "$_,";
}
$all = @data;

# 更新データ
$num[0] = "$num,$all,\n";
$num[1] = "$line\n";

seek(DAT, 0, 0);
print DAT @num;
close(DAT);

●変更後
# マスタDB更新
seek(DB, 0, 0);
print DB @data;
truncate(DB, tell(DB));
close(DB);

# データNo更新
foreach (@new) {
	$line .= "$_,";
}
$all = @data;

# 更新データ
$num[0] = "$num,$all,\n";
$num[1] = "$line\n";

seek(DAT, 0, 0);
print DAT @num;
truncate(DAT, tell(DAT));
close(DAT);

212行目
●変更前
seek(DAT, 0, 0);
print DAT @data;
close(DAT);

●変更後
seek(DAT, 0, 0);
print DAT @data;
truncate(DAT, tell(DAT));
close(DAT);

(4) スケジュール管理システム

・上部右の移動フォームで移動後に書き込んだデータが表示されなくなる。

calendar.cgi

32行目
●変更前
if ($in{'sel_y'} && $in{'sel_m'}) {
   $in{'y'} = $in{'sel_y'};
   $in{'m'} = $in{'sel_m'};

●変更後
if ($in{'sel_y'} && $in{'sel_m'}) {
   $in{'y'} = sprintf("%02d", $in{'sel_y'});
   $in{'m'} = sprintf("%02d", $in{'sel_m'});