%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/accviewsub.pl

##########################################################
#  Access Analysis "AshiatoLOG" Ver.2.01                 #
#  Copyright (c) 2000,2001,2002 Funakichi                #
#  All rights reserved.                                  #
##########################################################
# ATTENTION:This code is written with "S-JIS" character-set.

################################
# HTMLクラス
################################
package myHtml;

sub printHTMLheader
{
	my $ttl = shift;
	my $msg;

	print <<"_EOL_";
Content-Type: text/html; charset=SHIFT_JIS
Content-Language: ja
Pragma: no-cache
Cache-Control: no-cache
_EOL_

	print <<"_EOL_";

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<HTML lang="ja-JP">
<HEAD>
	<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
	<title>$ttl</title>
</HEAD>
<BODY text="#000000" bgcolor="#ffffff" link="#000099" vlink="#007D43" alink="#FF0000">
<DIV ALIGN="CENTER">
<b><font color="#CC0000">
<font face="Arial"><font size="+4">AshiatoLOG</font></font>
<font face="Arial,Helvetica"><font size="+2">Ver.</font></font><font face="Arial"><font size="+3">2.01</font></font>
</font></b>
<P>$msg</P>
</DIV>
_EOL_
}

sub printHTMLfooter
{
	print <<"_FOOT_";
<HR>
<DIV align=right>(c) 2000 <A href="http://www04.u-page.so-net.ne.jp/fa2/suga/?accview.cgi">Funa's Works</A>.</DIV>
</BODY>
</HTML>
_FOOT_
}

sub decodeForm {
	my $buffer = shift;
	my ($name, $value, $pair, @pairs, %FORM);
	if (!$buffer)
	{	if ($ENV{'REQUEST_METHOD'} eq "POST")
		{	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});	}
		else
		{	$buffer = $ENV{'QUERY_STRING'};	}
	}
	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		&Jcode::convert(\$value, 'sjis');
		$FORM{$name} = $value;
	}
	return %FORM;
}

################################
# クッキークラス
################################
package myCookie;

sub new
{
	my ($class, $cookieLimit, $path) = @_;
	my $this = {
		cookieLimit=>$cookieLimit,
		path=>$path,
		wcook=>{},
		rcook=>{}
	};
	bless $this;
}

sub addCookie
{
	my ($this, $key, $val) = @_;
	$val =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
	$this->{wcook}->{$key} = $val;
	$this->{rcook}->{$key} = $val;
}

sub setCookie
{
	my $this = shift;
	my ($date, $str, $ky, $val);
	my $hashref = $this->{wcook};
	
	$date = gmtime($^T + $this->{cookieLimit}).' GMT';
	
	while (($ky, $val)=each %$hashref)
	{	$str = "$ky=$val;";
		$str .= ' path='.$this->{path}.';' if ($this->{path});
		print "Set-Cookie: $str expires=$date\n";

	}
}

sub clearCookie
{
	my ($this, $key) = @_;
	$this->addCookie($key, 'xx');
	$this->{cookieLimit} = -3600;
	$this->setCookie;
}

sub readCookie
{
	my $this = shift;
	my ($key,$val);
	my $cooks = $ENV{'HTTP_COOKIE'};
	$cooks =~ s/; /;/ig;
	foreach ( split(/;/, $cooks) )
	{	($key,$val) = split(/=/);
		$this->{rcook}->{$key} = $val;
	}
}

sub getCookie
{
	my ($this, $key) = @_;
	my $val = $this->{rcook}->{$key};
	$val =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	$val;
}

################################
# パスワード暗号化クラス
################################
##########################################################
# Niftyでもso-netでも、crypt 関数が動作していないにもか
# かわらず、eval 'crypt...'が$@をセットしない(?)という不
# 都合があるため、全面的に crypt 関数の使用を中止します。
##########################################################
package myGatewd;

