%PDF- %PDF-
Mini Shell

Mini Shell

Direktori : /home/rappan/www/_cgi_ac/access/
Upload File :
Create Path :
Current File : /home/rappan/www/_cgi_ac/access/accview.cgi

#!/usr/local/bin/perl -I../lib
#^^^^^^^^これ^^^^^^^^をサーバーにあわせて書き直して下さい
##########################################################
#  Access Analysis "AshiatoLOG" Ver.2.01                 #
#                                                        #
#  Copyright (c) 2000,2001,2002 Funakichi                #
#  All rights reserved.                                  #
#  e-mail:   funabin@abox2.so-net.ne.jp                  #
#  homepage: http://www04.u-page.so-net.ne.jp/fa2/suga/  #
#                                                        #
# Ver0.00  00/03/12          Ver0.10  00/04/16           #
# Ver0.11  00/05/20          Ver0.12  00/05/20           #
# Ver0.13  00/06/03          Ver0.14  00/06/12           #
# Ver0.15  00/07/06          Ver0.16  00/09/03           #
# Ver1.00  01/04/16          Ver1.01  01/05/15           #
# Ver1.01b 01/09/09                                      #
#                                                        #
# Ver1.10 (accimg.cgiのみ配布)                           #
#  01/05/14：accimg.cgi簡略化、エラー記録機能削除        #
#  01/05/14：accimg.cgi自己アクセス・URL除外検査を削除   #
#  01/05/14：accimg.cgi記録ファイル自動圧縮機能削除      #
# Ver2.00                                                #
#  02/05/20：漢字処理をJcode.pmのみに特化                #
#  02/05/20：データファイルを毎日変更                    #
#  02/05/21：それに伴いバックアップファイル廃止          #
#  02/05/21：config.plを二分割、簡略化accimg.cgiで利用   #
#  02/05/21：accview.cgiのアクセス記録を削除             #
#  02/05/22：データ自動アップデート復活 = accupdate.pl   #
#  02/05/23：データ自動送信(sendmail)   = accupdate.pl   #
#  02/06/02：読み込みをmyAnalisisで1ファイル単位で行う   #
#  02/06/02：レコード数制限$maxlog撤廃                   #
#  02/06/04：データ自動削除             = accupdate.pl   #
#     BUG:データ自動送信されていなくとも削除!            #
#  02/06/05：前日一度もアクセスがない時は前々日のデータ  #
#              をアップデート                            #
#     BUG:アクセスがない日が続くとその前のデータをアップ #
#         デートしつづける（メールも送りつづける）       #
#  02/06/08：データ集計期間指定をaccgate.cgiで行う       #
#  02/06/09：表示項目および最低表示数のカスタマイズ      #
#  02/06/09：集計期間、表示カスタマイズをクッキー保存    #
#  02/06/22：エージェント集計でWindowsXP、Netscape6対応  #
# Ver2.01                                                #
#  02/07/03：Ver0.xxとのデータ互換機能削除               #
#  02/07/05：gethostbyaddrを記録ファイル読込時に行う     #
#  02/07/12：参照元の','区切りをエスケープ               #
#  02/07/12：myHostAgent検査でホスト名エスケープ文字復元 #
#  02/07/16：ホスト不明ならサブドメイン集計しない        #
#  02/09/23：ブラウザがOperaのときOS名をとりそこねていたのを修正 #
#  02/09/23：OS集計でWindowsME対応                       #
#  02/09/23：記録ファイル存在しないときaccimg.cgiが無限ループしていたのを修正 #
# 検討                                                   #
# ・アップデート時､エラーと不正アクセスを検出、メール連絡#
# ・アクセスカウンタの数値を個別データに埋め込む         #
# ・各ページごとの滞留時間、アクセス時間帯               #
# ・検索単語集計で、その単語からどのページを表示したのかの追跡機能#
# ・各種集計で、最低表示数以下をグラフにしないで、データだけを羅列表示する#
#   例えば、検索単語で、３件まではグラフ、それ以下は     #
#	２件	●●/○○/AA/BBBB/CCC/DDD/EEE・・・      #
#	１件	FFFFF/GGGGG/HHH/IIIIIII/JJ/KK・・・      #
# ・ブラウザのFlash表示能力を調査（JavaScript）          #
# ・今日のファイル以外は読み込むときロックの必要なし     #
# ・gethostbyaddrをアップデート時のみ行う（'-'と''で判断?）#
##########################################################
# ATTENTION:This code is written with "S-JIS" character-set.

require "configA.pl";
require "configB.pl";
use Jcode;
require 'access.pl';
require 'accviewsub.pl';

if ($ENV{'REQUEST_METHOD'} eq "POST")
{	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});	}
else
{	$buffer = $ENV{'QUERY_STRING'};	}
if (($cnt = index($buffer, 'ref='))>=0)
{
	$refer = substr($buffer, $cnt+4);
	$buffer = substr($buffer, 0, $cnt);
}
%FORM = &myHtml::decodeForm($buffer);

$mycookie = new myCookie($gatewdLimit,$accssdir);
$mycookie->readCookie;

$keywd = &myGatewd::getAccKey;
if ($gotgatewd = $FORM{'gateData'})
{	$answd = &myGatewd::makeCriptGatewd($gotgatewd, $keywd);
	$mycookie->addCookie('gateData', $answd);
}
else
{	$answd = $mycookie->getCookie('gateData');	}

$myCustom = new AshiatoOpt($optLimit, $accssdir, \%FORM);
($dtm, $days) = $myCustom->getCookieOpt;

