SAK 図書館
CGI-Perl 応用実地編 - 簡易伝言板作成6 (投稿ハンドルクッキー記憶)
■伝言投稿ハンドルクッキー記憶 ・投稿ハンドルを毎回入力するのは面倒です。 クッキーを使用して投稿ハンドルを記憶するようにします。 ・次のクッキー取得 GetCookie() 関数を最後に追加します。 #//===================================================================== #// クッキー取得 #//===================================================================== sub GetCookie { local($cookie) = $ENV{'HTTP_COOKIE'}; local(*data, @cookie, $key, $val); #// クッキー取得 @cookie = split(/ /, $cookie); foreach (@cookie) { ($key, $val) = split(/=/); $data{$key} = $val; } #// 戻り値セット return *data; } ・クッキー名を「#// 伝言ファイル」と「#// パラメタ取得」の間に、次のよ うに追加します。 #// クッキー $cknm = 'dengon'; ・クッキー取得コードを「#// 伝言ファイル読み込み」の前に、次のように追 加します。 ・「,」で複数のデータを記憶できるようにしているので、分割して先頭の データ(ここでは、ハンドルがセットされている) を $hdc に取得します。 #// クッキー取得 if ($ENV{'HTTP_COOKIE'}) { *data = GetCookie($ENV{'HTTP_COOKIE'}); $data{$cknm} =~ s/%20/ /g; @w = split(/\,/, $data{$cknm}); $hdc = @w[0]; } ・入力ハンドルでクッキーの値を更新するように「#// 伝言編集」の前に、 次のように追加します。 #// クッキーデータセット $hdc = $hd; ・クッキーの書き出しは、「#// HTML ヘッド表示」の前に、次のように追加 します。尚、HTML ヘッダもここで書いてしまうので、 「#// HTML ヘッド表示」の最初の 2 行は不要になります。 ・クッキーデータは、「,」で複数セットできるようにしていますが、このプ ログラムでは、ハンドルだけセットします。 また、クッキーの有効期限は 60 日にしています。 #// クッキーセット $hdc =~ s/\,/%2C/g; $cooks = "$hdc\,"; $cooks =~ s/ /%20/g; $cooks =~ s/;//g; ($secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg) = gmtime(time + 5184000); @mons = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); @week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); $dt= sprintf("%s\, %02d-%s-%04d %02d:%02d:%02d GMT", $week[$wdayg], $mdayg, $mons[$mong], $yearg+1900, $hourg, $ming, $secg); print "Content-type: text/html\n"; print "Set-Cookie: $cknm=$cooks; expires=$dt;\n\n"; #// HTML ヘッド表示 print << "END_OF_HTML"; <HTML> ・クッキーに記憶しているハンドルをフォームに表示するため、ハンドルの 入力定義を、次のように修正します。 <TD nowrap><INPUT id=hd name=hd size="22" maxlength="40" value="$hdc"></TD> ・以上を test6.cgi として修正すると、次のようになります。 #!/usr/local/bin/perl #//===================================================================== #// test6.cgi 簡易伝言板 #//===================================================================== #// 準備 $title = '簡易伝言板'; $callcgi = 'test6.cgi'; #// 伝言ファイル $msdnm = './'; $msfnm = 'dengon.txt'; $msmax = 10; #// クッキー $cknm = 'dengon'; #// パラメタ取得 *data = GetPara(); $md = $data{'md'}; $hd = $data{'hd'}; $ms = $data{'ms'}; #// クッキー取得 if ($ENV{'HTTP_COOKIE'}) { *data = GetCookie($ENV{'HTTP_COOKIE'}); $data{$cknm} =~ s/%20/ /g; @w = split(/\,/, $data{$cknm}); $hdc = @w[0]; } #// 伝言ファイル読み込み $err = 0; open(FIL, "$msdnm$msfnm") or $err = 1; if ($err) { DspMsg("ファイル読み込みオープンエラー ($msdnm$msfnm)"); exit(0); } @rec = <FIL>; close(FIL); #// 投稿処理開始 if ($md eq '1') { #// データチェック $hd =~ s/ / /g; $hd =~ s/</&lt;/g; $hd =~ s/>/&gt;/g; $hd =~ s/^\s+//; $hd =~ s/\s+$//; $ms =~ s/ / /g; $ms =~ s/</&lt;/g; $ms =~ s/>/&gt;/g; $ms =~ s/^\s+//; $ms =~ s/\s+$//; if ($hd eq '') { DspMsg("ハンドルが空白です。"); exit(0); } if ($ms eq '') { DspMsg("メッセージが空白です。"); exit(0); } #// クッキーデータセット $hdc = $hd; #// 伝言編集 ($ss, $mn, $hh, $dd, $mm, $yy, $yb) = localtime(time); $yy += 1900; $mm++; $dt = sprintf("%04d.%02d.%02d %02d:%02d:%02d", $yy, $mm, $dd, $hh, $mn, $ss); $rec = $dt . '_~|~_' . $hd . '_~|~_' . $ms . "\n"; #// 伝言ファイル書き込み $err = 0; open(FIL, ">$msdnm$msfnm") or $err = 1; if ($err) { DspMsg("ファイル書き込みオープンエラー ($msdnm$msfnm)"); exit(0); } unshift @rec, $rec; for ($i = $#rec; $i >= $msmax; $i--) { pop @rec; } print FIL @rec; close(FIL); #// 投稿処理終了 } #// クッキーセット $hdc =~ s/\,/%2C/g; $cooks = "$hdc\,"; $cooks =~ s/ /%20/g; $cooks =~ s/;//g; ($secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg) = gmtime(time + 5184000); @mons = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); @week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); $dt= sprintf("%s\, %02d-%s-%04d %02d:%02d:%02d GMT", $week[$wdayg], $mdayg, $mons[$mong], $yearg+1900, $hourg, $ming, $secg); print "Content-type: text/html\n"; print "Set-Cookie: $cknm=$cooks; expires=$dt;\n\n"; #// HTML ヘッド表示 print << "END_OF_HTML"; <HTML> <HEAD> <META http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> <TITLE>$title</TITLE> </HEAD> <BODY> <CENTER> <P><B>◆ 簡易伝言板 ◆</B></P> <FORM action="$callcgi" id=FORM1 method=post name=FORM1> <INPUT TYPE="hidden" NAME="md" VALUE="1"> <TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2> <TBODY> <TR bgcolor=#f0f0f0> <TD nowrap><FONT size=-1>ハンドル</FONT></TD> <TD nowrap><INPUT id=hd name=hd size="22" maxlength="40" value="$hdc"></TD> </TR> <TR bgcolor=#f0f0f0> <TD nowrap><FONT size=-1>メッセージ</FONT></TD> <TD nowrap><INPUT id=ms name=ms size="62" maxlength="200"></TD> </TR> </TBODY> </TABLE> <BR> <TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2> <TBODY> <TR bgcolor=#f0f0f0> <TD nowrap><INPUT id=submit1 name=submit1 type=submit value=" 投稿 "></TD> <TD nowrap><INPUT id=reset1 name=reset1 type=reset value="リセット"></TD> </TR> </TBODY> </TABLE> </FORM> END_OF_HTML #// 伝言ファイルヘッド表示 print << "END_OF_HTML"; <TABLE bgcolor=#b0b0b0 border=0 cellPadding=3 cellSpacing=2> <TBODY> <TR bgcolor=#d0d0d0> <TD nowrap><FONT size=-1>日付</FONT</TD> <TD nowrap><FONT size=-1>ハンドル</FONT</TD> <TD><FONT size=-1>メッセージ</FONT</TD> </TR> END_OF_HTML #// 伝言ファイルボディ表示 foreach (@rec) { @w = split(/\_\~\|\~\_/, $_); $dt = substr(@w[0], 0, 16); $hd = @w[1]; $ms = @w[2]; print '<TR bgcolor=#f0f0f0>'; print '<TD nowrap><FONT size=-1>', $dt, '</FONT</TD>'; print '<TD nowrap><FONT size=-1>', $hd, '</FONT</TD>'; print '<TD><FONT size=-1>', $ms, '</FONT</TD>'; print '</TR>'; } #// 伝言ファイルテイル表示 print << "END_OF_HTML"; </TBODY> </TABLE> END_OF_HTML #// HTML テイル表示 print << "END_OF_HTML"; </CENTER> </BODY> </HTML> END_OF_HTML #// 終了 exit(0); #//===================================================================== #// メッセージ表示 #//===================================================================== sub DspMsg { my($msg) = @_[0]; #// メッセージ表示 print << "END_OF_HTML"; Content-type: text/html <HTML> <HEAD> <META http-equiv="Content-Type" content="text/html; charset=Shift_JIS"> <TITLE>$title</TITLE> </HEAD> <BODY> <P>$msg</P> </BODY> </HTML> END_OF_HTML #// リターン return; } #//===================================================================== #// パラメタ取得 #//===================================================================== sub GetPara { my($encode) = @_; my($method) = $ENV{'REQUEST_METHOD'}; local($qu, @in, $key, $val); #// 日本語コード変換 jcode.pl 読み込み require 'jcode.pl' if $encode; #// パラメタ取得 if ($method eq 'GET') { $qu = $ENV{'QUERY_STRING'}; } elsif ($method eq 'POST') { read(STDIN, $qu, $ENV{'CONTENT_LENGTH'}); } local(@qu) = split(/&/, $qu); foreach (@qu) { tr/+/ /; ($key, $val) = split(/=/); $key =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack('c', hex($1))/ge; $val =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack('c', hex($1))/ge; $val =~ s/\r\n/\n/g; jcode'convert(*key, $encode) if ($encode); jcode'convert(*val, $encode) if ($encode); $in{$key} = $val; } #// 戻り値セット return *in; } #//===================================================================== #// クッキー取得 #//===================================================================== sub GetCookie { local($cookie) = $ENV{'HTTP_COOKIE'}; local(*data, @cookie, $key, $val); #// クッキー取得 @cookie = split(/ /, $cookie); foreach (@cookie) { ($key, $val) = split(/=/); $data{$key} = $val; } #// 戻り値セット return *data; } ■CGI-Perl 応用実地編資料
■CGI-Perl 基礎編資料
■CGI-Perl 基礎実地編資料
■PHP 基礎編資料
■PHP + MySQL 編資料