sub makeCriptGatewd
{
	my ($gatewd, $keywd) = @_;
	my ($ans, $klen, $glen, $maxl, $cnt, $gwd, @keywd, @gwd);

	$keywd =~ s/(.)/sprintf("%3d,", unpack("C", $1))/eg;
	@keywd = split(/,/, $keywd);
	$keywd = 0;
	foreach (@keywd)
	{	$keywd += $_;	}

	{	#crypt()使用不可の為、自前簡易暗号!
		$gwd = $gatewd;
		$gwd =~ s/(.)/sprintf("%3d,", unpack("C", $1))/eg;
		@gwd = split(/,/, $gwd);
		$glen = @gwd;
		$klen = @keywd;
		return $gatewd if (!$glen or !$klen);
		$maxl = ($klen > $glen)?$klen:$glen;
		for ($cnt = 0; $cnt < $maxl; $cnt += 1)
		{	$gwd[$cnt % $glen] = ($gwd[$cnt % $glen] + $keywd[$cnt % $klen]) & 255;	}
		$ans = pack("C$glen", @gwd);
	}
	return $ans;
}

sub chkCriptGatewd
{
	my ($answr, $orgGatewd, $keywd) = @_;
	my ($rtval, $klen, $alen, $maxl, $cnt, $ans, @keywd, @ans);

	{
		$keywd =~ s/(.)/sprintf("%3d,", unpack("C", $1))/eg;
		@keywd = split(/,/, $keywd);
		$ans = $answr;
		$ans =~ s/(.)/sprintf("%3d,", unpack("C", $1))/eg;
		@ans = split(/,/, $ans);
		$alen = @ans;
		$klen = @keywd;
		if (!$alen or !$klen)
		{
			return ($ans eq $orgGatewd)?1:0;
		}
		$maxl = ($klen > $alen)?$klen:$alen;
		for ($cnt = 0; $cnt < $maxl; $cnt += 1)
		{	$ans[$cnt % $alen] = ($ans[$cnt % $alen] - $keywd[$cnt % $klen]) & 255;	}
		$rtval = pack("C$alen", @ans);
		$rtval = ($rtval eq $orgGatewd)?1:0;
	}
	return $rtval;
}

sub getAccKey
{
	my $keywd = $ENV{'HTTP_USER_AGENT'};
	unless ($keywd)
	{	$keywd = $ENV{'REMOTE_HOST'};
		unless ($keywd)
		{	$keywd= $ENV{'REMOTE_ADDR'};
			unless ($keywd)
			{	$keywd='AshiatoLog Ver.2.01 by Funakichi';	}
		}
	}
	$keywd;
}

################################
# 集計表示オプション指定クラス
################################
package AshiatoOpt;

my %dspsws1 = (
	acpmin, 'あしあと(アクセスパターン)',
	pagmin, 'ページ別アクセス <B>(パーセント指定不可！)</B>',
	dommin, 'サブドメイン別アクセス数',
	ojpmin, '国外(JPドメイン外)のアクセス',
	hnamin, 'ホスト名',
	agnmin, 'ブラウザまたはエージェント',
	ostmin, 'OS',
	scrmin, '画面解像度',
	refmin, 'リンク元',
	rfsmin, '検索CGI個別集計',
	wrdmin, '検索単語(日本語)',
);

my %dspsws2 = (
	accCnts,	'同一アクセスでのページ巡回数(注目度)',
	stayTm,		'同一アクセスでの滞留時間 <small>(最初のアクセスから最後のアクセスまでの時間)</small>',
	reptCnts,	'IPでみる再訪問回数 <small>(固定IPの訪問者しか見分けられないので、捕捉率は低い)</small>',
	logDates,	'日別アクセス',
	logWeeks,	'曜日別アクセス',
	logHours,	'アクセス時間帯',
);

my @formlst = ('daybef', 'fdays', 'fbgn', 'fend', 'fdate');

sub new
{
	my ($class, $optlimit, $accssdir, $form) = @_;
	my $mycookie = new myCookie($optlimit,$accssdir);
	my $this = {
		FORM=>$form,
		MyCOOKIE=>$mycookie,
	};
	@dspsws = (keys %dspsws1);
	push (@dspsws, (keys %dspsws2));
	bless $this;
}

