#!/usr/local/bin/perl5

#################################################
# 初期設定                                      #
#################################################

#  
# gifcatへのパス《デフォルトは同一ディレクトリ》
# 
$gifcat= './' ;
# 
# datファイルへのパス《デフォルトは同一ディレクトリ》
# 
$dat_path= './' ;
# 
# GIFファイルへのパス《gifディレクトリ以下》
# 
$gif_path= 'gif/' ;


#################################################
# 処理開始                                      #
#################################################


# Query復元処理
%query = &decode;

# datファイル名
$file_name = $query{key}.'.dat' ;

# 表示するカウンタの桁数
$keta = $query{keta};

# データファイルのフルパス
$dat_file = $dat_path.$file_name;

# 新規キーの作成
unless(-e $dat_file){

    open( FH, ">$dat_file") ||  &error_exist ;
    print FH 0 ; close(FH) ;
    chmod(0666,$dat_file) ;

}

# ロック開始
$lf = &lock || &error_exist  ;

    # 現在のデータファイルの読込み
    open( FH, "<$dat_file")  ||  &error_exist ;
    $data = <FH> ;
    close(FH);

    # データファイルの足し込み
    chomp $data; $data++;
    
    # 更新データの出力
    open( FH, ">$dat_file") || &error_exist ;
    print FH $data;
    close(FH);

# ロック解除    
&unlock($lf);

# GIFデータ出力処理
&put_gif($data, $keta);

exit;


#################################################
# サブルーチンエリア                            #
#################################################


