#!/usr/bin/perl
#↑ここを自分のプロバイダにあわせて書き換えます。

# AccessLogger Model4-------------------
# -------------- LastUpdate [2002/02/15]
# 2004 Kazuhiro Nomura -------------------
# WEB : http://www.imaginet.ne.jp/~nobu/
# mail: nobu@pt.imaginet.ne.jp ---------


# --設定項目----------------------
# $PageUrl は $PageUrl[0] に置き換わりました。

 $PageUrl[0] = '';             # ログをとるページのURL。リンク元がこのURLを含む場合はログをとらない。
#$PageUrl[1] = '';             # ページが複数のURLを持つ場合、このように指定。[2],[3],...と増やせます。
#$PageUrl[2] = '';

# パス/URL等
 $Redirect = 'html/dummy.gif'; # 呼び出し後に表示する画像のURL。
 $DataDir  = 'data/';          # データ保存用フォルダへのパス。
 $Jcode    = 'jcode.pl';       # jcode.plへのパス

# ファイルロック処理
 $LockTryMax = 10;             # ロック処理の待ち時間[秒]
 $LockLimit  = 5;              # 強制ロック解除までの時間[秒]

# 重複ロック by クッキー
 $CookLimit = 0;               # 重複アクセスを排除する時間[秒]
#$CookLimit = 60*60*2;         # 0 の時、この機能を利用しない

 $CookName  = 'AccessLog4';    # 上に使用するクッキー名
 $CookValue = 'OverrapCheck!'; # 同じくクッキーの値

# 重複ロック by IP履歴 (こちらの方がクッキーより確実？)
 $IpLockLimit = 0;             # 重複アクセスを排除する時間[秒]
#$IpLockLimit = 60*60*2;       # 0 の時、この機能を利用しない

 $IpLogfile = $DataDir . "IpLock.dat";
                               # 上に使用するファイル名(変更不要)



# その他 ---------

 $OffLine = 0;                 # gethostbyaddr()が使えない場合'1'を指定。
#$OffLine = 1;

 $SSI     = 0;                 # SSIで呼び出す場合'1'を指定。
#$SSI     = 1;

 $TimeDiff    = 0;             # サーバからの時間差を指定。
 $RecEachExit = 1;             # ページ毎カウントで'のべ'ヒット数を記録。

 $KeyDivide   = 0;             # 検索キーのペアを項目として保存する場合 '0'
                               # 検索キーのペアを分割して保存する場合 '1' 

 %Search = (                   # サーチエンジンの設定。

#	'含むURL(正規表現使用可)',            '検索キーのフィールド名',
#NEW#
	'google\.ne\.jp',                     'q',     # 

	'yahoo\.co\.jp',                      'p',     # YahooJapan
	'www\.infoseek\.co\.jp',              'qt',    # InfoseekJapan
	'japan\.infoseek\.co\.jp',            'qt',    # 
	'www\.goo\.ne\.jp',                   'MT',    # Goo
	'search\.fresheye\.com',              'kw',    # fresh eye
	'www\.lycos\.co\.jp',                 'query', # lycos
	'search\.netplaza\.biglobe\.ne\.jp',  'key',   # netplaza

);


# !) 各サーチエンジンの情報は 99年4月18日現在のモノです。

 return(1) if( $isTestLoad );
 umask(0111);

#----------------------------------------------------------
# 以下新設項目

#$GetBrowserMinerVersion; # 未対応
#$REMOTE_ADDR_MASK[0] = '^127\.0\.0\.1$'; # REMOTE_ADDR がこれに一致する場合記録しない
#$REMOTE_HOST_MASK[0] = '';               # REMOTE_HOST がこれに一致する場合記録しない




#-------------------------------

# ToDo
# build #--- : ブラウザのマイナーバージョン抽出
# build #--- : データ日付の年を４桁に変更
# build #--- : OS名に略称を用いないよう変更(過去データとの整合・・)

# History

 $Ver       = '#069e';

#[2002/02/15]
# build #069 : IPアドレスによる一定期間内アクセスの排除機能を実装
# build #068 : 拒否IP/拒否ホストに対応。ただしチェックするのは環境変数のみ
# build #067 : OSXになんとなく対応
# build #066 : 複数PageURLに対応, $PageUrl は $PageUrl[0] に対応
# build #065 : $PageURLが無くても動作するようにした

#[2002/01/29]
# build #064 : WinXPとNetscape6に対応してみたつもり