$agent = $ENV{'HTTP_USER_AGENT'};
$agent =~ s/\,/\%2C/g;
$person= $ENV{'REMOTE_ADDR'};
$host  = &AshiatoData::getRemoteHost($person);
$teachenvmsg = 'このスクリプトのパス=「'.$ENV{SCRIPT_NAME}.'」<BR>'.
		"あなたのアクセスポイント=「$host」<BR>あなたのブラウザ=「$agent」<BR>\n";

if ($gatewd and $chkAgentAccpnt)
{
	unless (&AshiatoData::chkMyHostAgent($agent, $host, $person))
	{
		$answd = '';
		$mycookie->clearCookie('gateData');
		$msg =  '登録されたアクセスポイントおよびブラウザではないため<BR>'.
				'閲覧することは出来ません。';
	}
}

if ($gatewd and !&myGatewd::chkCriptGatewd($answd, $gatewd, $keywd))
{

	&myHtml::printHTMLheader('AshiatoLOG: No Password');
	unless ($msg)
	{	if ($gotgatewd or $answd)
		{	$msg = '<B>エラー： </B>パスワード不正！';	}
		else
		{	$msg = 'パスワードが無いか有効期限を過ぎています。';	}
		$msg .= << "_EOL_";
<BR>・<BR>・<BR>
パスワードを入力してください<BR>
<H2><A HREF="$gatefile">パスワード入力</A></H2>
_EOL_
	}
	print << "_EOL_";
<DIV ALIGN="CENTER">
$teachenvmsg
<BR><BR><BR><BR>
$msg
<BR><BR><BR><BR>
</DIV>
_EOL_
	&myHtml::printHTMLfooter;
	exit;

}