sub getCookieOpt
{
	my $this = shift;
	my $form = $this->{FORM};
	my ($tmp, $tmp2, $cnt, $dtm, $days, $swnam, @tmp);
	
	$this->{MyCOOKIE}->readCookie;
	
	if ($$form{'relative'})
	{
		$dtm = $^T - (($^T - $main::jsthor * 3600) % 86400) + ($$form{'daybef'} * 86400);	# 時刻を午前零時(JST)に巻き戻し、さらに指定日に巻き戻す($$form{'daybef'}<0).
		$days = $$form{'fdays'};
	}
	elsif ($$form{'absolute'})
	{
		$_ = $$form{'fbgn'};
		s|(..)(..)(..)|20$1/$2/$3|;
		$tmp = &AshiatoData::getDateSec($_);
		$_ = $$form{'fend'};
		s|(..)(..)(..)|20$1/$2/$3|;
		$tmp2 = &AshiatoData::getDateSec($_);
		$days = ($tmp2 - $tmp) / 86400;
		if ($days < 0)
		{	$days = -$days;
			$dtm = $tmp;
		}
		else
		{	$dtm = $tmp2;	}
		$days += 1;
	}
	elsif ($$form{'raw'})
	{
		$_ = $$form{'fdate'};
		s|(..)(..)(..)|20$1/$2/$3|;
		$dtm = &AshiatoData::getDateSec($_);
		$main::dn = '0-100';
	}
	else
	{
		$tmp = $this->{MyCOOKIE}->getCookie('formlst');
		@tmp = split(/\+/, $tmp);
		$cnt = 0;
		foreach (@formlst)
		{	$tmp = $tmp[$cnt++];
			$$_ = $tmp if ($tmp);
		}
	}
	
	$tmp = $this->{MyCOOKIE}->getCookie('minnum');
	@tmp = split(/\+/, $tmp);
	$cnt = 0;
	foreach (keys %dspsws1)
	{	$tmp = $tmp[$cnt++];
		$$_ = $tmp if ($tmp);
	}

	$tmp = $this->{MyCOOKIE}->getCookie('dspsw');
	@tmp = split(/\+/, $tmp);
	$cnt = 0;
	foreach (@dspsws)
	{	$tmp = $tmp[$cnt++];
		$tmp = 1 unless (defined $tmp);
		$swnam = "sw$_";
		$$swnam = $tmp;
	}
	
	foreach (keys %dspsws1)
	{	if ($tmp = $$form{$_})
		{	$$_ = $tmp;	}
	}

	if ($tmp = $$form{$dspsws[0]})
	{
		foreach (@dspsws)
		{	$swnam = "sw$_";
			$$swnam = ($$form{$swnam})?1:0;
		}
	}
	
	foreach (keys %dspsws1)
	{	if ($$_)
		{	eval "\$main::$_ = \$$_;";	}
	}
	foreach (@dspsws)
	{	eval "\$main::sw$_ = \$sw$_;";	}

	($dtm, $days);
}

sub setCookieOpt
{
	my $this = shift;
	my ($swnam, @tmp);
	my $form = $this->{FORM};
	my $mycookie = $this->{MyCOOKIE};
	
	foreach (keys %dspsws1)
	{	push(@tmp, $$_);	}
	$mycookie->addCookie('minnum', join('+', @tmp));
	
	undef @tmp;
	foreach (@dspsws)
	{	$swnam = "sw$_";
		push(@tmp, $$swnam);
	}
	$mycookie->addCookie('dspsw', join('+', @tmp));
	
	if ($$form{$formlst[0]})
	{	undef @tmp;
		foreach (@formlst)
		{	push(@tmp, $$form{$_});	}
		$mycookie->addCookie('formlst', join('+', @tmp));
	}
	
	$mycookie->setCookie;
}

