#!/usr/bin/perl
#
# ----Fusaotome Web counter----
#     CGI(NRIM) version; ver 0.01
#   by izu@math.tsukuba.ac.jp
#
# powered (a little) by FUSAOTOME(TM?), JA-Chiba
#
# *counter ga mawarisugita toki ni reset shite, log ga nokorimasu.
# *shell command yobidashi ha tsukatte imasen.
# *narubeku perl naibu no kansuu de yatta tsumori.
# *nazeka konogo ni oyonde perl4 base.
# *NRIM 3g you ni saitekika shita version.
#
# tsugi no kadai: settei wo betsu file ni suru koto.
# han-you sei wo motaseru koto.
#

$tmp_dir = "./count/tmp/"; #saigo nimo dir.delimiter wo tsukerukoto.
$file = "count.dig";
$back = "count.bak";
$MaxCounterLength = 4;
$DigitPath = "digits/"; #saigo nimo dir.delimiter wo tsukerukoto.
#modified for pg-m use in 19 7 1999


require "./gifcat.pl";

&lock1;

if(-e "$tmp_dir$file"){
    open(READ, "<$tmp_dir$file") || die "$!: Cannot Read file\n";
open(BAK, ">$tmp_dir$back");
$count = <READ>;
print(BAK $count );
close BAK;
close READ; } else {

&subscribe;

}

$count ++;
#koko de suuji wo fuyasu.

if ( length($count) gt $MaxCounterLength ){
$count = 1;
#koko de reset kakeru
$logname = "Log" ;
format LOG =
Counter reset by overflow at @>>:@>>:@>> @<< @<< @<<<< JST
$hour, $min, $sec, $mday, $realmon, $realyear
.

#kokokara log file sakusei
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
open(LOG,">>$tmp_dir$logname.log");
$realmon = $mon + 1;
$realyear = $year + 1900;

write(LOG);

#GMT -> JST henkan tte douyarundakke.

close LOG;
};

$lock = "$$\.lck";

open(WRITE,">$tmp_dir$lock") || die "$!: Cannot Write Out\n";
print(WRITE $count);
close WRITE;

&lock2;

&generate;

#print $count;

exit 0;

#subroutine lock1

sub lock1{

local($list,@lists);
local($retry) = 3;
opendir(TMPDIR,"$tmp_dir");
$list = join(" ",readdir(TMPDIR));
closedir(TMPDIR);
@lists = grep(/\.lck/,split(/\s+/,$list));


while (@lists)
{
if (--$retry <= 0) {
foreach (@lists){ unlink "$tmp_dir$_" || die "$!: Error at 2\n";} die "$!: Error at 11\n"}
sleep(1);
opendir(TMPDIR,"$tmp_dir") || die "$!: Error at 3\n";
$list = join(" ",readdir(TMPDIR));
closedir(TMPDIR);
@list = grep(/\.lck/,split(/\s+/,$list));
}}

#subroutine lock2

sub lock2
{
local($list,@lists);

opendir(TMPDIR,"$tmp_dir") || die "$!: Error at 4\n";
$list = join(" ",readdir(TMPDIR));
closedir(TMPDIR);
@lists = grep(!/$lock/,grep(/\.lck/,split(/\s+/,$list)));

if (@lists){
if (-e "$tmp_dir$lock") { unlink("$tmp_dir$lock") ;} die "$!: Error at 12\n";
}

rename("$tmp_dir$lock","$tmp_dir$file") || die "$!: Error at 13\n";
}

#subroutine subscribe

sub subscribe{
$hoe = umask (0);
#hence umask() returns the previous mask value, we save it
if (! -d "count"){mkdir("count",511) || die "$!: Error at 23\n";}
chdir(count);
if (! -d "tmp"){mkdir("tmp",511) || die "$!: Error at 24\n";}
chdir("../");
umask $hoe;
#pushforward the previous value
}

#subroutine generate

sub generate{
    print "Content-type: image/gif\n\n";
for (split('',$count)){
$hoe[$i] = "$DigitPath$_\.gif";
$i++;
}
print &gifcat'gifcat(@hoe);
}