if ($buffer =~ /^url=/)
{

	&jumpToURL($');
	print "Location: $jumpfile\n\n";
	exit;

}

$mycookie->setCookie if ($gotgatewd);
$myCustom->setCookieOpt;

&myHtml::printHTMLheader('AshiatoLOG');

print "<DIV align='CENTER'><P>$teachenvmsg<P>\n";

if ($FORM{del} eq ' はい ')
{

		unlink("$wrdir$errfile");
}
elsif ($FORM{del} eq 'エラー記録削除')
{

	print "エラー記録を削除します。よろしいですか？<P>";
	print "<FORM action='$dispfile' method='get'><INPUT name='del' type='submit' value=' はい '></FORM>\n";
	print "<FORM action='$dispfile' method='get'><INPUT name='del' type='submit' value='いいえ'></FORM><BR>\n";
	print "</DIV>\n";
	&myHtml::printHTMLfooter;
	exit;

}
elsif (open(IN, "$wrdir$errfile"))
{

	print "<HR><H4>エラー記録</H4>\n";
	print "<TABLE border=0 cellpadding=0 cellspacing=0>\n";
	while (<IN>)
	{	s|^(.*)[\r\n]+$|<TR><TD><TT>$1</TT></TD></TR>\n|;
		print;
	}
	print "</TABLE><BR>\n";
	print "<FORM action='$dispfile' method='get'><INPUT name='del' type='submit' value='エラー記録削除'></FORM><BR><HR><P>\n";
}

$acclog = new AshiatoFile($wrdir, $wrfile, $errfile, $lockfile, $timeout, $trytime, $intime, $updatetm);
$analysisData = new myAnalysis($hbarimg, $vbarimg, $dsplim, "$dispfile?url=");

if ($FORM{'dn'})
{
	$dn  = $FORM{dn};
	$dtm = $FORM{dtm};
}
unless($dtm)
{	$dtm = $^T;
	$dtm -= ($jsthor * 3600);
	$dtm -= $dtm % 86400;
	$dtm += ($jsthor * 3600);
}
$days = 2 unless($days);

if ($dn)
{

	&dispLogData($analysisData, $acclog, $dtm, $dn);
}
else
{

	@rtmsg = $analysisData->readAccFiles($acclog, $dtm, $days);
	if (!$analysisData->{sampleNum})
	{	if (!@rtmsg)
		{	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($dtm);
			$year += 1900;	$mon++;
			print "<BR><H3>ERROR：指定期間($year年$mon月$mday日までの$days日間)のアクセス記録ファイルを読み込めません。</H3><BR><BR><BR>\n";	}
		else
		{	print '<BR><H3>データ更新中です。少し時間を置いてからアクセスしてください</H3><BR><BR>'
				.join("<BR>\n", @rtmsg);
		}
	}
	else {
		print join('<BR>\n', @rtmsg),"<HR>\n" if (@rtmsg);

		$analysisData->dspGlobalInfo($dtm, $days);	#全体概要情報表示!
		$analysisData->startGraphs;		#棒グラフ表示登録開始!
		# 棒グラフ表示登録     ('タイトル',                     dataCode,   最低数,  type, '縦/横');
		$analysisData->regGraph('あしあと(アクセスパターン)',  'accsPtn',  $acpmin, 'num',  'yoko') unless($swacpmin==0);
		$analysisData->regGraph('ページ別アクセス数',          'eachPage', $pagmin, 'page', 'yoko') unless($swpagmin==0);
		$analysisData->regGraph('同一アクセスでのページ巡回数(注目度)','accCnts',0, 'cnts', 'yoko') unless($swaccCnts==0);
		$analysisData->regGraph("同一アクセスでの滞留時間 <small>(最初のアクセスから最後のアクセスまでの時間)</small>", 'stayTm', 0, 'date', 'yoko') unless ($swstayTm==0);
		$analysisData->regGraph('IPでみる再訪問回数 <small>(固定IPの訪問者しか見分けられないので、捕捉率は低い)</small>',  'reptCnts', 0,       'cnts', 'yoko') unless ($swreptCnts==0);
		$analysisData->regGraph("日別アクセス",                'logDates', 0,       'date', 'yoko') unless($swlogDates==0);
		$analysisData->regGraph("曜日別アクセス",              'logWeeks', 0,       'wday', 'tate') unless($swlogWeeks==0);
		$analysisData->regGraph('アクセス時間帯',              'logHours', 0,       'time', 'tate') unless($swlogHours==0);
		$analysisData->regGraph('サブドメイン別アクセス数',    'domains',  $dommin, 'num',  'yoko') unless($swdommin==0);
		$analysisData->regGraph('国外(JPドメイン外)のアクセス','noJPurls', $ojpmin, 'num',  'yoko') unless($swojpmin==0);
		$analysisData->regGraph('ホスト名',                    'hosts',    $hnamin, 'num',  'yoko') unless(!$host or $swhnamin==0);
		$analysisData->regGraph('ブラウザまたはエージェント',  'agents',   $agnmin, 'num',  'yoko') unless($swagnmin==0);
		$analysisData->regGraph('OS',                          'OS',       $ostmin, 'num',  'yoko') unless($swostmin==0);
		$analysisData->regGraph('画面解像度(横x縦xカラー)',    'scrCnd',   $scrmin, 'num',  'yoko') unless($swscrmin==0);
		$analysisData->regGraph('リンク元',                    'refers',   $refmin, 'num',  'yoko') unless($swrefmin==0);
		$analysisData->regGraph('検索CGI個別集計',             'refSites', $rfsmin, 'num',  'yoko') unless($swrfsmin==0);
		$analysisData->regGraph('検索単語(日本語)集計',        'refWords', $wrdmin, 'num',  'yoko') unless($swwrdmin==0);
		# 棒グラフ表示登録終了!

		$analysisData->finishGraphs("<DIV align='center'><A href='$gatefile'>表\示オプション</A></DIV>");
		#登録棒グラフ表示!
		$analysisData->dispGraphs();
		##### 定型HTML表示
		while(<DATA>)
		{	print;	}
	}
}
print "</DIV>\n";
&myHtml::printHTMLfooter;

sub jumpToURL
{
	my ($URL) = @_;

	open(OUT, ">$wrdir$jdatfile") || return 0;
	print OUT <<"_EOL_";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<HTML lang="ja-JP">
<HEAD>
	<LINK REV="MADE" HREF="mailto:funabin\@abox2.so-net.ne.jp">
	<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
	<META HTTP-EQUIV="refresh" CONTENT="1; URL=$URL">
	<TITLE>1 秒後にジャンプします。</TITLE>
</HEAD>
<BODY>
<P>
<DIV ALIGN='CENTER'>
<!--これは、リンク元を隠すためのページです。-->
<H2>別のサイトにジャンプしようとしています。お待ちください。</H2>
</P><P>
<H3>ジャンプしないときは、下のリンクをクリックして下さい。</H3>
<A href="$URL">$URL</A>
</DIV>
</P>
</BODY>
</HTML>
_EOL_
	close(OUT);
}

sub dispLogData
{
	my ($analysisData, $accfil, $ctm, $dn) = @_;

	my ($rfile, $logtime, $cnt, $logdate);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$dmsg);
	
	$rfile = $accfil->makFileName($ctm);
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($ctm);
	$year += 1900;	$mon++;
	$dmsg = "$year年$mon月$mday日の記録ファイル「$rfile」";
	unless (-e $rfile)
	{
		print "$dmsgは存在しません。<BR>\n";
		return;
	}
	unless ($accfil->readAccFile($rfile))
	{	print "$dmsgは、更新中の為、読み込めませんでした。<BR>\n";
		return;
	}
	print "$dmsgを読み込みました。<BR>\n";
	
	my $hashref = $accfil->getHash;
	my ($st, $en) = split('-', $dn);
	my ($lnk, $dif, $st2, $en2, $i, $endflg);
	my $bgc1='#d0f0ff';
	my $bgc2='#d0fff0';
	my @logs = sort { $hashref->{$a}->getDiffTm($hashref->{$b}); } keys %$hashref;
	$dif = $en - $st;
	$st2 = $en;
	$en2 = $st2 + $dif;
	$i = $st2+1;
	$lnk = "　<A href='$dispfile?dn=$st2-$en2&amp;dtm=$ctm'>次の $dif 件 ($i〜$en2)</A>　" if ($en <= @logs);
	$st2 = $st - $dif;
	if ($st2 >= 0)
	{	$en2 = $st;
		$i = $st2 + 1;
		$lnk .= "　<A href='$dispfile?dn=$st2-$en2&amp;dtm=$ctm'>前の $dif 件 ($i〜$en2)</A>　";
	}
	$lnk .= "</P><P><A href='$gatefile'>戻る</A></P>\n";
	print "<H3>個別データ一覧</H3>\n";
	print "<P>$lnk\n";
	$i=($en > @logs)?@logs:$en;
	printf("<H4>(No.%2d〜No.$i)</H4>\n", $st+1);
	print << "__EOL__";
	<table border=0 width=100% cellpadding=0 cellspacing=1 bgcolor="#000000"><tr><td>
	<table border=0 width=100% cellpadding=3 cellspacing=1>
	<tr bgcolor="$bgc1"><td rowspan=2><B>NO</B></td><td><B>日時</B></td>
	<td><B>あしあと</B></td>
	<td><B>IPアドレス</B></td>
	<td><B>画面解像度</B></td>
	<td><B>エージェント</B></td>
	</tr><tr bgcolor="$bgc2">
	<td><B>滞在時間</B></td>
	<td><B>アクセスページ数</B></td>
	<td colspan=2><B>ホスト</B></td>
	<td><B>リンク元</B></td>
	</tr>
	</table>
	</td></tr></table>
__EOL__
	for ($i = $st; $i < $en; )
	{	$person = $logs[$i];
		if (!$person)
		{	$endflg = 1;
			last;
		}
		my $dat = $hashref->{$person};

		($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($dat->getCtm);
		$logdate = sprintf("%d/%.2d/%.2d %.2d:%.2d:%.2d",1900+$year,1+$mon,$mday,$hour,$min,$sec);
		$i++;
		print << "__EOL__";
		<table border=0 width=100% cellpadding=0 cellspacing=1 bgcolor="#000000"><tr><td>
		<table border=0 width=100% cellpadding=3 cellspacing=1>
		<tr bgcolor='$bgc1'><td rowspan=2>$i</td><td>$logdate</td>
__EOL__

		$_ = $dat->getPageId;
		s/^>//;
		s/>/→/g;
		print "<td>$_</td>\n";

		$_ = $dat->getIPaddr;
		print "<td><a href='http://whois.nic.ad.jp/cgi-bin/whois_gw?key=$_' target='_blank'>$_</a></td>\n";

		$_ = $dat->getScrCnd;
		$_ = '*解像度不明*<BR>' if (!($_));
		print "<td>$_</td>\n";

		my ($host, $agent) = $dat->getHostAgent;
		if (!$agent or $agent eq '-')
		{	$agent = '*エージェント不明*';	}
		else {
			$agent =~ s/%([\da-fA-F][\da-fA-F])/pack("C",hex($1))/ge;
			if ($agent =~ /[\x80-\xFF]/)
			{	&Jcode::convert(\$agent, 'sjis'); }
		}
		print "<td>$agent</td>\n";

		print "</tr><tr bgcolor='$bgc2'>\n";

		my $stt = $dat->getStayTm;
		if ($stt)
		{	$_ = sprintf("<td>%d時間%d分%d秒</td>\n", int($stt/3600), int($stt/60)%60, $stt%60);
			s/^<td>0時間/<td>/;
			s/^<td>0分/<td>/;
			print;
		}
		else
		{	print "<td>１アクセスのみ</td>\n";	}

		print "<td>".$dat->getAccCnt."回</td>\n";

		if (!$host or $host eq '-')
		{	$host = '*ホスト不明*';	}
		else
		{
			$host =~ s/(.{30})/$1<BR>/g;
		}
		print "<td colspan=2><TT>$host</TT></td>\n";

		$_ = $dat->getRefer;
		if (!($_))
 		{	$_ = ' (リンク元なし)<BR>';	}
		else {
			$_ = $analysisData->addupRefers($_);
		}
		print "<td>$_</td>\n";

		print "</tr></table>\n";
		print "</td></tr></table>\n";
	}

	print "<P>$lnk\n";
}

################################
# ログ解析＆表示クラス
################################
package myAnalysis;

sub new
{
	my ($class, $himg, $vimg, $dsplim, $jmpurl) = @_;
	my $this = {};
	$this->{ARRAY}		= {};
	$this->{sampleNum}	= 0;
	$this->{hitNum}		= 0;
	$this->{firstLog}	= new AshiatoData('FIRST','','',2147483647,0,'','',0);
	$this->{lastLog}	= new AshiatoData('LAST','','',0,0,'','',0);
	$this->{dispDates}	= 0;
	$this->{logDates}	= {};
	$this->{logWeeks}	= {};
	$this->{logHours}	= {};
	$this->{accsPtn}	= {};
	$this->{stayTm}		= {};
	$this->{reptCnts}	= {};
	$this->{eachPage}	= {};
	$this->{refers}		= {};
	$this->{refSites}	= {};
	$this->{refWords}	= {};
	$this->{scrCnd}		= {};
	$this->{accCnts}	= {};
	$this->{agents}		= {};
	$this->{OS}			= {};
	$this->{hosts}		= {};
	$this->{noJPurls}	= {};
	$this->{domains}	= {};
	$this->{regGraph}   = [];
	$this->{hBarImg}	= $himg;
	$this->{vBarImg}	= $vimg;
	$this->{dsplim} = $dsplim;
	$this->{jmpurl} = $jmpurl;
	$this->{wstr} = ['日','月','火','水','木','金','土'];
	bless $this;
}

sub readAccFiles
{
	my ($this, $accfil, $ctm, $days) = @_;
	my ($rfile, @redmsg);
	my ($logtime, $cnt, $logdate);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday);
	
	for ($cnt = 0; $cnt < 24; $cnt += 1)
	{	$this->{logHours}->{$cnt} = 0;	}

	for ($cnt = 0; $cnt < 7; $cnt += 1)
	{	$this->{logWeeks}->{${$this->{wstr}}[$cnt]} = 0;	}

	for ($ctm -= 86400 * ($days-1); $days > 0; $days -= 1)
	{
		$rfile = $accfil->makFileName($ctm);
		if (-e $rfile)
		{
			if ($accfil->readAccFile($rfile))
			{	$this->{ARRAY} = $accfil->{ARRAY};
				$this->analyzeacc;
			}
			else
			{	push (@redmsg, '記録ファイル「'.$rfile.'」は、更新中の為、読み込めませんでした。');	}
		}
		$ctm += 86400;
	}

	$logtime = $this->{firstLog}->getDiffTm($this->{lastLog});
	$this->{dispDates} = int($logtime / (3600*24));

	$logtime = $this->{firstLog}->getCtm;
	for ($cnt = 0; $cnt < $this->{dispDates}; $cnt++)
	{	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($logtime);
		$logdate = sprintf("%d/%.2d/%.2d",1900+$year,$mon+1,$mday);
		$this->{logDates}->{$logdate} = 0 if (!$this->{logDates}->{$logdate});
		$logtime += (3600*24)
	}

	@redmsg;
}

