エラー！！

# # util.pl # use Jcode; # # parseInput(encoding) # encoding: 日本語コード(jis|sjis|euc) # Name=>Val のハッシュ（グロブ） # sub parseInput { my($encoding) = @_; my($method) = $ENV{'REQUEST_METHOD'}; local($query, @in, $key, $val); # 日本語が必要な場合は jcode.pl を取り込む # require 'jcode.pl' if $encoding; # GETメソッドかPOSTメソッドかを判別する if ($method eq 'GET') { $query = $ENV{'QUERY_STRING'}; } # elsif ($method eq 'POST') { # read(STDIN, $query, $ENV{'CONTENT_LENGTH'}); # } # 入力データを分解する local(@query) = split(/&/, $query); # Name=Val を $in{'Name'} = 'Val' のハッシュにする。 foreach (@query) { # + を空白文字に変換 tr/+/ /; # Name=Val を分ける ($key, $val) = split(/=/); # %HH形式を元の文字にデコードする。 $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, $encoding) if ($encoding); Jcode::convert(\$key, $encoding) if ($encoding); # jcode'convert(*val, $encoding) if ($encoding); Jcode::convert(\$val, $encoding) if ($encoding); # 連想配列（ハッシュ）にセット $in{$key} = $val; } # 連想配列のグロブを返す #print "Action: " . $in{'Action'} . "
\n"; return %in; } # ロック関連の設定値 $RetryNum = 100; # リトライ回数 $Interval = 0.1; # リトライのインターバル $EX_LOCK = 2; # 排他ロック $UN_LOCK = 8; # ロック解除 $LOCKTYPE = $EX_LOCK; # ロックタイプは排他ロック $useflock = 0; # flock()を使う場合は1にする $LPrefix = 'L-'; # ロックファイルのプリフィクス # # lock(lfh, lockfile) # lfh: ロックファイルのハンドル（openLockで指定されたファイル名 # に等しい。 # lockfile: ロックファイル名 # true: 成功 false: 失敗 # sub lock($$) { my($lfh, $lockfile) = @_; if ($useflock) { # flock()を使う flock($lfh, $LOCKTYPE); return 1; } else { my($retry) = $RetryNum; while (-f $lockfile) { select(undef, undef, undef, $Interval); return undef if (--$retry <= 0); } return open($lfh, ">$lockfile"); } } # # unlock(lfh, lockfile) # lfh: ロックファイルのハンドル（openLockで指定されたファイル名 # に等しい。 # lockfile: ロックファイル名 # なし # sub unlock ($$) { my($lfh, $lockfile) = @_; if ($useflock) { # flock()を使う flock($lfh, $UN_LOCK); } else { close($lfh); unlink($lockfile); } } # # openLock(fh, modefile) # fh: ハンドル # modefile: モードを含むファイル名 # true or false # sub openLock(*$) { my($fh, $modefile) = @_; my($lockf); ($mode, $file) = ($modefile =~ /^(\+?(?:<|>>?)\s*?)(.+)$/); if ($file =~ /(\/|\\)/) { ($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/); } else { $path = ''; $filename = $file; } return undef unless $filename; $lockf = $path.$LPrefix."$filename"; # ロックファイル名 lock($filename, $lockf) or return undef; open($fh, $modefile) or unlock($filename, $lockf), return undef; return 1; } # # closeUnlock # fh: ハンドル # modefile: モードを含むファイル名 # なし # sub closeUnlock(*$) { my($fh, $file) = @_; if ($file =~ /(\/|\\)/) { ($path, $filename) = ($file =~ /^(.*[\/|\\])(.+)$/); } else { $path = ''; $filename = $file; } my($lockfile) = $path.'L-'."$filename"; # ロックファイル名 unlock($filename, $lockfile); close($fh); } # # exitError() # エラーメッセージ # なし # sub exitError { my($msg) = @_; $msg =~ s/\n/
\n/g; print < エラー！！ $msg
$! END_OF_ERR_HTML exit(1); } # # getCookie() # エラーメッセージ # なし # sub getCookie { my($cookie) = $ENV{'HTTP_COOKIE'}; # my(%cookies, @cookie); local(*cookies); my(@cookie); @cookie = split(/;\s*/, $cookie); print "cookie = @cookie\n"; foreach (@cookie) { local($name, $val) = split(/=/); print "name=$name, val=$val\n"; $cookies{$name} = $val; } return *cookies; } # # setCookie() # エラーメッセージ # なし # sub setCookie { local(*data) = @_; my($cookie); $cookie = qq(Set-Cookie: ); foreach (keys %data) { $cookie = qq($cookie $_=$data{$_};); } return $cookie; } # # ツェラーの公式より曜日を求める # グレゴリウス暦(1582年10月15日(金)午後以後)で有効 # # 年、月、日 # 曜日 (0:日曜日 - 6:土曜日) # sub getDayOfWeek { my($year, $month, $day) = @_; # 1月または2月の場合は前年の13月および14月とみなす if ($month <= 2) { --$year; $month += 12; } return (($year + int($year/4) - int($year/100) + int($year/400) + int((13*$month + 8)/5) + $day) % 7); } # # 西暦年号 # うるう年: true 平年: false # sub leap { my($year) = @_; if ($year % 100) { # 西暦年号が 100 で割り切れない if ($year % 4) { # 西暦年号が 4 で割り切れない return 0; # 平年 } else { return 1; # うるう年 } } else { # 西暦年号が 100 で割り切れる if ($year % 400) { # 西暦年号が 400 で割り切れない return 0; # 平年 } else { # 西暦年号が 400 で割り切れる if ($year % 4000) { # 西暦年号が 4000 で割り切れない return 1; # うるう年 } else { # 西暦年号が 4000 で割り切れる return 0; #平年 } } } } @LeapYear = (0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); @NormYear = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); # # 年、月 # その月の合計日数 # sub getDaysOfMonth { my($year, $month) = @_; return leap($year) ? $LeapYear[$month] : $NormYear[$month]; } 1;