Perl・CGI入門/自作掲示板/ログファイル作成
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
|
ログイン
]
開始行:
''[[FrontPage]]''
* 自作CGI掲示板のログ作成部 [#p9ea5443]
実際に作成したソースコードを公開します。~
私の掲示板では、分かりやすさのため、機能の観点でソースを...
それぞれ、表(HTML出力部: guestbook.cgi)と裏(ログファイル...
ここではログの書込みとクッキーの設定に特化したwrite.cgiを...
~
近いうちに簡単なフローなど書いてみようかと。~
クエリ、フォーム、URLデコードの仕組みについても少しまとめ...
~
ファイル名: write_r4.cgi
#!/usr/bin/perl
use warnings; ...
use strict; ...
...
require './jcode.pl'; ...
require './idroll.pl'; ...
require './gb_util.pl'; ...
...
# URL Decode *******************************************...
my $tmp0 = my $tmp1 = ""; ...
my @decopairs = (""); ...
my $key = ""; ...
my $value = ""; ...
my %form = ("", ""); ...
...
if( $ENV{'REQUEST_METHOD'} eq "POST" ) ...
{ ...
read( STDIN, $tmp0, $ENV{'CONTENT_LENGTH'} ); ...
} ...
else ...
{ ...
$tmp0 = $ENV{'QUERY_STRING'}; ...
} ...
...
@decopairs = split( /&/, $tmp0 ); ...
...
foreach $tmp1 (@decopairs) ...
{ ...
($key, $value) = split( /=/, $tmp1 ); ...
$value =~ tr/+/ /; ...
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack ("C", hex...
# jcode::convert(*value, 'sjis'); ...
jcode::h2z_sjis( \$value ); ...
$form{$key} = $value; ...
} ...
# Resist Ads *******************************************...
if( $form{'confirm'} ) ...
{ ...
&gb_util::confirm(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
elsif( $form{'rollback'} ) ...
{ ...
&gb_util::rollback(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
elsif( "2109" == $form{'mssid'} ) ...
{ ...
&gb_util::rollback2(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
#/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'}; ...
$curl = $url; ...
$mssid = $form{'mssid'}; ...
...
$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 '****') ...
) ...
{ ...
print "Location: http://bj006.com/cgi/error1.htm"."\...
} ...
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','S...
...
($sec,$min,$hour,$day,$mon,$year,$weeko,$yday,$isdat...
$year += 1900; ...
$mon++; ...
$time = sprintf( "%04d-%02d-%02d (%s) %02d:%02d:%02d...
$year,$mon,$day,$weeka[$weeko],$hour,$mi...
#/Get Time *********************************************...
# Get ID ***********************************************...
my $mystr = ""; ...
...
if( $mssid ne '****' ) ...
{ ...
$mystr = idroll::roll( $mssid - 1 ); ...
} ...
else ...
{ ...
$mystr = '<b><font color="#00FF00">Hermit Webmas...
} ...
#/Get ID ***********************************************...
# GET IP and Host **************************************...
my $ipaddr = ""; ...
my $host = ""; ...
...
$ipaddr = $ENV{'REMOTE_ADDR'}; ...
$host = gethostbyaddr( pack("C4", $ipaddr), 2 ) || $...
#/GET IP and Host **************************************...
if( index( $url, 'http://' ) < 0 ) ...
{ ...
$url = $curl = 'http://'; ...
} ...
...
if( $url eq 'http://' ) ...
{ ...
$url = 'URL'; ...
} ...
else ...
{ ...
$url = "<a href=\""."$url"."\">URL</a>"; ...
} ...
...
open LOGW, ">>./guestlog.txt" ...
or print "Location: http://bj006.com/cgi/error0....
flock( LOGW, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
print LOGW "$name#@#$subject#@#$message#@#$url#@#". ...
"$mystr#@#$time#@#$ipaddr#@#$host#@#\...
close( LOGW ); ...
# Set Cookie *******************************************...
my $target = 0; ...
my ($gsec, $gmin, $ghour) = (0, 0, 0); ...
my ($gday, $gmon, $gyear) = (0, 0, 0); ...
my ($gweeko, $gyday, $gisdat) = (0, 0, 0); ...
my @gmona = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun...
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'De...
my $expire = ""; ...
my $cs = ""; ...
...
$target = time() + (60 * 60 * 24 * 90); ...
($gsec,$gmin,$ghour,$gday,$gmon,$gyear,$gweeko,$gyda...
$gyear += 1900; ...
...
$expire = sprintf( "%s, %02d-%s-%04d %02d:%02d:%02d ...
$weeka[$gweeko], $gday, $gmona[$gmon],...
$gyear, $ghour, $gmin, $gsec ); ...
...
$cs = "$name#@#$curl#@#$mssid#@#"; ...
...
print "Set-cookie:$cs; expires=$expire\n"; ...
#/Set Cookie *******************************************...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
#/Write Log File then Move *****************************...
exit; ...
ファイル名: gb_util.pl
# package gb_util **************************************...
{
package gb_util;
...
use warnings; ...
use strict; ...
# sub confirm ******************************************...
sub confirm ...
{ ...
my $logNum = 1; ...
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/err...
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/err...
read( INFO, $buf, (-s "./guestlog.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./LOG_MAS.txt" ) ...
or print "Location: http://bj006.com/cgi/err...
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/err...
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....
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/error0....
read( INFO, $buf, (-s "./LOG_MAS.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./guestlog.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
...
seek( OUTFO, 0, 0 ); ...
truncate( OUTFO, 0 ); ...
...
print OUTFO $buf; ...
close( OUTFO ); ...
...
return 0; ...
}
#/sub rollback *****************************************...
# sub rollback2 ****************************************...
sub rollback2 ...
{ ...
my $buf = ""; ...
...
open( INFO, "<./LOG_MAS_FRC.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/error0....
read( INFO, $buf, (-s "./LOG_MAS_FRC.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./guestlog.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
...
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/
終了行:
''[[FrontPage]]''
* 自作CGI掲示板のログ作成部 [#p9ea5443]
実際に作成したソースコードを公開します。~
私の掲示板では、分かりやすさのため、機能の観点でソースを...
それぞれ、表(HTML出力部: guestbook.cgi)と裏(ログファイル...
ここではログの書込みとクッキーの設定に特化したwrite.cgiを...
~
近いうちに簡単なフローなど書いてみようかと。~
クエリ、フォーム、URLデコードの仕組みについても少しまとめ...
~
ファイル名: write_r4.cgi
#!/usr/bin/perl
use warnings; ...
use strict; ...
...
require './jcode.pl'; ...
require './idroll.pl'; ...
require './gb_util.pl'; ...
...
# URL Decode *******************************************...
my $tmp0 = my $tmp1 = ""; ...
my @decopairs = (""); ...
my $key = ""; ...
my $value = ""; ...
my %form = ("", ""); ...
...
if( $ENV{'REQUEST_METHOD'} eq "POST" ) ...
{ ...
read( STDIN, $tmp0, $ENV{'CONTENT_LENGTH'} ); ...
} ...
else ...
{ ...
$tmp0 = $ENV{'QUERY_STRING'}; ...
} ...
...
@decopairs = split( /&/, $tmp0 ); ...
...
foreach $tmp1 (@decopairs) ...
{ ...
($key, $value) = split( /=/, $tmp1 ); ...
$value =~ tr/+/ /; ...
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack ("C", hex...
# jcode::convert(*value, 'sjis'); ...
jcode::h2z_sjis( \$value ); ...
$form{$key} = $value; ...
} ...
# Resist Ads *******************************************...
if( $form{'confirm'} ) ...
{ ...
&gb_util::confirm(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
elsif( $form{'rollback'} ) ...
{ ...
&gb_util::rollback(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
elsif( "2109" == $form{'mssid'} ) ...
{ ...
&gb_util::rollback2(); ...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
#/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'}; ...
$curl = $url; ...
$mssid = $form{'mssid'}; ...
...
$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 '****') ...
) ...
{ ...
print "Location: http://bj006.com/cgi/error1.htm"."\...
} ...
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','S...
...
($sec,$min,$hour,$day,$mon,$year,$weeko,$yday,$isdat...
$year += 1900; ...
$mon++; ...
$time = sprintf( "%04d-%02d-%02d (%s) %02d:%02d:%02d...
$year,$mon,$day,$weeka[$weeko],$hour,$mi...
#/Get Time *********************************************...
# Get ID ***********************************************...
my $mystr = ""; ...
...
if( $mssid ne '****' ) ...
{ ...
$mystr = idroll::roll( $mssid - 1 ); ...
} ...
else ...
{ ...
$mystr = '<b><font color="#00FF00">Hermit Webmas...
} ...
#/Get ID ***********************************************...
# GET IP and Host **************************************...
my $ipaddr = ""; ...
my $host = ""; ...
...
$ipaddr = $ENV{'REMOTE_ADDR'}; ...
$host = gethostbyaddr( pack("C4", $ipaddr), 2 ) || $...
#/GET IP and Host **************************************...
if( index( $url, 'http://' ) < 0 ) ...
{ ...
$url = $curl = 'http://'; ...
} ...
...
if( $url eq 'http://' ) ...
{ ...
$url = 'URL'; ...
} ...
else ...
{ ...
$url = "<a href=\""."$url"."\">URL</a>"; ...
} ...
...
open LOGW, ">>./guestlog.txt" ...
or print "Location: http://bj006.com/cgi/error0....
flock( LOGW, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
print LOGW "$name#@#$subject#@#$message#@#$url#@#". ...
"$mystr#@#$time#@#$ipaddr#@#$host#@#\...
close( LOGW ); ...
# Set Cookie *******************************************...
my $target = 0; ...
my ($gsec, $gmin, $ghour) = (0, 0, 0); ...
my ($gday, $gmon, $gyear) = (0, 0, 0); ...
my ($gweeko, $gyday, $gisdat) = (0, 0, 0); ...
my @gmona = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun...
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'De...
my $expire = ""; ...
my $cs = ""; ...
...
$target = time() + (60 * 60 * 24 * 90); ...
($gsec,$gmin,$ghour,$gday,$gmon,$gyear,$gweeko,$gyda...
$gyear += 1900; ...
...
$expire = sprintf( "%s, %02d-%s-%04d %02d:%02d:%02d ...
$weeka[$gweeko], $gday, $gmona[$gmon],...
$gyear, $ghour, $gmin, $gsec ); ...
...
$cs = "$name#@#$curl#@#$mssid#@#"; ...
...
print "Set-cookie:$cs; expires=$expire\n"; ...
#/Set Cookie *******************************************...
print "Location: http://bj006.com/cgi/guestbook.cgi"...
} ...
#/Write Log File then Move *****************************...
exit; ...
ファイル名: gb_util.pl
# package gb_util **************************************...
{
package gb_util;
...
use warnings; ...
use strict; ...
# sub confirm ******************************************...
sub confirm ...
{ ...
my $logNum = 1; ...
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/err...
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/err...
read( INFO, $buf, (-s "./guestlog.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./LOG_MAS.txt" ) ...
or print "Location: http://bj006.com/cgi/err...
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/err...
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....
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/error0....
read( INFO, $buf, (-s "./LOG_MAS.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./guestlog.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
...
seek( OUTFO, 0, 0 ); ...
truncate( OUTFO, 0 ); ...
...
print OUTFO $buf; ...
close( OUTFO ); ...
...
return 0; ...
}
#/sub rollback *****************************************...
# sub rollback2 ****************************************...
sub rollback2 ...
{ ...
my $buf = ""; ...
...
open( INFO, "<./LOG_MAS_FRC.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( INFO, 1 ) ...
or print "Location: http://bj006.com/cgi/error0....
read( INFO, $buf, (-s "./LOG_MAS_FRC.txt") ); ...
close( INFO ); ...
...
open( OUTFO, ">./guestlog.txt" ) ...
or print "Location: http://bj006.com/cgi/error0....
flock( OUTFO, 2 ) ...
or print "Location: http://bj006.com/cgi/error0....
...
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/
ページ名: