#!/usr/local/bin/perl
$|=1;
#####################################################################
# #
$ver= 'kz ダウンロードカウンター ver1.41'; # 2007/012/25 #
# #
# ご意見、ご要望等ありましたら、下記までお願いいたします。 #
# #
# メール kobouz@gmail.com #
# ウェブ http://kz-soft.mine.nu #
# #
#####################################################################
#■■■■■■■■■■■■■ 初期設定 ■■■■■■■■■■■■■■■■
# パスワード （必ず変更してください!!!）
# 集計画面を見るのに必要となります。英数半角のみ。スペース不可。
$pwd = 'kaken3';
# データファイルのパスを指定できます。
# 空白の場合は 上記パスワードと同名のデータファイル（password.dat）
# が自動的に作成されます。（推奨）
$datafile = '';
# 集計画面のファイル名に、そのファイルへのリンクを張るかどうか。
# 1 = リンクを張る 0 = リンクを張らない
$link = '0';
# sendmail が使える環境の方は、ファイルがダウンロードされた都度
# その結果をメールで受け取る事ができます。
# メール受け取りの場合は、下記に必要事項を入れてください。
# 例 $sendmail = '/usr/bin/sendmail'; ←sendmailのパス
# 例 $to=$from='hoge@hoge.com'; ←宛先メールアドレス
$sendmail = '';
$to=$from = '';
# 「トクトク」など一部の Lacationヘッダが使えないサーバーの場合
# $location = '1'; に変更してください。
$location = '0';
# 背景色のトーン デフォルトは黒基調。
# 白基調にしたい場合は $bgcolor = '1'; に変更してください。
$bgcolor = '0';
#■■■■■■■■■■■■■ 設定終り ■■■■■■■■■■■■■■■■
¤t_time; # 現在時刻取得
&style; # スタイルシート設定
$host = $ENV{'REMOTE_HOST'}; # ホスト名取得
if ($host eq "") { $host = $ENV{'REMOTE_ADDR'}; }
$query = $ENV{'QUERY_STRING'}; # 引数取得
$query =~ tr/+/ /;
$query =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C",hex($1))/eg;
if (! -e "./index.html" ) { # index.html(ダミー)が存在しなかったら作る
open ( FILEHANDLE , " >>./index.html" ) ;
close ( FILEHANDLE ) ;
}
if ($datafile eq ""){ # パスワード名のデータファイルを作る
$datafile = "$pwd.dat";
}
##### 引数なしの場合（エラー） #####
if($query eq ""){
&header('引数エラー','');
print qq{
引数エラーです};
print qq{
集計画面を見る場合は http://で始まるこのCGIのURLの後ろに};
print qq{
「?あなたのパスワード」を追加してください。};
&footer;
exit;
}
##### パスワードを引数としてCGIを呼び出した場合 #####
elsif($query eq "$pwd" or $query =~/^sort_\d$pwd&/){
##### データファイル読み込み #####
open (FILE,"$datafile") || &error('ファイルがオープンできません');
@line=;
close (FILE);
##### ソート処理 #####
if($sort_1 eq "" or $sort_2 eq "" or $sort_3 eq ""){
$sort_1="sort_1$pwd&n";
$sort_2="sort_2$pwd&n";
$sort_3="sort_3$pwd&n";
}
if($query eq "sort_1$pwd&down" or $query eq "sort_1$pwd&n"){
@line=sort{ $b cmp $a }@line;
$sort_1="sort_1$pwd&up";
$sort_2="sort_2$pwd&n";
$sort_3="sort_3$pwd&n";
}elsif($query eq "sort_1$pwd&up"){
@line=sort{ $a cmp $b }@line;
$sort_1="sort_1$pwd&down";
$sort_2="sort_2$pwd&n";
$sort_3="sort_3$pwd&n";
}elsif($query eq "sort_2$pwd&down" or $query eq "sort_2$pwd&n"){
@line = map {$_->[0]}
sort {$a->[2] <=> $b->[2]}
map {[$_, split /:=:/]} @line;
$sort_2="sort_2$pwd&up";
$sort_1="sort_1$pwd&n";
$sort_3="sort_3$pwd&n";
}elsif($query eq "sort_2$pwd&up"){
@line = map {$_->[0]}
sort {$b->[2] <=> $a->[2]}
map {[$_, split /:=:/]} @line;
$sort_2="sort_2$pwd&down";
$sort_1="sort_1$pwd&n";
$sort_3="sort_3$pwd&n";
}elsif($query eq "sort_3$pwd&down" or $query eq "sort_3$pwd&n"){
@line = map {$_->[0]}
sort {$a->[3] cmp $b->[3]}
map {[$_, split /:=:/]} @line;
$sort_3="sort_3$pwd&up";
$sort_2="sort_2$pwd&n";
$sort_1="sort_1$pwd&n";
}elsif($query eq "sort_3$pwd&up"){
@line = map {$_->[0]}
sort {$b->[3] cmp $a->[3]}
map {[$_, split /:=:/]} @line;
$sort_3="sort_3$pwd&down";
$sort_2="sort_2$pwd&n";
$sort_1="sort_1$pwd&n";
}
##### HTML書き出し用ライン作成 #####
$line=qq{};
$line.=qq{（ファイル自体は削除されません。）
};
$line.=qq{
};
$line.=qq{- $ver -
};
##### HTML書き出し #####
&header('DLデータ','');
print $line;
&footer;
}
##### 削除用 #####
elsif($query=~/del=/){
(undef,$delurl,$pwdchk)=split ("=",$query);
if($pwdchk ne $pwd){&error('不正な操作です');}
##### データファイル読み込み #####
open (FILE,"+<$datafile") || &error('ファイルがオープンできません');
flock(F, 2);
@datatmp=;
##### 不要なデータを削除 #####
foreach(@datatmp){
if(/$delurl/){
next;
}else{
push @hozon,$_;
}
}
##### データファイル書き込み #####
seek(FILE,0,0);
truncate(FILE,0);
print FILE @hozon;
flock(F, 8);
close (FILE); # 保存終了
##### HTML書き出し #####
$delurl=~s/.+\/(.+$)/$1/; # http://〜 を切り捨て
&header("削除終了","");
print qq{
"$delurl" 削除終了しました
戻る};
&footer;
}
##### 引数（URL）ありでCGIを呼び出した場合 #####
else{
##### データファイルが存在しなかったら作る #####
if (! -e "$datafile"){
open (FILE , ">>$datafile") ;
close (FILE) ;
# chmod (0666, "$datafile");
}
##### データファイル読み込み #####
open (FILE,"+<$datafile") || &error('ファイルがオープンできません');
flock(F, 2);
@datatmp=;
##### カウンター処理 #####
$hit=0;
foreach(@datatmp){
if(/$query/){
($file,$num,undef)=split (/:=:/,$_);
$num++;
$kousin="$file:=:$num:=:$date\n";
push @hozon,$kousin;
$hit=1;
}else{
push @hozon,$_;
}
}
##### 新規データ登録 #####
if ($hit == 0){
$new="$query:=:1:=:$date\n";
unshift @hozon,$new;
}
##### データファイル書き込み #####
seek(FILE,0,0);
truncate(FILE,0);
print FILE @hozon;
flock(F, 8);
close (FILE); # 保存終了
##### メール送信 #####
if($sendmail){
$query_m=$query;
$query_m=~s/.+\/(.+$)/$1/;
$mail_line="次のファイルがダウンロードされました。\n";
$mail_line.="━"x32;
$mail_line.="\n";
$mail_line.=" ファイル名 ： $query_m\n";
$mail_line.=" DL 日時 ： $year\/$month\/$day $hour:$min\n";
$mail_line.=" DL ホスト名 ： $host\n";
$mail_line.="━"x32;
&send_mail;
}
##### ダウンロード処理 #####
if ($location ne "1"){
print "Location: $query\n\n";
}else{
print "Content-type: text/html\n\n";
print "";
print "\n";
print "\n";
}
}
exit;
#エラー処理 --------------------------------------------#
sub error{
print "Content-type: text/html\n\n";
print "ERROR
$_[0]
";
exit;
}
# 現在日付取得 ------------------------------------------------------#
sub current_time{
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
$year=sprintf("%04d",$year + 1900);
$month=sprintf("%02d",$mon +1);
$day=sprintf("%02d",$mday);
$hour=sprintf("%02d",$hour);
$min=sprintf("%02d",$min);
$sec=sprintf("%02d",$sec);
@wday_array = ('日','月','火','水','木','金','土');
$week=$wday_array[$wday];
$date="$year/$month/$day";
}
# HTMLヘッダー / フッター -------------------------------------------#
sub header { # 引数 = HTMLのタイトル,BODYタグ,スタイルシート
my($html_title,$html_body) = @_ ;
print "Content-type: text/html; charset=Shift_JIS\n\n";
print "\n\n";
print "\n\n";
print "\n";
print "$html_title\n";
print "\n";
print "$html_style" ;
print "$html_body" ;
}
sub footer {
print "\n";
}
# メール送信（sendmail） --------------------------------------------#
sub send_mail{
open(MAIL, "| $sendmail -t") || &error('sendmailのエラーです'); ;
print MAIL "From: $from\n";
print MAIL "To: $to\n";
print MAIL "Subject: \"$query_m\" downloaded\n";
print MAIL "X-Mailer: $ver\n\n\n";
print MAIL "$mail_line";
print MAIL "\n";
close(MAIL);
}
# スタイルシート --------------------------------------------#
sub style{
if ($bgcolor){
$html_style = "