Perl/CGI研究室 'PERL-LABO'

クッキーの活用と管理者に通知

研究内容

クッキーを利用して「お名前」「URL」を最初から入力された状態にして 再入力しなくてもいいようにする研究です。 ついでに投稿があったことを管理者にメールで通知する機能も付けます。

詳細

何度も「お名前」「URL」を入力するのは面倒ですよね。 こういうときこそ、クッキーを利用して利用者の便宜をはかりましょう。 あと、メールで管理者に通知するのも大事な機能ですよね。 この２つをまとめて追加します。

結果

クッキー処理

クッキー処理は以前作成したライブラリ cookie.pl で簡単に行うことができます。 名前とURLをそれぞれ name url という名前でクッキーに書き込んでおいて、 フォームを出力するときに INPUT タグの value 属性でこれらを指定します。 そうすると、最初からそれらの文字列が入力された状態になるので、 再入力が不要になるわけです。 名前とURLは記事が投稿されるたびにクッキーにセットされるので、 最後に投稿したときの名前、URLが保存されることになります。

メール処理

メールの送信は以前作成したライブラリ sendmail.pl で簡単に行うことができます。 先に変数にメール送信先のアドレスを入れておきます。 ここで注意！もう忘れてしまったと思いますが、メールアドレスの中にある @ はPerlの配列を 表す記号のため、例えば "abc@xyz.jp" というように " で囲んでしまうと、 @xyz という配列としてこれが展開されておかしなことになってしまいます。 メールアドレスは必ず ' で囲みます。'abc@xyz.jp' とすれば正しく届きます。 これを忘れないようにしましょうね。

作成したCGIプログラム

#!/usr/bin/perl

# v 1.01
use CGI::Carp qw(fatalsToBrowser);

require 'getformdata.pl';
require 'stdplab.pl';
require 'lock.pl';
require 'html.pl';
require 'cookie.pl';
require 'sendmail.pl';

# データファイル名
$logfname = "dat_bbs.cgi";

# 管理者メールアドレス
$adminmailaddress = 'admin@perl-labo.org';

# フォームデータ取得
%form = plab::getformdata();

# 処理モードを取得
$mode = $form{'mode'};

# モードに従って分岐します
if ($mode eq "write") {
	# 記事の書き込み処理
	writemode();
	exit;
}
elsif ($mode eq "clear") {
	# 記事の全削除
	if (open(FILE, "> $logfname")) {
		close(FILE);
	}
	print "Content-type: text/html\n\n";
	print "記事を全て削除しました。";
	exit;
}

# 以下、記事の閲覧

# HTMLの頭部分出力
htmlhead();

# クッキーから前回入力した名前とURLを得る
plab::readcookie();
$name = $plab::Cookie{'name'};
$url  = $plab::Cookie{'url'};