sub put_gif {
# -----------------------------------------------
# 
# 【GIF出力処理】
# 
# -----------------------------------------------
# 【概要】
# 
# gifcat.plへ提供する為の配列情報を作成し
# gifcat.plを呼び出します。
# 
# -----------------------------------------------
# 
# 《成功時》
#  
# 第一引数：出力する数値
# 
# 第二引数：出力する桁数
# 
# -----------------------------------------------

# gifcatの読込み
require $gifcat.'gifcat.pl';

    my($cnt,$keta) = @_;

    my @cnt = reverse(split(//,$cnt));
    
    my @gif = ();

    for(0..$keta -1 ){

        unshift @gif , $gif_path .( $cnt[$_] || 0 ).'.gif';

    }
    
    binmode(STDOUT);
    
    print "Content-type: image/gif\n\n";
    print &gifcat'gifcat(@gif);

}


sub lock{
# -----------------------------------------------
# 
# 【ロック開始処理】
# 
# -----------------------------------------------
# 【概要】
# 
# ロックファイルを作成しロックを開始します
# 異常ロックの解除も行います。
# 
# -----------------------------------------------
# 
# 《成功時》
# 
# ロックファイル、その他の情報を含むハッシュへの
# リファレンスを返します。(解除で使用)
# 
# -----------------------------------------------
# 
# 《失敗時》
# 
# 未定義を返します
# 
# -----------------------------------------------

    my %lf=(lockdir => './lockdir/', 
            timeout => 15, 
            trytime => 10 );

    $lf{fname}  =  shift  ||  'lockfile' ;

    $lf{source}  =  $lf{lockdir} . $lf{fname};
    
    for ( my $i = 0; $i < $lf{trytime}; $i++ , sleep 1 ) {

        if( rename( $lf{source}, $lf{lockname} = $lf{source}.time )){
            return  \%lf ;
        }

    }

    my @flist = glob($lf{lockdir}.'*' ) ;
    
    foreach ( @flist ) {
    
        if ( /^$lf{fname}(\d+)/ ){
        
            if ( time - $1 > $lf{timeout}
                    and
            rename ( $lf{lockdir} . $_  , $lf{lockname} = $lf{source} . Time  ) ){
        
                return  \%lf  
                    
            }

             last;

        }
    }
        
    undef;
        
}


sub unlock{
# -----------------------------------------------
# 
# 【ロック解除処理】
# 
# -----------------------------------------------
# 【概要】
# 
# 引数で与えられた情報を元にロックファイルを
# ロックしていない時の状態に戻します。
# 
# -----------------------------------------------

    rename ( $_[0]->{lockname},  $_[0]->{source}  );
}


sub decode {
# -----------------------------------------------
# 
# 【Query復元処理】
# 
# -----------------------------------------------
# 【概要】
# 
# スクリプトに与えられた引数を環境変数へ代入します。
# その他不正なデータを排除します。
# 
# -----------------------------------------------
# 
# 《成功時》
# 
# 環境変数を返します。
# 
# -----------------------------------------------


    if($ENV{REQUEST_METHOD} eq 'GET' ){
        $str_query = $ENV{QUERY_STRING};
    } else {
        read(STDIN,$str_query,$ENV{CONTENT_LENGTH});
    }

    foreach ( split('&', $str_query ) ){

        my ($name, $value) = split('=',$_,2);
        $value =~ s/\+/ /g;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;

        # タグの除去
        $value =~  s/<//g;
        $value =~  s/>//g;
        $tmp{$name} = $value;
    }

    # 省略時デフォルトで"index"を使用する。
    $tmp{key} = $tmp{key} || 'index' ;
    
    # 桁数は１〜１０まで
    unless($tmp{keta} >= 1 && $tmp{keta} <= 10){ 
        $tmp{keta} = 6 ;
    }

    return %tmp;

}

sub error_exist {
# -----------------------------------------------
# 
# 【エラールーチン】
# 
# -----------------------------------------------
# 【概要】
# 
# エラー用のGIFファイルを出力します。
# 
# -----------------------------------------------

    # エラー用GIF(0)の定義
    @err_gif = ('47','49','46','38','39','61','0F','00','14','00','F7','00','00','00','00','00','33','00','00','66','00','00','99','00','00','CC','00','00','FF','00','00','00','33','00','33','33','00','66','33','00','99','33','00','CC','33','00','FF','33','00','00','66','00','33','66','00','66','66','00','99','66','00','CC','66','00',
                'FF','66','00','00','99','00','33','99','00','66','99','00','99','99','00','CC','99','00','FF','99','00','00','CC','00','33','CC','00','66','CC','00','99','CC','00','CC','CC','00','FF','CC','00','00','FF','00','33','FF','00','66','FF','00','99','FF','00','CC','FF','00','FF','FF','00','00','00','33','33','00','33','66',
                '00','33','99','00','33','CC','00','33','FF','00','33','00','33','33','33','33','33','66','33','33','99','33','33','CC','33','33','FF','33','33','00','66','33','33','66','33','66','66','33','99','66','33','CC','66','33','FF','66','33','00','99','33','33','99','33','66','99','33','99','99','33','CC','99','33','FF','99',
                '33','00','CC','33','33','CC','33','66','CC','33','99','CC','33','CC','CC','33','FF','CC','33','00','FF','33','33','FF','33','66','FF','33','99','FF','33','CC','FF','33','FF','FF','33','00','00','66','33','00','66','66','00','66','99','00','66','CC','00','66','FF','00','66','00','33','66','33','33','66','66','33','66',
                '99','33','66','CC','33','66','FF','33','66','00','66','66','33','66','66','66','66','66','99','66','66','CC','66','66','FF','66','66','00','99','66','33','99','66','66','99','66','99','99','66','CC','99','66','FF','99','66','00','CC','66','33','CC','66','66','CC','66','99','CC','66','CC','CC','66','FF','CC','66','00',
                'FF','66','33','FF','66','66','FF','66','99','FF','66','CC','FF','66','FF','FF','66','00','00','99','33','00','99','66','00','99','99','00','99','CC','00','99','FF','00','99','00','33','99','33','33','99','66','33','99','99','33','99','CC','33','99','FF','33','99','00','66','99','33','66','99','66','66','99','99','66',
                '99','CC','66','99','FF','66','99','00','99','99','33','99','99','66','99','99','99','99','99','CC','99','99','FF','99','99','00','CC','99','33','CC','99','66','CC','99','99','CC','99','CC','CC','99','FF','CC','99','00','FF','99','33','FF','99','66','FF','99','99','FF','99','CC','FF','99','FF','FF','99','00','00','CC',
                '33','00','CC','66','00','CC','99','00','CC','CC','00','CC','FF','00','CC','00','33','CC','33','33','CC','66','33','CC','99','33','CC','CC','33','CC','FF','33','CC','00','66','CC','33','66','CC','66','66','CC','99','66','CC','CC','66','CC','FF','66','CC','00','99','CC','33','99','CC','66','99','CC','99','99','CC','CC',
                '99','CC','FF','99','CC','00','CC','CC','33','CC','CC','66','CC','CC','99','CC','CC','CC','CC','CC','FF','CC','CC','00','FF','CC','33','FF','CC','66','FF','CC','99','FF','CC','CC','FF','CC','FF','FF','CC','00','00','FF','33','00','FF','66','00','FF','99','00','FF','CC','00','FF','FF','00','FF','00','33','FF','33','33',
                'FF','66','33','FF','99','33','FF','CC','33','FF','FF','33','FF','00','66','FF','33','66','FF','66','66','FF','99','66','FF','CC','66','FF','FF','66','FF','00','99','FF','33','99','FF','66','99','FF','99','99','FF','CC','99','FF','FF','99','FF','00','CC','FF','33','CC','FF','66','CC','FF','99','CC','FF','CC','CC','FF',
                'FF','CC','FF','00','FF','FF','33','FF','FF','66','FF','FF','99','FF','FF','CC','FF','FF','FF','FF','FF','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00',
                '00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00','00',
                '00','00','00','00','00','00','00','00','00','00','00','00','00','21','F9','04','01','00','00','D7','00','2C','00','00','00','00','0F','00','14','00','00','08','48','00','AF','09','1C','08','A0','20','80','81','08','09','12','2C','98','70','E1','C1','6B','0C','13','1E','34','28','90','22','C2','87','12','31','56','6C',
                '08','31','62','47','8E','16','3F','82','C4','E8','31','E3','42','8E','22','53','9A','AC','58','F2','A4','4B','89','2B','2F','6A','64','09','B3','61','C8','99','19','5B','A2','DC','C9','B3','27','C7','80','00','3B');

    binmode(STDOUT);

    print "Content-type: image/gif\n\n";

    foreach (@err_gif) {

        $data = pack('C*',hex($_));
        print $data;

    }

    exit;
}