![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
#freeze
''[[FrontPage]]''
* 自作ファイルアップローダのログファイル生成部 [#ea58f06a]
実際に作成したソースコードを公開します。~
掲示板と同様、機能の観点でファイルを２つに分けています。~
それぞれ、表(HTML出力部: dfh.cgi)と裏(ログファイル作成部: write.cgi)といったかたちで。~
ここではログの生成に特化したwrite.cgiを、コメント中にて解説しています。~
~
~
ファイル名: write_f_r2.cgi
#!/usr/bin/perl
use warnings; # 警告表示 #
use strict; # 構文チェック #
use CGI; # for "multipart/form-data" #
# #
require './jcode.pl'; # for URLデコード #
require './idroll.pl'; # for ID文字列振出し #
# #
# URL Decode **************************************************## フォームデコード #
my $cgi = CGI::new(); # 実操作用ハッシュ #
# #
my $name = ""; # 作業用 #
my $comment = ""; # 作業用 #
my $infile = ""; # 作業＆判定用 #
my $pwd = ""; # 作業＆判定用 #
my $url = ""; # 作業用 #
my $curl = ""; # クッキー設定用 #
my $mssid = ""; # 作業＆判定用 #
# #
$name = $cgi->param('name'); # 名前のデータを格納 #
$comment = $cgi->param('comment'); # タイトルのデータを格納 #
$infile = $cgi->param('file'); # フォームのファイル名データを格納 #
$pwd = $cgi->param('pwd'); # 投稿パスワードのデータを格納 #
$url = $curl = $cgi->param('url'); # URLデータを格納 #
$mssid = $cgi->param('mssid'); # IDデータを格納 #
# #
$name =~ s/<br>//g; # 名前からタグを取り除く(任意) #
$comment =~ s/<br>//g; # コメントタグを取り除く(任意) #
# #
jcode::h2z_sjis( \$name ); # 半角カナ → 全角カナ #
jcode::h2z_sjis( \$comment ); # 半角カナ → 全角カナ #
#/URL Decode **************************************************## #
# ERR Check ***************************************************## フォームデータに対しエラー判定をする #
my $size = 0; # 作業＆判定用 #
my $filename = ""; # 作業＆判定用 #
my @path = (""); # 作業＆判定用 #
# #
$size = (-s $infile); # ファイルサイズの取得 #
# #
if( $ENV{'HTTP_USER_AGENT'} =~ /Win/ || # ユーザーのOSがwindows系かどうか #
$ENV{'HTTP_USER_AGENT'} =~ /win/ ) # #
{ # ユーザーのOSがwindows系の場合 #
@path = split( /\\/, $infile ); # '\'を区切り文字としてフォームのファイルパスを分割#
} # #
else # ユーザーのOSがwindows系以外の場合 #
{ # #
@path = split( /\//, $infile ); # '/'を区切り文字としてフォームのファイルパスを分割#
} # #
# #
$filename = pop( @path ); # #
$filename = "./attach/" . $filename; # #
# #
if( # 入力値が異常かどうか(*性能改善余地) #
$infile eq "" || # ファイル名が未入力 #
$pwd ne "****" || # 投稿パスワードが正しくない #
(-e $filename) || # 指定のファイル名がユーザー上に既に存在する #
(-s $infile > (5 * 1024 * 1024)) || # ファイルサイズが5Mを超える #
($size == 0) || !(-e $infile) || # 指定ファイルが無効または存在しない #
(($mssid > 1024 || $mssid < 1) && $mssid ne '****') # ID値が上限以上下限以下かつ特殊文字列でない #
) # #
{ # 入力値が異常の場合 #
print "Location: http://bj006.com/cgi/error3.htm"."\n\n"; # エラーページ３へジャンプ(パラメータエラー) #
} # #
elsif( !index( $ENV{'HTTP_REFERER'}, "http://bj006.com/cgi/dfh" ) && # 外部からの不正なアクセスかどうか #
!index( $ENV{'HTTP_REFERER'}, "http://www.bj006.com/cgi/dfh" ) ) # #
{ # 不正なアクセスである場合 #
print "Location: http://bj006.com/cgi/error9.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(); # 入力時刻の取得 #
$mon++; # 月表示のため #
$year += 1900; # 年表示のため #
$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 *********************************************## #
while($size =~ s/(.*\d)(\d\d\d)/$1,$2/){} # サイズに3桁ごとカンマを付加する #
# #
open( OUTFO, ">$filename" ) # ファイルオープン #
or print "Location: http://bj006.com/cgi/error2.htm"."\n\n"; # 失敗時はエラーページ2(内部エラー)へジャンプ #
flock( OUTFO, 2 ) # 排他ロック #
or print "Location: http://bj006.com/cgi/error2.htm"."\n\n"; # 失敗時はエラーページ2(内部エラー)へジャンプ #
binmode( OUTFO ); # バイナリモードで操作 #
# #
while( <$infile> ) # 元ファイルから1行ずつファイル内容を読込む #
{ # 元ファイルのデータ行がある限り #
print OUTFO $_; # 先ファイルにファイル内容を書込む #
} # #
# #
close( OUTFO ); # ファイルクローズ #
close( $infile ) if ($CGI::OS ne 'UNIX'); # CGIモジュールの使い方がよく分からない #
# close( $infile ); # 不明だが一応書いておく？ #
# #
$filename =~ s/.\/attach\///; # 文字列の置換 ファイル名からパスを除く #
# #
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, ">>./filelog.txt" # ログファイルオープン #
or print "Location: http://bj006.com/cgi/error2.htm"."\n\n"; # 失敗時はエラーページ2(内部エラー)へジャンプ #
flock( LOGW, 2 ) # 占有ロック #
or print "Location: http://bj006.com/cgi/error2.htm"."\n\n"; # 失敗時はエラーページ2(内部エラー)へジャンプ #
print LOGW "$name#@#$comment#@#$filename#@#$size#@#". # ログファイルへ追加書込み #
"$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/dfh/dfh.cgi"."\n\n"; # すべてが正常なら、掲示板に戻る #
} # #
#/Write Log File then Move ************************************## #
exit; # 処理終了 #
** 関連ページ [#o43acf5b]
[[Perl･CGI入門/パッケージを使う/ID Roll]]~
[[Perl･CGI入門/ファイルアップローダ/HTML出力]]
** 修正履歴 [#g98babae]
#attach( [nolist] ,[noform])
*** 参考ページ [#bffcccc6]
http://www.perl-labo.org/~
http://perl.misty.ne.jp/~
[[Perlメモ/CGIモジュール:http://digit.que.ne.jp/work/index.cgi?Perl%E3%83%A1%E3%83%A2%2FCGI%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB#i1]]~
