![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
''[[FrontPage]]''
* 自作CGI掲示板のログ作成部 [#p9ea5443]
実際に作成したソースコードを公開します。~
私の掲示板では、分かりやすさのため、機能の観点でソースを２つに分けています。~
それぞれ、表(HTML出力部: guestbook.cgi)と裏(ログファイル作成部: write.cgi)といったかたちで。~
ここではログの書込みとクッキーの設定に特化したwrite.cgiを、コメント中にて解説しています。~
~
近いうちに簡単なフローなど書いてみようかと。~
クエリ、フォーム、URLデコードの仕組みについても少しまとめたい？~
~
ファイル名: write_r4.cgi
#!/usr/bin/perl
use warnings; # 警告表示 #
use strict; # 構文チェック #
# #
require './jcode.pl'; # for URLデコード #
require './idroll.pl'; # for ID文字列振出し #
require './gb_util.pl'; # for ログの確定とロールバック #
# #
# URL Decode **************************************************## URLデコード #
my $tmp0 = my $tmp1 = ""; # 作業領域 #
my @decopairs = (""); # フォームの内容を各データごとに格納する #
my $key = ""; # フォームデータのキー #
my $value = ""; # フォームデータの値 #
my %form = ("", ""); # 実操作用ハッシュ #
# #
if( $ENV{'REQUEST_METHOD'} eq "POST" ) # POST使用かどうか #
{ # POST使用の場合 #
read( STDIN, $tmp0, $ENV{'CONTENT_LENGTH'} ); # フォームに入力された内容を変数に格納する #
} # #
else # #
{ # POST使用以外の場合 #
$tmp0 = $ENV{'QUERY_STRING'}; # クエリの内容を変数に格納する #
} # #
# #
@decopairs = split( /&/, $tmp0 ); # フォーム入力内容を'&'区切りで配列に格納する #
# #
foreach $tmp1 (@decopairs) # 配列の各要素について #
{ # #
($key, $value) = split( /=/, $tmp1 ); # '='区切りでキーと値に切分ける #
$value =~ tr/+/ /; # URLデコード #
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack ("C", hex($1))/eg; # URLデコード #
# jcode::convert(*value, 'sjis'); # URLデコード #
jcode::h2z_sjis( \$value ); # 半角カナ → 全角 #
$form{$key} = $value; # フォームの内容をハッシュ(ログ用)にセット #
} # #
# Resist Ads **************************************************## ログ確定・切戻し処理 #
if( $form{'confirm'} ) # 確定ボタンが押されたかどうか #
{ # 確定ボタンが押された場合 #
&gb_util::confirm(); # ログ確定サブルーチンを呼出す #
print "Location: http://bj006.com/cgi/guestbook.cgi"."\n\n"; # 掲示板に戻る #
} # #
elsif( $form{'rollback'} ) # ロールバックボタンが押されたかどうか #
{ # ロールバックボタンが押された場合 #
&gb_util::rollback(); # ロールバックサブルーチンを呼出す #
print "Location: http://bj006.com/cgi/guestbook.cgi"."\n\n"; # 掲示板に戻る #
} # #
elsif( "2109" == $form{'mssid'} ) # ID入力値が強制切戻し命令番号と一致するか #
{ # ID入力値が強制切戻し命令番号と一致する場合 #
&gb_util::rollback2(); # 強制ロールバックサブルーチンを呼出す #
print "Location: http://bj006.com/cgi/guestbook.cgi"."\n\n"; # 掲示板に戻る #
} # #
#/Resist Ads **************************************************## #
my $name = ""; # 作業用 #
my $subject = ""; # 作業用 #
my $message = ""; # 作業＆判定用 #
my $url = ""; # 作業＆判定用 #
my $curl = ""; # クッキー設定用 #
my $mssid = ""; # 作業＆判定用 #
# #
$name = $form{'name'}; # 名前のデータを格納 #
$subject = $form{'subject'}; # タイトルのデータを格納 #
$message = $form{'message'}; # 本文のデータを格納 #
$url = $form{'url'}; # URLのデータを格納 #
$curl = $url; # URLのデータを複製 #
$mssid = $form{'mssid'}; # IDのデータを格納 #
# #
$name =~ s/<br>//g; # 名前からタグを除く(任意) #
$subject =~ s/<br>//g; # タイトルからをタグを除く(任意) #
$message =~ s/\n/<br>/g; # 本文の改行をタグに変換 #
# #
#/URL Decode **************************************************## #
# ERR Check ***************************************************## フォームデータに対しエラー判定をする #
if( # 入力値が異常かどうか(*性能改善余地) #
length( $message ) > 1600 || # 本文が長すぎる #
length( $message ) == 0 || # 本文がない #
(($mssid > 1024 || $mssid < 1) && $mssid ne '****') # ID値が上限以上下限以下かつ特殊文字列でない #
) # #
{ # 入力値が異常の場合 #
print "Location: http://bj006.com/cgi/error1.htm"."\n\n"; # エラーページ１へジャンプ #
} # #
else # #
{ # 入力値が異常でない場合 #
#/ERR Check ***************************************************## #
# Write Log File then Move ************************************## ログ書込みとページ移動 #
# Get Time ****************************************************## 入力時刻の取得 #
my ($sec, $min, $hour) = (0, 0, 0); # 入力時刻(秒, 分, 時) #
my ($day, $mon, $year) = (0, 0, 0); # 入力時刻(日, 月, 年) #
my ($weeko, $yday, $isdat) = (0, 0, 0); # 入力時刻(曜日, 年初からの日数, サマータイム判定) #
my $time = ""; # 整形済み入力時刻 #
my @weeka = ( 'Sun','Mon','Tue','Wed','Thu','Fri','Sat' ); # 曜日を文字列で表すため #
# #
($sec,$min,$hour,$day,$mon,$year,$weeko,$yday,$isdat) = localtime(); # 入力時刻の取得 #
$year += 1900; # 年表示のため #
$mon++; # 月表示のため #
$time = sprintf( "%04d-%02d-%02d (%s) %02d:%02d:%02d", # 入力時刻のフォーマット整形 #
$year,$mon,$day,$weeka[$weeko],$hour,$min,$sec ); # #
#/Get Time ****************************************************## #
# Get ID ******************************************************## ID文字列の取得 #
my $mystr = ""; # ID文字列 #
# #
if( $mssid ne '****' ) # 入力されたIDが特殊文字列でないかどうか #
{ # 入力されたIDが特殊文字列でない場合 #
$mystr = idroll::roll( $mssid - 1 ); # ID文字列の振出し #
} # #
else # #
{ # 入力されたIDが特殊文字列の場合 #
$mystr = '<b><font color="#00FF00">Hermit Webmaster</font></b>' # 管理人用文字列 #
} # #
#/Get ID ******************************************************## #
# GET IP and Host *********************************************## 入力者のIPアドレスとホストを取得 #
my $ipaddr = ""; # 環境変数からIPアドレスを格納する #
my $host = ""; # ホスト名を格納する #
# #
$ipaddr = $ENV{'REMOTE_ADDR'}; # 環境変数からデータを変数に格納する #
$host = gethostbyaddr( pack("C4", $ipaddr), 2 ) || $ipaddr; # IPアドレスからホスト取得、失敗したらIPアドレス #
#/GET IP and Host *********************************************## #
if( index( $url, 'http://' ) < 0 ) # 入力URLが"http://"以外で始まるかどうか #
{ # 入力URLが"http://"以外で始まる場合 #
$url = $curl = 'http://'; # デフォルト値設定とする(無視対象文字列となります) #
} # #
# #
if( $url eq 'http://' ) # 入力URLがデフォルト値かどうか #
{ # 入力URLがデフォルト値の場合 #
$url = 'URL'; # ただの文字列 #
} # #
else # 入力URLがある場合 #
{ # #
$url = "<a href=\""."$url"."\">URL</a>"; # ハイパーリンクを設定 #
} # #
# #
open LOGW, ">>./guestlog.txt" # ログファイルオープン #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したらエラーページ０へジャンプ #
flock( LOGW, 2 ) # 占有ロック #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したらエラーページ０へジャンプ #
print LOGW "$name#@#$subject#@#$message#@#$url#@#". # ログファイルへ追加書込み #
"$mystr#@#$time#@#$ipaddr#@#$host#@#\n"; # #
close( LOGW ); # ファイルクローズ #
# Set Cookie **************************************************## #
my $target = 0; # クッキーの失効時刻を定める #
my ($gsec, $gmin, $ghour) = (0, 0, 0); # GMT時刻(秒, 分, 時) #
my ($gday, $gmon, $gyear) = (0, 0, 0); # GMT時刻(日, 月, 年) #
my ($gweeko, $gyday, $gisdat) = (0, 0, 0); # GMT時刻(曜日, 年初からの日数, サマータイム判定) #
my @gmona = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', # 月文字列配列 #
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); # #
my $expire = ""; # 整形済クッキー失効時刻 #
my $cs = ""; # クッキーに保持するデータ文 #
# #
$target = time() + (60 * 60 * 24 * 90); # クッキーの生存期間を設定(この場合は90日間となる) #
($gsec,$gmin,$ghour,$gday,$gmon,$gyear,$gweeko,$gyday,$gisdat) = gmtime($target); # 期限切れ時のGMTを取得 #
$gyear += 1900; # 西暦の正規化 #
# #
$expire = sprintf( "%s, %02d-%s-%04d %02d:%02d:%02d GMT", # クッキー設定用フォーマット整形 #
$weeka[$gweeko], $gday, $gmona[$gmon], # #
$gyear, $ghour, $gmin, $gsec ); # #
# #
$cs = "$name#@#$curl#@#$mssid#@#"; # クッキーに保持するのは名前、URL、ID #
# #
print "Set-cookie:$cs; expires=$expire\n"; # クッキーの設定 #
#/Set Cookie **************************************************## #
print "Location: http://bj006.com/cgi/guestbook.cgi"."\n\n"; # すべてが正常なら、掲示板に戻る #
} # #
#/Write Log File then Move ************************************## #
exit; # 処理終了 #
ファイル名: gb_util.pl
# package gb_util *********************************************## 掲示板CGI追加機能 #
{
package gb_util;
# #
use warnings; # 警告表示 #
use strict; # 構文チェック #
# sub confirm *************************************************## 未確定ログ確定 #
sub confirm # サブルーチン: ログファイルの内容を確定する #
{ # #
my $logNum = 1; # ログ番号 for バックアップ退避 #
my $buf = ""; # 作業領域 #
# #
for( ; ; ) # 無限ループ #
{ # #
if( (-s "./LOG_MAS.txt") == (-s "./guestlog.txt") ) # ログファイルがバックアップファイルと同一かどうか #
{ # ログファイルがバックアップファイルと同一の場合 #
last; # その後の処理をせず終了 #
} # #
# #
while( -e "./LOG_MAS_$logNum.txt" ) # 対象の番号のバックアップファイルが存在する限り #
{ # #
$logNum++; # ログ番号を加算していく #
} # ループを抜けたら最新の番号となる #
rename( "./LOG_MAS.txt", "./LOG_MAS_$logNum.txt" ); # バックアップ退避 #
# #
open( INFO, "<./guestlog.txt" ) # ファイルオープン(読込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( INFO, 1 ) # 排他ロック(LOCK_SH == 1) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
read( INFO, $buf, (-s "./guestlog.txt") ); # ファイル内容を変数に読込む #
close( INFO ); # ファイルクローズ #
# #
open( OUTFO, ">./LOG_MAS.txt" ) # ファイルオープン(書込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( OUTFO, 2 ) # 排他ロック(LOCK_EX == 2) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
print OUTFO $buf; # マスタファイルの内容をログに書き込む #
close( OUTFO ); # ファイルクローズ #
# #
last; # ループ終了 #
} # #
# #
return 0; # 処理終了 #
}
#/sub confirm *************************************************## #
# sub rollback ************************************************## ログ状態のロールバック #
sub rollback # サブルーチン: ログファイルの内容を巻戻す #
{ # #
my $buf = ""; # 作業領域 #
# #
open( INFO, "<./LOG_MAS.txt" ) # ファイルオープン(読込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( INFO, 1 ) # 共有ロック(LOCK_SH == 1) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
read( INFO, $buf, (-s "./LOG_MAS.txt") ); # ファイル内容を変数に読込む #
close( INFO ); # ファイルクローズ #
# #
open( OUTFO, ">./guestlog.txt" ) # ファイルオープン(書込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( OUTFO, 2 ) # 排他ロック(LOCK_EX == 2) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
# #
seek( OUTFO, 0, 0 ); # ポインタをファイルの先頭にセット #
truncate( OUTFO, 0 ); # ファイル内容を消去 #
# #
print OUTFO $buf; # マスタファイルの内容をログに書き込む #
close( OUTFO ); # ファイルクローズ #
# #
return 0; # 処理終了 #
}
#/sub rollback ************************************************## #
# sub rollback2 ***********************************************## ログ状態のロールバック2 #
sub rollback2 # サブルーチン: ログファイルの内容を(強引に)巻戻す #
{ # #
my $buf = ""; # 作業領域 #
# #
open( INFO, "<./LOG_MAS_FRC.txt" ) # ファイルオープン(読込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( INFO, 1 ) # 共有ロック(LOCK_SH == 1) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
read( INFO, $buf, (-s "./LOG_MAS_FRC.txt") ); # ファイル内容を変数に読込む #
close( INFO ); # ファイルクローズ #
# #
open( OUTFO, ">./guestlog.txt" ) # ファイルオープン(書込み専用) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
flock( OUTFO, 2 ) # 排他ロック(LOCK_EX == 2) #
or print "Location: http://bj006.com/cgi/error0.htm"."\n\n"; # 失敗したら、エラーページ0へジャンプ #
# #
seek( OUTFO, 0, 0 ); # ポインタをファイルの先頭にセット #
truncate( OUTFO, 0 ); # ファイル内容を消去 #
# #
print OUTFO $buf; # マスタファイルの内容をログに書き込む #
close( OUTFO ); # ファイルクローズ #
# #
&gb_util::confirm(); # 確定処理も行う(!性能改善余地!) #
# #
return 0; # 処理終了 #
}
#/sub rollback ************************************************## #
1;
}
#/package gb_util *********************************************## #
** 関連ページ [#y78124f3]
[[Perl･CGI入門/パッケージを使う/ID Roll]]~
[[Perl･CGI入門/自作掲示板/HTML出力]]
** 修正履歴 [#z945a43b]
-write_r2.cgi~
--strictとwarnings~
--合わせて変数の初期化を実施。~
--ログファイルに使用する区切り文字を変更~
--本文が空の場合の処理を追加~
~
-write_r3.cgi~
--もろもろ改良~
~
-guestbook_r4.cgi~
--ログ切戻し機能実装~
--クッキー作成部の修正~
#attach( [nolist] ,[noform])
*** 参考ページ [#y6358f50]
http://www.perl-labo.org/~
http://perl.misty.ne.jp/
