#!/usr/local/bin/perl

#Web Analyze Ver 3.05 (2006/05/11)
#
#Copyright(C) 2002-2006 Knight, All rights reserved.
#Mail ... support@web-liberty.net
#Home ... http://www.web-liberty.net/

#――――― 初期処理 ――――――――――――――――――――――――

package main;

use strict;
use lib qw(./lib);

use webliberty::Basis;
use webliberty::String;
use webliberty::Host;
use webliberty::Cookie;
use webliberty::Lock;
use webliberty::Script;

require './init.cgi';

#――――― メイン処理 ―――――――――――――――――――――――

my $init = &init::get_init;

my $query = &decode;
&regist;
&result;

exit;

#――――― サブルーチン ――――――――――――――――――――――

### デコード
sub decode {
	my($url, $screen, $color, $referer);

	if ($init->{download_mode} != 0 and ${$init->{download_file}}{"$ENV{'QUERY_STRING'}"} ne '') {
		$url     = ${$init->{download_file}}{"$ENV{'QUERY_STRING'}"};
		$screen  = '';
		$color   = '';
		$referer = $ENV{'HTTP_REFERER'};
	} else {
		($screen, $color, $referer) = split(/&/, $ENV{'QUERY_STRING'}, 3);

		$referer =~ tr/+/ /;
		$referer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;

		if ($referer =~ /[^\w\.\~\-\/\?\&\#\+\=\:\;\@\%]+/) {
			require Jcode;

			my $jcode_ins = new Jcode($referer);
			$referer = $jcode_ins->utf8;
		}
	}

	foreach ($screen, $color, $referer) {
		$_ =~ s/&/&/g;
		$_ =~ s/</&lt;/g;
		$_ =~ s/>/&gt;/g;
		$_ =~ s/"/&quot;/g;
	}

	my $query;

	$query->{url}     = $url;
	$query->{screen}  = $screen;
	$query->{color}   = $color;
	$query->{referer} = $referer;

	return $query;
}

### データ記録
sub regist {
	my $url_ins     = new webliberty::String($query->{url});
	my $referer_ins = new webliberty::String($query->{referer});
	my $screen_ins  = new webliberty::String($query->{screen});
	my $color_ins   = new webliberty::String($query->{color});

	#特定のアクセスを除外
	foreach (@{$init->{except_referer}}) {
		if ($_ and $referer_ins->get_string eq $_) {
			return;
		}
	}
	if (!$init->{multi_mode}) {
		foreach (@{$init->{self_url}}) {
			if ($_ and $referer_ins->get_string =~ /$_/) {
				return;
			}
		}
	}

	my($sec, $min, $hour, $day, $mon, $year) = localtime(time);
	my $log_name = sprintf("%04d%02d%02d", $year + 1900, $mon + 1, $day);

	my($cookie_id, $cookie_count, $cookie_last, $cookie_ins, $online_ins);

	#Cookie取得
	if ($init->{cookie_mode}) {
		$cookie_ins = new webliberty::Cookie($init->{cookie_id});
		$online_ins = new webliberty::Cookie($init->{cookie_id} . '_online');

		if ($cookie_ins->get_cookie('id')) {
			foreach (@{$init->{except_id}}) {
				if ($_ and $cookie_ins->get_cookie('id') eq $_) {
					return;
				}
			}

			$cookie_id    = $cookie_ins->get_cookie('id');
			$cookie_count = $cookie_ins->get_cookie('count');
			$cookie_last  = $cookie_ins->get_cookie('last');

			if (time - $online_ins->get_cookie('id') < $init->{session_time} * 60) {
				$cookie_count = '';
				$cookie_last  = '';
			} else {
				if ($cookie_count) {
					$cookie_count++;
				} else {
					$cookie_count = 1;
				}
			}
		} else {
			$cookie_id    = substr(crypt(time, pack('CC', int(rand(26) + 65), int(rand(10) + 48))), 0, 5) . time;
			$cookie_count = 1;
			$cookie_last  = '';
		}
	} else {
		$cookie_id    = '';
		$cookie_count = '';
		$cookie_last  = '';
	}

	my($page_url, $js_flag);
	if ($init->{download_mode} != 0 and $url_ins->get_string) {
		$page_url = $url_ins->get_string;
		$js_flag  = 0;
	} elsif ($ENV{'QUERY_STRING'}) {
		$page_url = $ENV{'HTTP_REFERER'};
		$js_flag  = 1;
	} else {
		$page_url = $ENV{'HTTP_REFERER'};
		$js_flag  = 0;
	}

	my $host_ins = new webliberty::Host;

	#特定のホストを除外
	foreach (@{$init->{except_host}}) {
		if ($_ and $host_ins->get_host =~ /$_/) {
			return;
		}
	}

	my $lock_ins = new webliberty::Lock($init->{lock_file});
	if (!$lock_ins->file_lock) {
		die 'Now Locking';
	}

	#アクセスログ記録
	if (open(FILE, ">>$init->{logs_dir}$log_name\.$init->{logs_ext}")) {
		print FILE time . "\t$page_url\t" . $referer_ins->get_string . "\t$ENV{'HTTP_USER_AGENT'}\t" . $host_ins->get_host . "\t$js_flag\t" . $screen_ins->get_string . "\t" . $color_ins->get_string . "\t$cookie_id\t$cookie_count\t$cookie_last\n";
		close(FILE);
	} else {
		die "Write Error : $init->{logs_dir}$log_name\.$init->{logs_ext}";
	}

	my $i;

	#古いログを削除
	opendir(DIR, "$init->{logs_dir}") or die "Read Error : $init->{logs_dir}";
	foreach (sort { $b <=> $a } readdir(DIR)) {
		if ($_ =~ /^(\d\d\d\d\d\d\d\d)\.$init->{logs_ext}$/ and $i++ >= $init->{save_days}) {
			unlink("$init->{logs_dir}$_");
		}
	}
	closedir(DIR);

	#アクセス数記録
	if ($init->{count_mode}) {
		&countup;
	}

	$lock_ins->file_unlock;

	#Cookie記録
	if ($init->{cookie_mode}) {
		$cookie_ins->set_holddays($init->{cookie_holdday});
		$cookie_ins->set_cookie(
			id    => $cookie_id,
			count => $cookie_count,
			last  => time
		);
		$online_ins->set_cookie(
			id => time
		);
	}

	return;
}

### アクセス数記録
sub countup {
	open(FH, $init->{count_file}) or die "Read Error : $init->{count_file}";
	my $data = <FH>;
	close(FH);

	my($count, $today, $yesterday, $key, $host) = split(/\t/, $data);
	my($sec, $min, $hour, $day) = localtime(time);

	my $host_ins = new webliberty::Host;

	if ($key == $day) {
		if ($host_ins->get_host eq $host) {
			return;
		} else {
			$today++;
		}
	} else {
		$yesterday = $today;
		$today     = 1;
	}
	$count++;

	open(FILE, ">$init->{count_file}") or die "Write Error : $init->{count_file}";
	print FILE "$count\t$today\t$yesterday\t$day\t" . $host_ins->get_host;
	close(FILE);

	my $script_ins = new webliberty::Script;

	my($flag, $message);

	($flag, $message) = $script_ins->create_jscript(
		file     => $init->{js_count_file},
		contents => $count
	);
	if (!$flag) {
		die $message;
	}

	($flag, $message) = $script_ins->create_jscript(
		file     => $init->{js_today_file},
		contents => $today
	);
	if (!$flag) {
		die $message;
	}

	($flag, $message) = $script_ins->create_jscript(
		file     => $init->{js_yesterday_file},
		contents => $yesterday
	);
	if (!$flag) {
		die $message;
	}

	return;
}

### 結果画面表示
sub result {
	if ($init->{download_mode} != 0 and $query->{url}) {
		if ($init->{download_mode} == 1) {
			if ($ENV{'PERLXS'} eq 'PerlIS') {
				print "HTTP/1.0 302 Temporary Redirection\r\n";
				print "Content-type: text/html\n";
			}
			print "Location: $query->{url}\n\n";
		} else {
			my $basis_ins = new webliberty::Basis;

			print $basis_ins->header;
			print "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
			print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
			print "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"ja\" lang=\"ja\">\n";
			print "<head>\n";
			print "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n";
			print "<title>ファイルのダウンロード</title>\n";
			print "</head>\n";
			print "<body>\n";
			print "<h1>ファイルのダウンロード</h1>\n";
			print "<p>$query->{url}をダウンロードしようとしています。自動的にファイルがダウンロードされない場合、以下のURLをクリックしてダウンロードしてください。</p>\n";
			print "<ul>\n";
			print "\t<li>$query->{url}</li>\n";
			print "</ul>\n";
			print "</body>\n";
			print "</html>\n";
		}
	} else {
		&image;
	}

	return;
}

### ダミー画像出力
sub image {
	my @dammy = (
		'47','49','46','38','39','61','02','00','02','00','80','00','00','00','00',
		'00','ff','ff','ff','21','f9','04','01','00','00','01','00','2c','00','00',
		'00','00','02','00','02','00','00','02','02','8c','53','00','3b'
	);

	print "Content-type: image/gif\n\n";
	foreach (@dammy) {
		print pack('C*', hex($_));
	}

	return;
}