#[2001/11/20]
# build #063 : Unixの判定(X-Window)を修正

#[2000/04/24]
# build #062 : OSにWin2000 WinMe 追加
# build #061 : 設定部分の重複を削除
# build #060 : Google を追加


# build #059 : Cook  クッキーのフォーマットをrfcに合わせて修正。
# build #058 : Each  &FileNameOfにEachが無かったのを修正。
# build #057 : Word  全角スペースで区切られた検索キーも分ける。(キー分割モードの時)
# build #056 : Reff  Yahooカテゴリからのリンク元処理を正常に。CGIからのアクセス判定を強化。
# build #055 : Reff  複数のサーチエンジンに、設定変更だけで対応可能に。

# build #054 : Sys   $CookLimitが[0]の時、cookieを発行しないようにした
# build #053 : Sys   不明データを書き出す部分を修正。
# build #052 : Sys   cookieの有効期限部分(年)を４桁出力に修正。
# build #051 : Sys   cookieが正しく発行されていなかったのを修正。(cookie_name/cookie_valueとなっていた)
# build #050 : Sys   cookieを発行しブラウザのbackボタンで戻ってきたときに起こる
#                    ２重記録を確実にシャットアウトするオプションを追加。(デフォルトではoff)

# [99/01/19]

# build #049 :       jcode.plのロード失敗を検出。
# build #048 :       修正部分が有効になっていなかったのを修正。
# build #047 :       不明データ出力で重複するモノはカットするように。
# build #046 : Ref   不明データ出力部を修正。(DirectAccessになっていた。)
# build #045 :       時差設定を追加。($TimeDiff)
# build #044 : Agent ブラウザ名取得部分を少し修正。
# build #043 : Ref   リンク元に「'」や「bookmarks」が入るのを仮修正。DirectAccessとして扱う。

# [98/10/29]

# build #042 :       ホストのデフォルト値がうまくセットできなかったのを修正。
# build #041 : perl4 データヘッダが出力されない点を修正。(データがないのに @Dataが１を返す。。？)
# build #040 :       if であるべきところが elsif になっていたのを修正。(RecMain)
# build #039 :       DyasData ディレクトリ作成時umask(0000)を一時的に指定。777出ないとファイル作成出来ないため。
# build #038 : perl4 undefを左辺値に使わないように修正。

# build #037 :       umask(0111);を追加。mkdir()のパーミッションを変更。
# build #036 :       全体のコードの調整。(特にRec/Days/Word)
# build #035 : Host  'localhost'の例外処理を追加。
# build #034 :       DataDirの存在チェックを追加。
# build #033 : Host  ホスト名が分かっているときにもgethostbyaddr()を呼んでいたのを修正。
# build #032 : Host  $OffLineの処理を変更。
# build #031 :       不明データの出力処理を変更。
# build #030 :       変数名を一部変更。localを多用(いいんだろうか？)
# build #029 : Agent Unkown -> Unknown を修正。
# build #028 : Agent 「'」が抜けているのを修正。

# [98/10/24]

# build #027 : ブックマークなどの直接アクセスの大部分が取得できていなかったのを修正。
#              JavaScriptでリンク元がなかったとき、環境変数を調べていたため、
#              リンク元を設置URLと解釈してしまい、重複チェックではねられていました。

# build #026 : $PageUrlが設定されていないと動かなかったが、エラー出力するように変更。
# build #025 : ロック部分の修正。ちょっとヤバかったかも。
# build #024 : SSIでの呼び出しに対応。($SSI=1;)
# build #023 : gooに仮対応。
# build #022 : 引数に含まれる'<'や'>'の処理を追加。表が崩れるのを防ぐ。
# build #021 : mdayが２桁になってなかったのを修正。
# build #020 : JavaScriptのエラー、mailbox:に対応。
# build #019 : WORDのヘッダが消えてしまうのを修正。
# build #018 : 月別データのファイル数を減らす。
# build #017 : データにヘッダを出力するように。
# build #016 : 日別データ保存に対応。なかなか試行錯誤。
# build #015 : 大部分を全部最初から書き直す。