sub analyzeacc
{
	my $this = shift;
	my ($hashref, $person, $stayTm, $accData, $logtime, $logdate, $cnt, $pageId, $pageNum);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday);
	my $dsplim = $this->{dsplim};
	my %ipcnts;

	$hashref = $this->{ARRAY}->getHash;
	while (($person, $accData) = each %$hashref)
	{	$this->{sampleNum} += 1;
		$this->{hitNum} += $accData->getAccCnt;
		if ($this->{firstLog}->getDiffTm($accData) < 0)
		{	$this->{firstLog} = new AshiatoData('FIRST','','',$accData->getCtm,0,'','',0);	}
		if ($this->{lastLog}->getDiffTm($accData) > 0)
		{	$this->{lastLog} = new AshiatoData('LAST','','',$accData->getCtm,0,'','',0);	}
	}
	
	LOOP: while (($person, $accData) = each %$hashref)
	{
		$pageId = $accData->getPageId;
		$_ = $pageId;
		s|^((>[^>]*){$dsplim})(>[^>]*){1,}(>[^>]*$)|$1>(略)$4|;
		s/>/→/g;
		s/^→//;
		$this->{accsPtn}->{$_} += 1;
		
		$_ = $accData->getIPaddr;
		s/\+\d+$//;
		$ipcnts{$_} += 1;
		
		$_ = $accData->getStayTm;
		if ($_)
		{	if ($_ >= 5400)
			{	$stayTm = '90分以上';	}
			else {
				if ($_ >= 600)
				{	$_ = int($_ / 600) * 10;
					$stayTm = sprintf("%02d〜%02d分", $_, $_ + 10);
				}
				else
				{	$_ = int($_ / 60);
					$stayTm = sprintf("%02d〜%02d分", $_, $_ + 1);
				}
			}
		}
		else
		{	$stayTm = '１アクセスのみ';	}
		$this->{stayTm}->{$stayTm} += 1;
		
		$pageNum = split(/>+/, $pageId) - 1;
		shift;
		foreach (@_)
		{	$this->{eachPage}->{$_} += 1;	}
		
		$_ = 'JavaScript無効' if (!($_ = $accData->getScrCnd));
		$this->{scrCnd}->{$_} += 1;
		
		if ($_ = $accData->getRefer)
		{
			$this->addupRefers($_);
		}
		
		$cnt = $accData->getAccCnt;
		$this->{accCnts}->{$cnt} += 1;
		
		($sec,$min,$logtime,$mday,$mon,$year,$wday) = localtime($accData->getCtm);
		$mon++;
		$year = 1900+$year;
		$logdate = sprintf("%d/%.2d/%.2d",$year,$mon,$mday);
		$this->{logDates}->{$logdate} += 1;
		$this->{logHours}->{$logtime} += 1;

		my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($accData->getCtm);
		$this->{logWeeks}->{${$this->{wstr}}[$wday]} += 1;
		
		my ($host, $agent) = $accData->getHostAgent;
		$this->addupDomains($host, $person);

		$this->addupAgents($agent);
		
		delete $hashref->{$person};
	}
	
	if ($this->{scrCnd}->{'JavaScript無効'} == $this->{sampleNum})
	{	$this->{scrCnd} = {};	}
	
	while (($person, $_) = each %ipcnts)
	{

		$this->{reptCnts}->{$_} += 1;
	}
}