# フォーム他
print << "EOM";
<div class=pl>
<ol>
<li>	掲示板です。是非足跡を残していってください！
<li>	恐縮ですがタグは無効です。入力項目はいずれも省略可です。
<li>	荒らしはやめてください。IPアドレスを記録しています。…念のため (^^;
</ol>
<form method=post action=bbs.cgi>
<input type=hidden name=mode value=write>
<table>
<tr><td>タイトル</td><td><input type=text name=title size=40></td></tr>
<tr><td>お名前</td><td><input type=text name=name size=40 value="$name"></td></tr>
<tr><td>URL</td><td><input type=text name=url size=40 value="$url"></td></tr>
<tr><td>内容</td><td><textarea rows=5 cols=70 name=body></textarea></td></tr>
<tr><td></td><td><input type=submit value="送信"></td></tr>
</table>
</form>
</div>
EOM

# 記事を読み込む
open(FILE, "< $logfname");
@data = <FILE>;
close(FILE);

# 新しい方から20個表示する
$n = @data;
$nkiji = 0;
for ($i = $n - 1; $i >= 0 && $nkiji < 20; --$i, ++$nkiji) {
	($name, $title, $url, $body, $date, $tim, $ip, $host) = split('<>', $data[$i]);
	$no = $i + 1;
	print "<div class=plh>No.$no ";
	if ($title ne "") { print "<b>$title</b> "; }
	if ($name ne "")  { print "$name "; }
	if ($url ne "")  { print "[<a href=$url target=_blank>WEB</a>] "; }
	print "$date</div>\n";
	print "<br>\n";
	print "<div class=pl>\n";
	print "$body<br>";
	print "</div>\n";
	print "<br>\n";
}

# HTMLの足部分出力
plab::printhtmlfooter("Plab BBS v1.01");
exit;


# 投稿された記事をファイルに保存
sub writemode
{
	# フォームからのデータを取得
	$name  = $form{'name'};
	$title = $form{'title'};
	$url   = $form{'url'};
	$body  = $form{'body'};

	# タグ、改行などを処理
	$name  = replasecontrolchars($name);
	$title = replasecontrolchars($title);
	$url   = replasecontrolchars($url);
	$body  = replasecontrolchars($body);

	# クッキーに名前とURLを保存する
	plab::readcookie();
	$plab::Cookie{'name'} = $name;
	$plab::Cookie{'url'}  = $url;

	# HTMLヘッダ
	plab::writecookie();
	htmlhead();
	print "<div align=center>";

	# 記事の長さチェック
	$len = length($body);
	if ($len > 1024) {
		print "記事が長すぎます。もう少し短くしてください。<br>";
		print "ブラウザの戻るボタンで戻ってください。<br>";
	}
	else {
		# その他のデータを取得
		$date = plab::getcurrentdatestring();
		$tim  = plab::getcurrenttimestring();
		$ip   = plab::getip();
		$host = plab::gethost();

		# ロック
		$lockdir = $logfname . ".lockdir";
		if (! plab::lock($lockdir)) {
			print "ファイルロックに失敗しちゃいました。<br>";
		}
		else {
			# データ書き込み
			open FILE, ">> $logfname";
			print FILE "$name<>$title<>$url<>$body<>$date<>$tim<>$ip<>$host\n";
			close(FILE);
			plab::unlock($lockdir);
			print "<br>";
			print "記事の投稿は無事に終わりました。<br>";
			print "ありがとうございました。<br>";
		}
	}

	$scripturl = $ENV{'SCRIPT_NAME'};
	print "<br>";
	print "<a href=$scripturl>掲示板に戻る</a><br>";
	print "<br>";

	plab::printhtmlfooter("Plab BBS v1.01");

	# 管理者にメールで通知する
	$msg = $body;
	$msg =~ s/<br>/\n/g;
	$message = << "EOM";
タイトル：
$title

お名前：
$name

URL：
$url

内容：
$msg
EOM
	if (! plab::sendmail(
		"PlabBBS",
		$adminmailaddress,
		"Admin",
		$adminmailaddress,
		"PlabBBSに投稿がありました",
		$message)) {
		print "<br>管理者へのメール送信に失敗しています。";
	}
}

# HTMLタグ、改行の処理
sub replasecontrolchars
{
	local $s = $_[0];
	$s =~ s/\r\n/\n/g;
	while (chomp($s)) {
		;
	}
	$s =~ s/</</g;
	$s =~ s/>/>/g;
	$s =~ s/\n/<br>/g;
	return $s;
}

sub htmlhead
{
	print "Content-type: text/html\n\n";
	plab::printhtmlheader();
	print "<div style=\"line-height: 1.3em\">\n";
	print "<div class=plh>掲示板 version 1.01</div>\n";
	print "<br>\n";
}

実行結果

考察

プログラムの説明

特に新しいことはしていないと思います。 ライブラリ関数を呼ぶだけっていう感じですね。

１つ、変なのは通知用のメールの本文を作成しているところです。

	$message = << "EOM";
タイトル：
$title

お名前：
$name

URL：
$url

内容：
$msg
EOM

ここまで、関数の中は見やすくするために行の頭にタブを１つ入れていました。 今回ももちろんそうしているのですが、 このメール本文の内容を作成しているところだけはそれがありません。 なんでかというと、 = << というのは、ヒアドキュメントといって指定した文字列が出てくるまでを 改行を含めて変数に入れるっていうやつでした。もしタブが各行に付いていると、 このタブも含めて変数の中に入ってしまうんです。ですから、 ヒアドキュメントを使うときはタブを入れちゃいけないわけです。

そんなわけで、タブが付いていないんですが、 なんかプログラムを見ていて気持ち悪い感じもしますね。 でも、そういうものですから仕方ありませんね。

動きました！

動いてます。じゃんじゃん書き込んでください！