# build #014 : &UnLockErrの呼び出しミス修正。
# build #013 : &LockErrの呼び出し部分を整理。
# build #012 : umask()がよくわからないので不安だが、生成するディレクトリのパーミッションがおかしかったのを修正。
# build #011 : エラー出力形式の変更。ana3.cgiがうまく動かないのを防ぐ。
# build #010 : ロック強制解除機構作成。
# build #009 : &UnLockの返す%LOCKEDの値を修正。
# build #008 : ロック失敗時にログを残すようにした。
# build #007 : データ保存前にロックの解除を行っていたのを修正。
# build #006 : ローカルファイルからのリンクを記録しない。
# build #005 : ディレクトリを使ったファイルロック採用。
# build #004 : 半角カナの処理を修正。
# build #003 : Osにwin98を追加。
# build #002 : 引数なしの場合、環境変数からリンク元取得。＜SSI用
# build #001 : log3.cgiの後継。特に変更なし。

#---


# log.cgi - メイン処理

# 設置URLが無いとき。
#&catErr('$PageUrlが設定されていません。'  ) if(!$PageUrl   );
 &catErr('データディレクトリがありません。') if(!-e $DataDir);

 &ChkCook;
 &SetCook  if(!$CookLock);

 #---

 eval{ require $Jcode; };
 &catErr("jcode.plのロードに失敗しました($@)") if( $@ );

 &Redirect;                # redirect
 exit if(&isMaskedAccess); # 拒否アドレスなら無視

 &GetFileName;    # filename
 &GetRefData;     # ref/key
 &WrapExit if( $CookLock || &isFromInnerPages($Reff) || &isIpLocked );

 &GetAgentData;   # agent/os
 &GetHostName;    # host/ip

 &Record;         # save


1;



####################################################################################################
# IP LOCK ROUTINES
# 訪問者のIPアドレスを逐一記録し、一定期間内に同じIPからの
# アクセスが有れば1を返すルーチン

sub isIpLocked{
	local $result; # 結果の値
	local $now;    # 現在の時刻(秒)
	local @log;    # IPの履歴  形式: IP<Tab>time\n
	local @new;    # まだ有効な履歴を抽出したもの

	return 0 if(!$IpLockLimit);   # フラグがoffならなにもしない

	# ファイルを処理することに対するロック
	$RecAct = 'ip_lock'; # ロックファイル名はこの変数
	&Lock;               # ロック処理。なんで上の変数を引数を取らないのかすごい疑問。(今となっては、だけど)

	$now = int(time);    # 秒

	# ファイルが無ければ作成する
	if(!-r $IpLogfile){
		open(IPF,">>$IpLogfile") || catErr("ファイルのオープンに失敗しました。(>$IP_logfile : $!)");
		close(IPF);
	}

	# IPの履歴を取り出す
	open(IPF,"$IpLogfile") || catErr("ファイルのオープンに失敗しました。($IP_logfile: $!)");
	@log = <IPF>;
	close(IPF);

	for $line(@log){
		$_ = $line;
		chomp;
		($addr,$time)=split(/\t/);

		# 新しいものだけ抽出
		if($now - $time < $IpLockLimit){
			push(@new,$line);
			# そのなかで一致すれば TRUE 
			if($ENV{REMOTE_ADDR} eq $addr){
				$result = 1;
			}
		}
	}

	# 一致しなければ新規に追加
	if(!$result){
		push(@new,"$ENV{REMOTE_ADDR}\t$now\n");
	}

	# 新しいリストを登録
	open(IPF,">$IpLogfile") || catErr("ファイルのオープンに失敗しました。(>$IP_logfile : $!)");
	print IPF @new;
	close(IPF);

	&UnLock;
	return $result;
}


####################################################################################################

# ページ内からのリンクかどうかを判別
# global @PageUrl