sub addupDomains
{
	my ($this, $host, $person) = @_;
	my $refstr;

	if ($host eq $person)
	{	$_ = '-';	}
	elsif ($host =~ /(\.[^\.]+)(\.\w+\.\w{2})$/)
	{
		$_ = $1.$2;
		$this->{domains}->{$2} += 1;
	}
	elsif ($host =~ /(\.[^\.]+)(\.\w{2,})$/)
	{
		$_ = $1.$2;
		$this->{domains}->{$2} += 1;
	}
	else
	{	$_ = '-';	}

	if ($_ eq '-')
	{	$refstr = '*不明*';	}
	else {
		$refstr = '<A href="'.$this->{jmpurl}."http://www$_\" target=\"dmy\">";
		s/%(([a-fA-F\d]){2})/pack("C",hex($1))/eg;
		$refstr .= "$_</A>";
		if (!($_ =~ /\.jp$/))
		{	$this->{noJPurls}->{$refstr} += 1;	}
	}
	$this->{hosts}->{$refstr} += 1;
}

sub addTLDcmnt
{
	my %domainlist = (
		'com',	'企業',
		'edu',	'教育系',
		'net',	'プロバイダ',
		'int',	'国際機関',
		'org',	'団体',
		'gov',	'米国政府',
		'mil',	'米軍',
		'ad.jp','国内管理組織',
		'ac.jp','国内教育',
		'go.jp','日本政府',
		'or.jp','国内団体',
		'co.jp','国内企業',
		'ne.jp','国内プロバイダ',
		'gr.jp','国内グループ',
		'kr',	'<B>韓国</B>',
		'tw',	'<B>台湾</B>',
		'hk',	'<B>香港</B>',
		'cn',	'<B>中国</B>',
		'sg',	'<B>シンガポール</B>',
		'au',	'<B>オーストラリア</B>',
		'us',	'<B>米国</B>',
		'uk',	'<B>英国</B>',
		'fr',	'<B>フランス</B>',
		'de',	'<B>ドイツ</B>',
		'it',	'<B>イタリア</B>',
		'ca',	'<B>カナダ</B>',
		'ru',	'<B>ロシア</B>',
	);
	my ($this, $tag, $tail) = @_;
	my ($dom, $wd, $chs, %doms);
	my $domains = $this->{$tag};
	foreach (keys %$domains)
	{	$dom = $_;
		/\.(..\.jp|\w{2,3})$tail$/;
		$wd = $1;
		if ($chs = $domainlist{$wd})
		{	s/\.$wd$tail$/.$wd$tail - $chs/i;	}
		$doms{$_} = $domains->{$dom};
	}
	$this->{$tag} = \%doms;
}

