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

「KENTと作る! ワンランク上の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　携帯メーラーを設置してみよう！

■特別収録
・上記のChapter1～8のCGIプログラムとは別に、「KENTとつくろう！PerlでCGI 改訂増補」（絶版）の付録CGI一式も特別収録しています。

掲示板
チャット
アクセスカウンタ
全文検索
検索エンジン
レシピデータベース
情報共有システム

■修正情報（誤植）
・書籍内容に誤植がありました。謹んでお詫びいたしますとともに、内容の変更をご報告いたします。

●変更前
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

■付録プログラムの修正
・付録プログラムに修正内容がありますので、以下のとおり訂正させていただきますようお願いいたします。
・ご自分での修正が難しいようでしたら、CD-ROMからコピーしたままの修正対象のCGIスクリプトを添付メールにて、
webmaster@kent-web.com までお送りください。修正版と差し替えてさせていただきます。

(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="検索">

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

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

「KENTと作る! ワンランク上のPerl/CGIプログラミング」執筆のお知らせ

「KENTと作る! ワンランク上のPerl/CGIプログラミング」
執筆のお知らせ