sub isFromInnerPages{
	local($reff)=shift;

	for $pat(@PageUrl){
		next if(!$pat);
		next if(!$pat || $pat =~ m|^http://$|i );
		return 1 if($reff =~ /$pat/);
	}
}

# マスクアドレス/ホストのチェック
sub isMaskedAccess{
	for $mask(@REMOTE_ADDR_MASK){
		return 1 if($ENV{REMOTE_ADDR} =~ /$mask/)
	}
	for $mask(@REMOTE_HOST_MASK){
		return 1 if($ENV{REMOTE_HOST} =~ /$mask/)
	}
}

####################################################################################################


sub GetRefData{
	# リンク元の解析。

	local ( $tmp,$dummy,@tmp );


	($Each,$Reff) = split(/@/,$ENV{QUERY_STRING},2);
	 $Each = 'Default' if(!$Each);

	$Reff  = $ENV{'HTTP_REFERER'} if($SSI && !$Reff);   # $SSI=1で、Jsを使わないとき。
	$Reff  = $ENV{'REFERER_URL'}  if($SSI && !$Reff);   # 上に同じ。

	&ChkSearchWords;

	$Reff =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

	   if(!$Reff)                 { $Reff = 'Direct Access.';}
	elsif( $Reff =~ /^file:/ )    { $Reff = 'Direct Access.';} # ローカルファイル
	elsif( $Reff =~ /^mailbox:/ ) { $Reff = 'Direct Access.';} # メールボックス
	elsif( $Reff !~ /^http:/ )    { &ana( $Reff );             # 不明なアクセス
	                                $Reff = 'Direct Access.';}
	else{

#		&jcode'convert( *Reff,'euc');         # 変換によってアドレスが変わるのでヤメ。
		$Reff =~ s/\?/\&\#63;/g;              # これはいらない？ '?'のエスケープ
		$Reff =~ s/</&lt;/g;                  # テーブルが崩れるのを防止。
		$Reff =~ s/\r|\n/ /g;                 # 改行によるデータ破損防止。

	}
}


sub ChkSearchWords{
	# KeyWordの取得 ( @Wordsの設定 )


	return if( $Reff !~ /^(http:.+)\?(.+\=.+)$/ ); # [?]と[=]をこの順で含む

	local($sURL,$sKEY,$Words);
	local($RefURL,$Query) = ($1,$2);

	while( ($sURL,$sKEY) = each %Search ){
		if( $RefURL =~ /$sURL/ && $Query =~ /$sKEY\=/ ){
			$Words = &GetQuery( $Query, $sKEY );
			last;
		}
	}

	return if(!$Words);


	$Words =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$Words =~ tr/^[A-Z]/^[a-z]/;

	# EUCに変換
	&jcode'h2z_euc( *Words );      # ほとんどの場合ページと同じEUCコード。違う場合文字化け。
	&jcode'convert( *Words,'euc'); # 文字コードの変換
#	&jcode'tr(      *Words, '｣�-｣ﾚ','a-Z'); # ２バイト=>１バイト

	$Words =~ s/</&lt;/g;          # キーに<td>等が含まれる場合(一応)
	$Words =~ s/\r|\n/ /g;         # 改行によるデータ破損防止。


	if( $KeyDivide ){
		@Words = split (/\+|｡｡/,$Words); # (半角|全角)スペース(EUC)で分割。
	}
	else{
		@tmp   = split (/\+|｡｡/,$Words);
		@Words = ( join( ', ', sort(@tmp)) );
	}

	$Reff = $RefURL;
	$Reff =~ s|^(http://[^/]+/)(.+)$|$1|;
	# /bin/search など、検索プログラムへのパスを削除。。(ダメ？)

}

sub GetQuery{
	# QUERY_STRINGからKeyに対応するフォーム値を返す。

	local(@pairs);
	local($query, $key ) = @_;

	@pairs =  split(/\&/, $query );

	for( @pairs ){
		if( /^$key\=(.+)$/ ){
			return $1;
		}
	}

	return "";

}

1;

#--- end of 'getReff.pl' ----

sub GetAgentData{
	# ブラウザ、OSの判定

	local( $tmp );
	$tmp = $ENV{'HTTP_USER_AGENT'};

	for ( $tmp ){
		( $_ ) = split(/ *via/);          #プロクシ情報の削除。

	# OS判定
	    if( /Win/ && /98/ && /Win 9x 4\.90/){ $Os = 'winMe';   } #NEW#
	 elsif( /Win/ && /98/)                  { $Os = 'win98';   }
	 elsif( /Win/ && /95/)                  { $Os = 'win95';   }
	 elsif( /Win/ && /16/)                  { $Os = 'win3.1';  }
	 elsif( /Win/ && /NT 5.1/)              { $Os = 'winXP';   } #NEW#
#	 elsif( /Win/ && /XP/)                  { $Os = 'winXP';   } #NEW#
	 elsif( /Win/ && /NT 5.0/)              { $Os = 'win2000'; } #NEW#
#	 elsif( /Win/ && /2000/)                { $Os = 'win2000'; } #NEW#
	 elsif( /Win/ && /NT/)                  { $Os = 'winNT';   }

	 elsif( /Mac/ && /OS X/)   { $Os = 'MacOSX';  }
	 elsif( /Mac/ && /68/)     { $Os = 'Mac68K';  }
	 elsif( /Mac/ && /PowerPC/){ $Os = 'MacPPC';  }
	 elsif( /Mac/ && /PPC/)    { $Os = 'MacPPC';  }


#	 elsif( /Linux/ )    { $Os = 'Linux';    }
#	 elsif( /SunOS/ )    { $Os = 'SunOS';    }
#	 elsif( /FreeBSD/ )  { $Os = 'FreeBSD';  }
	 elsif( /X11/ )      { $Os = 'Unix';     } # 

	 else                      { &ana( $_ );    }         # 不明データ

	# ブラウザ判定

	    if( /MSIE (\d)/     ){  $Agent  = "Internet Explorer $1.x";} # MsIE
	 elsif(m|Netscape6/(\d)|){  $Agent  = "Netscape 6.x";          } # Netscape6 NEW
	 elsif(m|Mozilla/(\d)|  ){  $Agent  = "Netscape $1.x";         } # Netscape
	 elsif(m|(\S+)/(\d)|    ){  $Agent  = "$1 $2.x";                 &ana( $_ ); } # 汎用１ Name/Ver
	 elsif( /\(/            ){ ($Agent) = split(/\(/); chop($Agent); &ana( $_ ); } # 汎用２ Name (...)
	 else {                     $Agent  = $_;                        &ana( $_ ); } # 汎用３ Name Ver

	$Os    = 'Unknown' if(!$Os);                           # 不明データ
	$Agent = 'Unknown' if(!$Agent);                        # 不明データ

	}

}

1;
#---

sub GetHostName{
	# ホスト名取得 / IPのマスク処理

	local( $tmp, @tmp);

	$Host = $ENV{'REMOTE_HOST'};
	$Addr = $ENV{'REMOTE_ADDR'};

	if( $Host eq $Addr || !$Host ){
		  @tmp = split(/\./, $Addr );
		  $tmp = pack('C4',  @tmp );
		 ($Host) = gethostbyaddr($tmp,2) if(!$OffLine);
	}

	return if( $Host eq 'localhost');

	# host/ip mask (.+) は当てはまる中で一番長い文字列にマッチする。
	   if( $Host =~ /^(.+)\.(.+)\.(.+)\.(.+)$/ ) { $Host = "www\.$2\.$3\.$4";     } 
	elsif( $Host =~ /^(.+)\.(.+)\.(.+)$/       ) { $Host = "www\.$2\.$3";         }
	elsif( $Addr =~ /^(.+)\.(\d+)$/            ) { &ana( $Host ) if ( $Host);
	                                               $Host = "$1\.". 'x' x length($2); }

	$Host = 'Unknown' if(!$Host); # シェルテスト用。(ホスト/IPともに取得できない場合)
}



1;
#---

 sub GetFileName{
	# ファイルネームのHashを生成。

#	(undef,undef,$hour,$mday,$mon,$year,$wday) = localtime(time);            # perl5
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time + $TimeDiff ); # compatible for perl4

	 $mon++;
	 $mon  = sprintf("%02d",$mon        );
	 $year = sprintf("%02d",$year % 100 );
	 $hour = sprintf("%02d",$hour       );
	 $mday = sprintf("%02d",$mday       );

	$DaysDir = "$DataDir$year$mon";

	%DataFileOf = (
		'Main',		"$DataDir$year$mon.main",
		'Host',		"$DataDir$year$mon.host",
		'Reff',		"$DataDir$year$mon.reff",
		'Word',		"$DataDir$year$mon.word",
		'Each',		"$DataDir$year$mon.each",
		'DaysData', "${DaysDir}/$year$mon$mday.dat",
		'err',		"${DataDir}LockErr.dat",
	);

 }

1;
#---

sub Lock{
	# ロックの強制解除と生成

	local($Retry);

	$LockDir = $DataDir.$RecAct;

	$Pass = -M $LockDir;     # Age[day]
	$Pass = $Pass*24*60*60;  # [day]->[s]

	if( $Pass > $LockLimit ){                                 # ある程度ロック状態が続いていれば
		if( rmdir( $LockDir) ){ &LockErr('ForceUnLocked');  } # ロックを強制解除してみる。
		else                  { &LockErr('ForceUnLockErr'); } # 失敗すれば、エラーを書き出す。
	}

	while( !mkdir($LockDir, 0777) ){                          # ロック処理。
		if ( ++$Retry > $LockTryMax ){ &LockErr('LockErr'); return(0); }
		else                         { sleep(1)                        }
	}

	# ロック成功時、真を返す。
	$LOCKED{$RecAct} = 1;
 }

#---

sub UnLock{
	# ロックの解除

	$LockDir = $DataDir.$RecAct;

	 return(0) if(!$LOCKED{$RecAct});
	 $LOCKED{$RecAct} = !rmdir( $LockDir);              # 消去成功 ? 成功[偽] : 失敗[真]
		 &LockErr('UnLockErr') if( $LOCKED{$RecAct} );	# 失敗したらエラーを書き出す。
	!$LOCKED{$RecAct};                                  # 成功->[真] / 失敗->[偽]

}

sub LockErr{
	# ロックエラーの書き出し

	local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	 $mon++;

	open(ERR,">>$DataFileOf{'err'}");
		printf ERR ("%-15s %-7s %2d/%2d/%2d %2d:%2d:%2d\n",$_[0],"[$RecAct]",$year,$mon,$mday,$hour,$min,$sec);
	close(ERR);

}

1;
#---

sub Load{
	# データのロード。

	$DataFile = $DataFileOf{$RecAct};

	&Lock;
	return if(!$LOCKED{$RecAct});
	# ロック失敗しているときは処理を戻す。
	# 他のプロセスがアクセス中にロードすると、空データを読んでしまうことがある。

		open(IN,"$DataFile");
			@Data = <IN>;
		close(IN);

}

#---

sub Save{
#	データの保存。

	return if(!$LOCKED{$RecAct});
	# ロック失敗している時は処理を戻す。
	# 空データに新しいデータを追加して、(上参照)
	# ファイルに保存したらひどいことになるもんね。

	if( $RecAct eq 'DaysData' && !(-e $DaysDir) ){
		umask(0000);                                      # (0777)のディレクトリを作るため。
		mkdir( $DaysDir, 0777 ) || &LockErr('mkdirErr');  
		umask(0111);                                      # 終われば戻す。
	}

	open(OUT,">$DataFile") || &LockErr('SaveFileErr') ;   # LockErrの流用？
	  print OUT @Data;
	close(OUT);

	&UnLock;

}

#---
sub Redirect{
	# リダイレクト

	if(!$SSI) {
		print "Content-type: image/gif\n";
		print "Expires: 01/01/70 00:00:00 GMT\n";
		print "Location: $Redirect\n\n";
	}
	else{
		print "Status:204 No Response\n\n";
	}

}

#---

1;

 sub WrapExit{

	exit if(!$RecEachExit);

	&Rec('Each', $Each );

	$ChkReff=1;  $ChkHost=1;
	$ChkHour=1;  $ChkWord=1;
	$ChkAgent=1; $ChkOs=1;

	&RecDaysData;

	exit;
 }

 sub Record{
	# record  data

	&RecMain;
	&Rec('Reff', $Reff );
	&Rec('Host', $Host );
	&Rec('Each', $Each );
	&Rec('Word', $Word ) if(@Words);
	&RecDaysData;
 }

#---

 sub RecMain{
	# Mon/Main

	local( $tmp,$RecAct,$ChkWday,$ChkMday,$ChkHour,$ChkOs,$ChkAgent );

	$RecAct = 'Main';
	&Load;

	return(1) if(!$LOCKED{$RecAct});

	if( $Data[0] !~ '-' ){
		push( @Data, <DATA>);
		&SetDataHeader;
	}

	foreach( @Data ){ # incr
		   if(!$ChkWday  && /^wday:\t($wday)\t(\d+)$/  ){ $_ = "wday:\t$1\t".  ($2+1). "\n"; $ChkWday  = 1; }
		elsif(!$ChkMday  && /^mday:\t($mday)\t(\d+)$/  ){ $_ = "mday:\t$1\t".  ($2+1). "\n"; $ChkMday  = 1; }
		elsif(!$ChkHour  && /^hour:\t($hour)\t(\d+)$/  ){ $_ = "hour:\t$1\t".  ($2+1). "\n"; $ChkHour  = 1; }
		elsif(!$ChkOs    && /^os:\t($Os)\t(\d+)$/      ){ $_ = "os:\t$1\t".    ($2+1). "\n"; $ChkOs    = 1; }
		elsif(!$ChkAgent && /^agent:\t($Agent)\t(\d+)$/){ $_ = "agent:\t$1\t". ($2+1). "\n"; $ChkAgent = 1; }
	}

	# add data
	   if(!$ChkAgent ){ push( @Data, "agent:\t$Agent\t1\n" ); }
	   if(!$ChkOs    ){ push( @Data, "os:\t$Os\t1\n" );       }

	# add unknown

	&AddUnknown if( @ana);

	&Save;
 }

#---

sub AddUnknown{
	# 重複するモノを除外してから付け足そう

	local($cnt);

	for $d ( reverse(@Data) ){ # unknown_data はデータの最後に付け加えられる。
		$cnt=0;
		last if(!@ana);

		for $a (@ana){
			splice(@ana,$cnt,1) if( $d eq "$a\n" );
			$cnt++;
		}
	}

	foreach( @ana ){
		s/\n//;		# 空白キーを除外。
		push( @Data, "$_\n" ) if( $_ );
	}

}

#---

sub Rec{
	# Mon/others

	local($RecAct,$Value) = @_;

	 &Load;

	return(1)      if(!$LOCKED{$RecAct});
	&SetDataHeader if( $Data[0] !~ '-' );     # 何故か if(!@Data) ではうまく行かない...。

	if($RecAct eq 'Word'){
		foreach (@Words){ &incr( $_ ) if( $_ ); }
	}
	else{
		$Value = "Data Missing." if(!$Value); #「DataMissing」になることはまず無い。
		&incr( $Value );
	}

	 &Save;
}

#---

 sub incr{
	# incr / add

	local( $Name,$tmp ) = @_;

	foreach(@Data){
		if(/^($Name)\t(\d+)$/){
			$_ = "$1\t". ($2+1). "\n";
			$tmp = 1; last;
		}
	}

	if(!$tmp){
		$tmp = "$Name\t1\n";
		push(@Data,$tmp);
	}
}

1;
#---

sub ana{
	local($data) = @_;
	push( @ana, $data) if(!grep( $_ eq $data ,@ana) );
}


sub SetDataHeader{
	local( $Head);
	$Head = 
	    "----------------------------------------------\n".
	    "Access Logger Model4 (c) 2004 Kazuhiro Nomura.\n".
	    "	Location: $PageUrl[0]\n".
	    "	Created : $year$mon$mday\n".
	    "	DataType: $RecAct\n".
	    "----------------------------------------------\n\n";
	unshift(@Data, $Head );
}

sub catErr{

	print "Content-type: text/html\n\n";
	print "<HTML>\n";
	print "<b> エラーが発生しました </b>\n<ul>";
	print @_;
	print "</ul>\n";

	print "<div align=right>\n".
	      "<hr><a href=http://www.imaginet.ne.jp/~nobu/> AccessLogger $Ver</a><br>\n".
	      "(c) 2004 Kazuhiro Nomura.</div>";

	print "</HTML>";
	exit;
}



1;
#---

sub RecDaysData{
	# 日別データ記録。

#	local( $ChkReff,$ChkHost,$ChkHour,$ChkEach,$ChkOs,$ChkAgent,$ChkWord);
	local( $RecAct) = 'DaysData';
	&Load;

	$ChkReff = 1 if(!$Reff);
	$ChkWord = 1 if(!@Words);

	&SetDataHeader if( $Data[0] !~ '-' );

	# incr data / 変数にメタ文字が含まれる場合おかしくなる->対処済み。
	foreach( @Data ){
		   if(!$ChkReff  && /^reff:\t($Reff)\t(\d+)$/   ) { $_ = "reff:\t$1\t".  ($2+1). "\n"; $ChkReff  = 1; }
		elsif(!$ChkHost  && /^host:\t($Host)\t(\d+)$/   ) { $_ = "host:\t$1\t".  ($2+1). "\n"; $ChkHost  = 1; }
		elsif(!$ChkHour  && /^hour:\t($hour)\t(\d+)$/   ) { $_ = "hour:\t$1\t".  ($2+1). "\n"; $ChkHour  = 1; }
		elsif(!$ChkEach  && /^each:\t($Each)\t(\d+)$/   ) { $_ = "each:\t$1\t".  ($2+1). "\n"; $ChkEach  = 1; }
		elsif(!$ChkOs    && /^os:\t($Os)\t(\d+)$/       ) { $_ = "os:\t$1\t".    ($2+1). "\n"; $ChkOs    = 1; }
		elsif(!$ChkAgent && /^agent:\t($Agent)\t(\d+)$/ ) { $_ = "agent:\t$1\t". ($2+1). "\n"; $ChkAgent = 1; }
		elsif(!$ChkWord  && /^word:\t(.+)\t(\d+)$/      ) {

			local( $cnt);                               # ヘッダが[word:]の時は、
			foreach $tmp ( @Words ){                    # @Wordsそれぞれと比較して
				if( $1 eq $tmp ){                       # キー同士が一致すれば
					$_ = "word:\t$1\t". ($2+1). "\n";   # @Dataのカウントを増やして
					splice(@Words,$cnt,1);              # @Wordsから消す。(次回のループ数が減る)
					$ChkWord = 1 if( !@Words );         # @Wordsを全て処理し終えたらフラグをたてる。
					last;                               # 一致したので次の(@Dataの)要素へ。
				}
				$cnt++;                                 # 添え字カウンタ(spliceで使用)
			}      # enc foreach
		}          # end elsif
	}              # end foreach

	# add data / @Dataに無かった場合、別に追加。
	if (!$ChkReff  ){ push( @Data, "reff:\t$Reff\t1\n" );  }
	if (!$ChkHost  ){ push( @Data, "host:\t$Host\t1\n" );  }
	if (!$ChkHour  ){ push( @Data, "hour:\t$hour\t1\n" );  }
	if (!$ChkEach  ){ push( @Data, "each:\t$Each\t1\n" );  }
	if (!$ChkOs    ){ push( @Data, "os:\t$Os\t1\n" );      }
	if (!$ChkAgent ){ push( @Data, "agent:\t$Agent\t1\n" );}

	# wordは別に追加。
	foreach( @Words){
		$tmp = "word:\t$_\t1\n";
		push( @Data, $tmp);
	}
	# すでに incr された要素は削除されている。

	&Save;
}


1;
#---
#--- ioCook.pl : build #050より追加。

sub ChkCook{

	#----------------------
	# check cookie

	$Cooks = $ENV{'HTTP_COOKIE'};
	$Cooks =~ s/; /;/ig;

	for( split(/;/,$Cooks) ){
		$CookLock = 1 if( /^$CookName=$CookValue$/ );
		last;
	}

}


sub SetCook{

	#---------------------
	# cokkieの出力

	return if(!$CookLimit);

	# $date = gmtime( time + $cookie_limit ); # perl5
 
	local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $CookLimit);

	$year = sprintf( "%04d", $year + 1900 ); # 2000年問題対応(2)
	$sec  = sprintf( "%02d", $sec  ); $min  = sprintf( "%02d", $min  );
	$hour = sprintf( "%02d", $hour ); $mday = sprintf( "%02d", $mday );

	$wday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [$wday];
	$mon  = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
	$date = "$wday, $mday\-$mon\-$year $hour:$min:$sec GMT";

	print "Set-Cookie: $CookName=$CookValue; expires=$date\n";
}

1;

#---
# <DATA> - メインデータフォーマット.

__END__

wday:	0	0
wday:	1	0
wday:	2	0
wday:	3	0
wday:	4	0
wday:	5	0
wday:	6	0

mday:	01	0
mday:	02	0
mday:	03	0
mday:	04	0
mday:	05	0
mday:	06	0
mday:	07	0
mday:	08	0
mday:	09	0
mday:	10	0
mday:	11	0
mday:	12	0
mday:	13	0
mday:	14	0
mday:	15	0
mday:	16	0
mday:	17	0
mday:	18	0
mday:	19	0
mday:	20	0
mday:	21	0
mday:	22	0
mday:	23	0
mday:	24	0
mday:	25	0
mday:	26	0
mday:	27	0
mday:	28	0
mday:	29	0
mday:	30	0
mday:	31	0
mday:	32	0

hour:	00	0
hour:	01	0
hour:	02	0
hour:	03	0
hour:	04	0
hour:	05	0
hour:	06	0
hour:	07	0
hour:	08	0
hour:	09	0
hour:	10	0
hour:	11	0
hour:	12	0
hour:	13	0
hour:	14	0
hour:	15	0
hour:	16	0
hour:	17	0
hour:	18	0
hour:	19	0
hour:	20	0
hour:	21	0
hour:	22	0
hour:	23	0

agent:	Internet Explorer 5.x	0
agent:	Internet Explorer 4.x	0
agent:	Internet Explorer 3.x	0
agent:	Netscape 5.x	0
agent:	Netscape 4.x	0
agent:	Netscape 3.x	0
agent:	Netscape 2.x	0
agent:	Unknown	0

os:	win2000	0
os:	winXP	0
os:	winNT	0
os:	winMe	0
os:	win98	0
os:	win95	0
os:	win3.1	0
os:	MacOSX	0
os:	Mac68K	0
os:	MacPPC	0
os:	Unix	0
os:	Unknown	0

--- UnknownData ---