sub addupRefers
{
	my ($this, $oURL) = @_;
	my ($dspLnk, $len, $ln, $aword, $pairs, $akey, $arg, @wbytes, $urlhead, $rval);
	$oURL =~ s/%([0-7][a-fA-F\d])/pack("C",hex($1))/eg;
	$_ = $oURL;
	s/%(([a-fA-F\d]){2})/pack("C",hex($1))/eg;
	&Jcode::convert(\$_,'euc');
	s/&/&amp;/g;
	s/</&lt;/g;
	s/>/&gt;/g;
	s/"/&quot;/g;

	if (!/^([^\?]+)\?/)
	{	$dspLnk = $_;	}
	else {
		$_ = $';
		$urlhead = $1;
		$dspLnk = $1.'?';
		$len = length($dspLnk);
		s/[\t\+]+/ /g;
		s/([\x00-\x7F]*?)(([\x80-\xFF]{2})*?)(\xA1\xA1)+/$1$2 /g;
		@wbytes = split(/&amp;/, $_);
		foreach $pairs (@wbytes)
		{	($akey, $arg) = split(/=/, $pairs);
			foreach (split(/ /, $arg))
			{	if (/[\x80-\xFF]{2}/)
				{
					&Jcode::euc_sjis(\$_);
					$this->{refWords}->{$_} += 1;
				}
			}
			$_ = $akey.'=';
			$ln = length;
			$len += $ln;
			if ($len > 60)
			{	$len = $ln;
				$dspLnk .= '<BR>';
			}
			$dspLnk .= $_;
			$_ = $arg.'&amp;';
			$ln = length;
			$len += $ln;
			if ($len > 60)
			{	$len = $ln;
				$dspLnk .= '<BR>';
			}
			$dspLnk .= $_;
		}
		$dspLnk =~ s/&amp;$//;
	}
	&Jcode::euc_sjis(\$dspLnk);
	$_ = ($dspLnk =~ m|^http://|)?('<A href="'.$this->{jmpurl}."$oURL\" target=\"dmy\">$dspLnk</A>\n"):($dspLnk."\n");
	$rval = $_;
	if ($urlhead)
	{
		$this->{refSites}->{$_} += 1;
		$_ = '<A href="'.$this->{jmpurl}."$urlhead\" target=\"dmy\">$urlhead</A>\n";
	}
	$this->{refers}->{$_} += 1;
	
	return $rval;
}

sub addupAgents
{
	my ($this, $agent) = @_;
	my ($os, $aver);

	$agent = '*不明*' if (!$agent);
	$agent =~ s/%([\da-fA-F][\da-fA-F])/pack("C",hex($1))/eg;
	$_ = $agent;
	s/Windows 98\; *Win 9x 4.90/Windows ME/;
	if (/[\x80-\xFF]/)
	{
		$aver = '*非ASCII文字を含むエージェント名*';
		$os = '*不明*';
	}
	elsif (/^Opera\/(\d+\.\d+).*\(([^;]+)/)
	{
		$aver = 'Opera/'.$1;
		$os = $2;
	}
	elsif (/^Mozilla\/\d+\.\d+[ \[\w\]]*\(compatible\; MSIE (\d+\.\w*)\; .*(Windows [\dMNX][\dETP\.][ \d\.]*|Win\d{2,3}|Mac_PowerPC|Mac_PPC|Macintosh)/)
	{
		$aver = 'InternetExplorer/'.$1;
		$os = $2;
		if (/ Opera (\d+\.\d*)/)
		{
			$aver = 'Opera/'.$1;
		}
	}
	elsif(/^Mozilla\/([\w\.\-]+) .*\(([^;\)]+)/)
	{
		$aver = 'Netscape/'.$1;
		$os = $2;
		if (/\([cC]ompatible;/)
		{
			$aver = $agent;
			$os = '*不明*';
		}
		elsif (/(AVE-Front[^ \(]*) *\(/)
		{
			$aver = $1;
			if (/Product=([^;\)]+)/)
			{	$os = $1;	}
			else
			{	$os = '*不明*';	}
		}

		elsif (m| Gecko/\d+|)
		{
			$aver = 'Netscape/6.x';
		}
	}
	else {

		$aver = $agent;
		$os = '*不明*';
	}

	$aver =~ s|/(\d+)\.\d+[\w\.\-]*|/$1\.x|;

	if (!/Win/)
	{	if (/^Mozilla\/[\w\.\-]+ .*\(([^;]+); [INU]; ([\w\.\-]+)/)
		{
			$os = $1.'_'.$2;
		}
	}

	$os =~ s/[\. ]+$//;
	$os =~ s/Macintosh_/Mac_/;
	$os =~ s/^Mac_PPC/Mac_PowerPC/;
	$os =~ s/^(Win16|Win32)/Windows 3.1/;
	$os =~ s/^(Win9|Windows_*9)/Windows 9/;
	$os =~ s/^(NT|WinNT)(\d+)/Windows NT $2/;
	$os =~ s/^(NT|WinNT|Windows_*NT)/Windows NT/;

	$os =~ s/^(Windows NT 5\.0|Win2000)/Windows 2000/;
	$os =~ s/^(Windows NT 5\..)/Windows XP/;
	$os = '*不明*'	if (!$os);

	$this->{OS}->{$os} += 1;
	$this->{agents}->{$aver} += 1;
}

sub dspGlobalInfo
{
	my ($this, $dtm, $days) = @_;
	my ($stm, $etm, $anm, $sec,$min,$hour,$mday,$mon,$year,$wday);

	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($dtm - 86400*($days-1));
	printf('<H2>%d/%.2d/%.2d %.2d:%.2d:%.2d', $year+1900,$mon+1,$mday,$hour,$min,$sec);
	($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($dtm + (86400-1));
	printf(" 〜 %d/%.2d/%.2d %.2d:%.2d:%.2d</H2>\n", $year+1900,$mon+1,$mday,$hour,$min,$sec);

	$stm = $this->{firstLog}->getCtm;
	$etm = $this->{lastLog}->getCtm;
	if ($etm < $stm)
	{	print "<H3>指定範囲にアクセス記録はありません</H3>\n";	}
	else {
		($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($stm);
		printf('<H3>( 記録 %d/%.2d/%.2d %.2d:%.2d:%.2d', $year+1900,$mon+1,$mday,$hour,$min,$sec);
		($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($etm);
		printf(" 〜 %d/%.2d/%.2d %.2d:%.2d:%.2d )</H3>\n", $year+1900,$mon+1,$mday,$hour,$min,$sec);

		$anm = $this->{sampleNum};
		printf("$anm セッション (平均セッション数 =%5.1f 件/日、平均ページビュー数 = %5.1f 回/日)<P>\n",
				$anm/$days, $this->{hitNum}/$days);
	}
}

sub startGraphs
{
	my $this = shift;

	$this->addTLDcmnt('domains', '');
#	$this->addTLDcmnt('noJPurls', '</A>');#行頭の'#'を外すと「国外のアクセス」集計に解説がつきます

	print "<A name=\"GRPINDEX\"></A><TABLE frame=box rules=none border=2 cellpadding=4 cellspacing=0><CAPTION>目次</CAPTION>\n";
}

sub regGraph
{
	my ($this, $title, $dataword, $limit, $sorttype, $dsptype) = @_;

	my $dataref = $this->{$dataword};
	return 0 if (!%$dataref);
	print "<TR><TD><A href=\"#$dataword\">$title</A><BR></TD></TR>\n";
	push(@{$this->{regGraph}}, [$title, $dataword, $limit, $sorttype, $dsptype]);
	1;
}

sub finishGraphs
{
	my ($this, $addtable) = @_;
	print "<TR><TD>$addtable</TD><TR>\n</TABLE><BR><HR>\n";
}

sub dispGraphs
{
	my $this = shift;
	my ($reggrp, $regdats);
	$reggrp = $this->{regGraph};
	foreach $regdats (@$reggrp)
	{
		if ($this->dspbargraph(@$regdats))
		{	print "<A href=\"#GRPINDEX\"><FONT size=\"-1\">▲目次</FONT></A><BR>\n";	}
	}
}

sub prHgraph
{
	my ($keywd, $cnt, $rno) = @_;
	if ($rno & 1) { $bgc1 = '#d0ffe0'; $bgc2 = '#d0e0ff'; }
	else		  { $bgc1 = '#d0e0ff'; $bgc2 = '#d0ffe0'; }
	print "<TR bgcolor=$bgc1><TD>&nbsp; $keywd $unitname</TD>\n";
	print "<TD align=right bgcolor=$bgc2><FONT size=-1>$cnt</FONT></TD>\n";
	print "<TD><TABLE border=0 cellpadding=0 cellspacing=0 align=left>\n<TR><TD>";
	if ($cnt > 0)
	{	$wd = 1 if (($wd = int($cnt * $scale)) <= 0);
		if ($hBarImg)
		{	$bakgnd = "bgcolor=\"$bgc1\" background=\"$hBarImg\"";	}
		else
		{	$bakgnd = 'bgcolor="#00a020"';	}

		print "<TABLE border=0 cellpadding=0 cellspacing=0 cols=1 lows=1 width=$wd height=16 $bakgnd><TR><TD><BR></TD></TR></TABLE>";
	}
	else
	{	print '<BR>';	}

	printf "</TD><TD> <FONT size=-1>&nbsp;%4.1f\%</FONT><BR>\n", $cnt*$percent;
	print "</TD></TR></TABLE></TD></TR>\n";
}

sub prVgraph
{
	my ($keywd, $cnt, $rno) = @_;
	if ($rno & 1) { $bgc1 = '#d0ffe0'; $bgc2 = '#d0e0ff'; }
	else		  { $bgc1 = '#d0e0ff'; $bgc2 = '#d0ffe0'; }

	printf "<TD align=\"center\" valign=\"bottom\" bgcolor=\"$bgc1\"><FONT size=-1>%4.1f%%<BR>", $cnt*$percent;
	if ($cnt > 0)
	{	$wd = 1 if (($wd = int($cnt * $scale)) <= 0);
		if ($vBarImg)
		{	$bakgnd = "bgcolor=\"$bgc1\" background=\"$vBarImg\"";	}
		else
		{	$bakgnd = 'bgcolor="#00a020"';	}

		print "<TABLE border=0 cellpadding=0 cellspacing=0 cols=1 lows=1 width=16 height=$wd $bakgnd><TR><TD><font size=1><BR><font></TD></TR></TABLE>\n";

		print "$cnt<BR>";
		print "$keywd$unitname<BR></FONT>";
	}

	print "</TD>";
}

sub dspbargraph
{
	my ($this, $title, $dataword, $limit, $sorttype, $dsptype) = @_;
	my ($dataref, $cnt, $keywd, $perclim, $othern, $maxcnt, @keywds, $rno);
	local ($unitname, $percent, $scale, $hBarImg, $vBarImg);

	$dataref = $this->{$dataword};
	return 0 if (!%$dataref || !$this->{sampleNum});
	$unitname = '';
	if ($sorttype eq 'wday')
	{	@keywds = @{$this->{wstr}};	$unitname = '曜日';	}
	elsif ($sorttype eq 'date')
	{	@keywds = sort { $b cmp $a } keys %$dataref;	}
	elsif ($sorttype eq 'cnts')
	{	@keywds = sort { $a <=> $b; } keys %$dataref;
		$unitname = '回';
	}
	elsif ($sorttype eq 'time')
	{	@keywds = sort { $a <=> $b; } keys %$dataref;	$unitname = '時';	}
	else
	{	@keywds = sort { $dataref->{$b} <=> $dataref->{$a}; } keys %$dataref;	}
	
	if ($sorttype eq 'page')
	{	$cnt = 0;
		LOOP: foreach $keywd (@keywds)
		{	$cnt += $$dataref{$keywd};	}
		$percent = 100/$cnt;
	}
	else
	{	$percent = 100/$this->{sampleNum};	}
	if ($limit =~ /%$/)
	{
		$limit = $`;
		$perclim = $limit;
		$limit *= $this->{sampleNum}/100;
		$limit = 0 if ($limit < 1);
	}
	
	$othern = $maxcnt = 0;
	foreach $keywd (@keywds)
	{	$cnt = $dataref->{$keywd};
		$othern += $cnt	if ($cnt < $limit);
		$maxcnt  = $cnt	if ($cnt > $maxcnt);
	}
	$maxcnt = $othern	if ($othern > $maxcnt);
	return 0 if (!$maxcnt);
	
	print "<A name=\"$dataword\"></A><BR><TABLE width=90% frame=void rules=none cols=1 rows=1 bgcolor=#c0ffff cellpadding=4 cellspacing=0><TR align=center valign=bottom><TD><FONT size+=3><B>$title</B></FONT></TD></TR></TABLE>\n";

	$hBarImg = $this->{hBarImg};
	$vBarImg = $this->{vBarImg};
	if  ($dsptype ne 'yoko')
	{
		print "<TABLE frame=box rules=none border=2 cellpadding=0 cellspacing=0>\n";
		$scale = 200/$maxcnt;
		print '<TR>';
		LOOP: foreach $keywd (@keywds)
		{	$cnt = $$dataref{$keywd};
			last LOOP if ($cnt < $limit);
			&prVgraph($keywd, $cnt, $rno++);
		}
		if ($othern)
		{	if ($perclim)
			{	$str = sprintf('その他 (%d件[%d%%]未満)', $limit, $perclim);	}
			else
			{	$str = "その他 ($limit件未満)";	}
			&prVgraph($str, $othern, $rno++);
		}
		print '</TR>';
	}
	else
	{
		print "<TABLE frame=box rules=none border=2 width=90% cellpadding=2 cellspacing=0>\n";
		$scale = 400/$maxcnt;
		LOOP: foreach $keywd (@keywds)
		{	$cnt = $$dataref{$keywd};
			last LOOP if ($cnt < $limit);
			&prHgraph($keywd, $cnt, $rno++);
		}
		if ($othern)
		{	if ($perclim)
			{	$str = sprintf('その他 (%d件[%d%%]未満)', $limit, $perclim);	}
			else
			{	$str = "その他 ($limit件未満)";	}
			&prHgraph($str, $othern, $rno++);
		}
	}
	print "</TABLE><P>\n";
	return 1;
}

######################## PROGRAM END #########################
### ここから上はPerlの知識がない限り書き換えてはいけない！ ###
### ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ###
### HTMLの知識がある方は、”_END_”の下を自由に書き換えて  ###
### ください。（”_END_”自体は書き換えないでください！!） ###
###             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   ###
__END__
<P>
<CENTER>
<HR><P><TT>
▼この文章は、「accview.cgi」ファイルの末尾に定義されて▼<BR>
▲います。用途に合わせ、ご自由に変更していただけます。 ▲</TT></P>
</CENTER>

Zerion Mini Shell 1.0