#! /usr/bin/perl
print "Content-type: text/html\n\n";
#(print関数 指定された文字列や変数の内容を画面等に出力する組込関数)ebina
#HTTPヘッダを出力しています。このヘッダは、ブラウザに対して出力がHTML形式であることを伝えます。
#---------------------------------------------------
# 残席ARENAメールのご案内リンクを集計する 2011/11/10 yoshida
#
#---------------------------------------------------
$para = $ENV{"QUERY_STRING"},"\n";
#パラメータゲット
#クエリ文字列を取得し、変数 $para に格納しています。クエリ文字列は、ウェブブラウザから送信された情報を含んでいます。
$para =~ s/%(..)/pack("c",hex($1))/ge;
#URLエンコードされた文字列をデコードしています。。
#--------頭の一文字目が飛ぶことがあるので、飛んでいたら追加する
#パラメータの先頭が "/" でない場合、先頭に "/" を追加しています。
$topfn = substr($para,0,1);
if ($topfn ne "/") {
$para = "/" . "$para";
}
@para = split(/\//,$para);
#パラメータを「/」で分割して分析する
#パラメータを "/" で分割し、配列 @para に格納しています。
#---------PDFファイルはセキュアDIRに置いてあるので、その時はhttps://とする。それ以外はhttp://。
#パラメータの最後が "pdf" である場合、URLの先頭を "https://www.maitabi.jp" に設定し、それ以外の場合は "https://www.maitabi.jp/atp/atp.php?" に設定します。
$lastfn = $para[-1];
if ($lastfn =~ /pdf/) {
$paratop = "https://dev.maitabi.jp";
} else {
$paratop = "https://dev.maitabi.jp/atp/atp.php?";
}
#----------旅行番号かPDFかによって、httpかhttpsかを切り分ける
#パラメータを含むURLを構築します。
$para = "$paratop" . "$para";
#HTMLのmetaタグを使用して、リダイレクト先のURLを指定しています。
print "";
&logout();
#アクセス状況保存、
#logout サブルーチンを呼び出しています。
#========================
#ログアウト処理を行うサブルーチンが定義されています。ログファイルにユーザーエージェントやリモートアドレスなどの情報を記録し、古いログファイルを削除しています。このスクリプトは、HTTPリクエストを処理し、リダイレクトさせると同時にログを記録する役割を果たしています。
sub logout {
$agent = $ENV{"HTTP_USER_AGENT"};
$raddr = $ENV{"REMOTE_ADDR"};
$docroot = $ENV{"DOCUMENT_ROOT"};
$promei = $ENV{"SCRIPT_FILENAME"};
($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
$nen = $year + 1900;
$tuki = $mon + 1;
$tuki = sprintf("%.2d",$tuki);
$hi = $mday; $hi = sprintf("%.2d",$hi);
$logfn = "arena/" . "$nen$tuki$hi" . "perl.log";
open (OUT,">>$logfn");
print OUT "$nen/$tuki/$hi $hour:$min:$sec $raddr ($promei,$para)($agent)\n";
#----------ログの後片付け
($sec, $min, $hour, $mday, $mon, $year) = localtime(time - 60*60*24*365*1);
$snen = $year + 1900;
$stuki = $mon + 1;
$stuki = sprintf("%.2d",$stuki);
$shi = $mday;
$hi = sprintf("%.2d",$hi);
$sakunen = "$snen$stuki$shi";
while (<./arena/*.log>) {
$gfn = $_; #/arena/20140414perl.log
@gfn = split(/\//,$gfn);
$lfn = $gfn[-1];
$logyyyymmdd = substr($lfn,0,8);
# print OUT "($logyyyymmdd) < ($sakunen)\n";
if ($logyyyymmdd < $sakunen) {
unlink "$gfn";
# print OUT "unlink ($gfn)\n";
}
}
close (OUT);
}