#!/usr/local/bin/perl
#######################################################
#BooClickAndViewCounter v1.05 / this program is free. #
#bcvc.cgi (C) BooBooClub 2001-2010 #
#######################################################
#set data
$dat = 'bcvc.dat';
$refcheck = 'off';
$logging = 'on';
$log = './log.dat';
$tmp = './tmp.dat';
$nocnt = '0';
#lock
&lock;
#time
$ENV{'TZ'}='JST-9';
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = ($year + 1900);
$mon++;
if ($sec < 10) { $sec = "0$sec";}
if ($min < 10) { $min = "0$min";}
if ($hour < 10){ $hour = "0$hour";}
if ($mon < 10) { $mon = "0$mon";}
if ($mday < 10){ $mday = "0$mday";}
$time = "$year/$mon/$mday $hour:$min:$sec";
#read
if ($ENV{'REQUEST_METHOD'} eq "POST"){
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
else{
$buffer = $ENV{'QUERY_STRING'};
}
@pairs = split(/&/,$buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/\cM\n//g;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\,//g;
$value =~ s/</ig;
$value =~ s/>/>/ig;
$value =~ s/\r\n|[\r\n]/
/ig;
$FORM{$name} = $value;
}
#branch
open (DAT,"$dat");
@dat = ;
close (DAT);
foreach $data(@dat){
@data = split(/,/,$data);
if($FORM{'id'} eq $data[0]){
$id = $data[0];
$img = $data[2];
$url = $data[3];
$way = $data[4];
last;
}
}
if($FORM{'act'} eq 'n' && $way eq 'c'){
&vimage;
}
elsif($FORM{'act'} eq 'c' && $way eq 'c'){
if($FORM{'id'} ne ''){
&count;
}
&jump;
}
elsif($FORM{'act'} eq 'v' && $way eq 'v'){
if($FORM{'id'} ne ''){
&count;
}
&vimage;
}
else{
print "Content-type: text/html\n\n";
print "\n";
print ''."\n";
print "Error!\n";
print "\n";
print "
Error!
\n";
print "CGIの設定かCGI呼び出し方法に誤りがあります。\n";
print "
\n";
unlink("$lockfile");
exit 0;
}
sub count{
$nocount = 0;
if($refcheck eq 'on'){
#check
if($ENV{'HTTP_REFERER'} eq '' || $ENV{'HTTP_REFERER'} != /$id/){
$nocount = 2;
}
}
#OnceViewCheck for Click
if($FORM{'act'} eq 'c'){
open (TMP,"$tmp");
@temp = ;
close (TMP);
$ov = 0;
foreach $temp(@temp){
@temps = split(/,/,$temp);
if($temps[0] eq '' && $temps[2] eq $ENV{'REMOTE_ADDR'} && $temps[3] eq $id){
$ov++;
}
}
if($ov == 0){
$nocount = 3;
}
}
#for tmpdata
$tmptime = time();
if($nocnt ne '' && $nocnt ne '0'){
$chktime = $tmptime - (60*60*$nocnt);
open (TMP,"$tmp");
@temp = ;
close (TMP);
foreach $temp(@temp){
@temps = split(/,/,$temp);
if($temps[0] > $chktime){
push (@ntemp,$temp);
if($temps[1] eq $ENV{'REMOTE_ADDR'}){
$nocount = 1;
}
}
}
if($nocount == 0){
$ntemp = "$tmptime\,$ENV{'REMOTE_ADDR'}\,\,\n";
push(@ntemp,$ntemp);
}
open (TMP,">$tmp");
print TMP @ntemp;
close (TMP);
}
#count
if($nocount == 0){
open (DAT,"$dat");
@dat = ;
close (DAT);
foreach $data(@dat){
chomp $data;
@data = split(/,/,$data);
if($data[0] eq $id){
$data[5]++;
$data = join(',',@data);
}
$data .= "\n";
push (@ndat,$data);
}
open (CNT,">$dat");
print CNT @ndat;
close (CNT);
}
#log
if($logging eq 'on'){
$putdat = "$time\,$id\,$ENV{'REMOTE_ADDR'}\,$ENV{'REMOTE_HOST'}\,$ENV{'HTTP_REFERER'}\,$nocount\,\n";
open (LOG,">>$log");
print LOG $putdat;
close (LOG);
}
}
sub jump{
print "Location: $url\n\n";
unlink("$lockfile");
exit 0;
}
sub vimage{
$image = $img;
open(IMG,"$image");
binmode(IMG);
print "Content-type: image/gif\n\n";
binmode(STDOUT);
while(){
print;
}
close(CIMG);
if($FORM{'act'} eq 'n' && $way eq 'c'){
#tmp
$tmptime = time();
if($ENV{'REMOTE_ADDR'} ne '' && $id ne ''){
$chktime = $tmptime - (60*60*1);
open (TMP,"$tmp");
@temp = ;
close (TMP);
foreach $temp(@temp){
@temps = split(/,/,$temp);
if($temps[0] ne '' || ($temps[1] > $chktime && !($temps[2] eq $ENV{'REMOTE_ADDR'} && $temps[3] eq $id))){
push (@ntemp,$temp);
}
}
if($nocount == 0){
$ntemp = "\,$tmptime\,$ENV{'REMOTE_ADDR'}\,$id\,$url\,\n";
push(@ntemp,$ntemp);
}
open (TMP,">$tmp");
print TMP @ntemp;
close (TMP);
}
}
unlink("$lockfile");
exit 0;
}
sub lock{
$lockfile = './lock/lockfile';
$retry = 1;
until (symlink("$dat", "$lockfile")){
if (++$retry >= 30){
&lockerror;
exit 0;
}
sleep(1);
}
}
sub lockerror{
print "Content-type: text/html\n\n";
print "\n";
print ''."\n";
print "Busy!\n";
print "\n";
print "
現在サーバが混雑しています。
\n";
print "恐れ入りますがもうしばらくして再度操作を行ってください。\n";
print "
\n";
unlink("$lockfile");
exit 0;
}