sub dspOptFormHtml
{
	my $this = shift;
	my ($ky, $msg, $val, $sw, $t0,$t1,$t2,$t3,$t4,$t5, @filelst, @tmplst);
	
	print "<div align='CENTER'>\n<form method='POST' action='$main::dispfile'>\n";
	
	if ($main::gatewd)
	{
		print << "_EOL_";
<hr width='70%'>
	<B>パスワードを入力してください</B><BR>
	<input TYPE="password" NAME="gateData" VALUE=""><BR>
<hr width='70%'>
_EOL_
	}

	opendir(WDIR, $main::wrdir);
	@filelst = readdir(WDIR);
	closedir(WDIR);
	foreach (@filelst)
	{	next unless (/^$main::wrfile(\d+)\.csv$/);
		push(@tmplst, $1);
	}
	@filelst = (sort {$b cmp $a} @tmplst);

	if    ($daybef ==  0) { $t0=' selected'; }
	elsif ($daybef == -1) { $t1=' selected'; }
	elsif ($daybef == -2) { $t2=' selected'; }
	print <<"_EOL_";
  <p>
  表\示範囲指定１<br>
  <select size="1" name="daybef">
    <option$t0 value="0">今日</option>
    <option$t1 value="-1">昨日</option>
    <option$t2 value="-2">一昨日</option>
  </select>
_EOL_
	$t0 = $t1 = $t2 = '';
	if    ($fdays ==  1) { $t0=' selected'; }
	elsif ($fdays ==  2) { $t1=' selected'; }
	elsif ($fdays ==  3) { $t2=' selected'; }
	elsif ($fdays ==  5) { $t3=' selected'; }
	elsif ($fdays ==  7) { $t4=' selected'; }
	elsif ($fdays == 10) { $t5=' selected'; }
	print <<"_EOL_";
  <select size="1" name="fdays">
    <option$t0 value="1">一日</option>
    <option$t1 value="2">までの二日間</option>
    <option$t2 value="3">までの三日間</option>
    <option$t3 value="5">までの五日間</option>
    <option$t4 value="7">までの一週間</option>
    <option$t5 value="10">までの十\日間</option>
  </select>の集計を<input type="submit" value="表\示" name="relative">
  </p>
  <p>
  表\示範囲指定２<br>
  <select size="1" name="fbgn">
_EOL_
	$sw = 0;
	$fbgn = $filelst[$#filelst] unless($fbgn);	# $#xxは最後の要素の添字
	foreach (@filelst)
	{	$val = ($_ eq $fbgn)?' selected':'';
		/(..)(..)(..)/;
		$msg = $1+2000;
		print "    <option$val value='$_'>$msg年$2月$3日</option>";
		$sw++;
	}
	print <<"_EOL_";
  </select> から
  <select size='1' name='fend'>
_EOL_
	$fend = $filelst[0] unless($fend);
	foreach (@filelst)
	{	$val = ($_ eq $fend)?' selected':'';
		/(..)(..)(..)/;
		$msg = $1+2000;
		print "    <option$val value='$_'>$msg年$2月$3日</option>";
	}
	print <<"_EOL_";
  </select>までの集計を<input type="submit" value="表\示" name="absolute">
  </p>
_EOL_

	print <<"_EOL_";
  <p>
  個別一覧（生ログ）<br>
  <select size="1" name="fdate">
_EOL_
	$fdate = $filelst[0] unless($fdate);
	foreach (@filelst)
	{	$val = ($_ eq $fdate)?' selected':'';
		/(..)(..)(..)/;
		$msg = $1+2000;
		print "    <option$val value='$_'>$msg年$2月$3日</option>";
	}
	print <<"_EOL_";
  </select>のアクセス記録を<input type="submit" value="表\示" name="raw">
  </p>
_EOL_

	print <<"_EOL_";
  表\示オプション
  <table border="1">
    <tr>
      <TD>表\示項目 </TD>
      <TD>最低表\示数 </TD>
    </tr>
_EOL_
	
	while (($ky, $msg) = each %dspsws1)
	{	$val = eval "\$main::$ky";
		$sw = "sw$ky";
		$sw = ($$sw != 0)?' checked':'';
		print <<"_EOL_";
    <tr>
      <TD><input type="checkbox" name='sw$ky' value="1"$sw>$msg</TD>
      <TD><INPUT name='$ky' type="text" size="5" value=$val></TD>
    </tr>
_EOL_
	}
	
	while (($ky, $msg) = each %dspsws2)
	{	$sw = "sw$ky";
		$sw = ($$sw != 0)?' checked':'';
		print <<"_EOL_";
    <tr>
      <TD colspan="2"><input type="checkbox" name='sw$ky' value="1"$sw>$msg</TD>
    </tr>
_EOL_
	}
	print "  </table>\n</form>\n</div>\n";
}

1;

Zerion Mini Shell 1.0