%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/access.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.

################################
# データ単体クラス
################################
package AshiatoData;

sub getDateSec
{
	my ($stm) = @_;
	my ($dt,$tm,$hor,$mnt,$sec,$pyear,$pmon,$pday);
	my @montbl = (0,31,59,90,120,151,181,212,243,273,304,334);

	($dt, $tm) = split(/ /, $stm);

	($hor, $mnt, $sec) = split(/:/, $tm);
	$sec += ($hor*60 + $mnt)*60;

	($pyear, $pmon, $pday) = split(/\//, $dt);
	$pday -= 1 if (($pyear%4) || $pmon < 3);
	$pday += $montbl[$pmon-1];
	$pyear -= 1973;
	$pyear *= 365.25;

	$sec += ($pday+(int $pyear)+(365*2+366))*24*3600+$main::jsthor*3600;
	return $sec;
}

sub getRemoteHost
{
	my ($person) = @_;
	my $ipadr;
	my $host = $ENV{'REMOTE_HOST'};
	if ( ($host eq $person) || !$host )
	{

		{
			$ipadr = pack('C4', split(/\./, $person));
			($host) = eval 'gethostbyaddr($ipadr,2);';
		}
	}
	return $host;
}

sub chkMyHostAgent
{
	my ($agent, $host, $person) = @_;
	my ($envkey, $myagent, $myurl);
	$host =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	foreach $envkey (keys %main::myenv)
	{	($myagent, $myurl) = split(/ *:: */, $main::myenv{$envkey});
		if ($agent eq $myagent)
		{	$myurl =~ s/\./\\\./g;
			$myurl =~ s/\?/\./g;
			return 1  if ($host =~ m|$myurl| or $person =~ m|$myurl|);
		}
	}
	return 0;
}

sub chkMyURL
{
	my $ref = shift;
	my $myurl;
	
	foreach $myurl (@main::myurls)
	{	$myurl =~ s/([^\\])\./$1\\\./g;
		if ($myurl)
		{	return 1 if ($ref =~ m|$myurl|);	}
	}
	return 0;
}

sub new
{
	my ($class, $person, $agent, $url, $accTm, $stayTm, $ref, $scrCnd, $pageId, $accnt) = @_;
	my $this = {};
	$person =~ s/\s+$//;
	return 0 unless ($person);
	$this->{IPadr}	= $person;
	$this->{agent}	= $agent;
	$this->{accpnt}	= $url;
	$this->{CTM}	= $accTm;
	$this->{stayTm} = $stayTm;
	$this->{refer}	= $ref;
	$this->{scrCnd}	= $scrCnd;
	$this->{pageID}	= $pageId;
	$this->{accCnt}	= $accnt;
	bless $this;
}

#

#

#

#

#

#

sub getDiffTm
{
	my ($this, $other) = @_;
	return $other->{CTM} - $this->{CTM} - $this->{stayTm};
}

sub getCtm
{
	my $this = shift;
	return $this->{CTM};
}

sub getPageId
{
	my $this = shift;
	return $this->{pageID};
}

sub getStayTm
{
	my $this = shift;
	return $this->{stayTm};
}

sub getRefer
{
	my $this = shift;
	return $this->{refer};
}

sub getScrCnd
{
	my $this = shift;
	return $this->{scrCnd};
}

sub getAccCnt
{
	my $this = shift;
	return $this->{accCnt};
}

sub getHostAgent
{
	my $this = shift;
	return ($this->{accpnt}, $this->{agent});
}

sub getIPaddr
{
	my $this = shift;
	$this->{IPadr};
}

sub unify
{
	my ($this, $other) = @_;
	$this->{agent} = $other->{agent} if ($other->{agent});
	$this->{refer} = $other->{refer}	unless ($this->{refer});
	$this->{scrCnd} = $other->{scrCnd}	unless ($this->{scrCnd});
	$this->{pageID} .= $other->{pageID};
	$this->{accCnt} += $other->{accCnt};

	$this->{stayTm} = $other->{CTM} + $other->{stayTm} - $this->{CTM};
}

sub write
{
	my $this = shift;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($this->{CTM});
	$mon++;
	$year = 1900+$year;
	my $accStr = sprintf("%d/%.2d/%.2d %.2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec);
	my $stayStr = sprintf("%4d", $this->{stayTm});
	return $accStr.','. $stayStr.','. $this->{pageID}.','. $this->{IPadr}.','. $this->{accCnt}.','.
		   $this->{accpnt}.','. $this->{agent}.','. $this->{refer}.','. $this->{scrCnd}."\n";
}

sub newRead
{
	my ($class, $line) = @_;
	my ($accStr, $stayTm, $pageId, $person, $accnt, $url, $agent, $ref, $scrCnd) = split(/[,\r\n]/, $line);
#	my ($accStr, $stayTm, $pageId, $person, $accnt, $url, $agent, $ref, $scrCnd);	#互換
#	my @accdat = split(/[,\r\n]/, $line);	#互換
#	if ($accdat[1] =~ /^>/)	#互換
#	{	($accStr, $pageId, $person, $accnt, $url, $agent, $ref) = @accdat;	}	#互換
#	else 	#互換
#	{	($accStr, $stayTm, $pageId, $person, $accnt, $url, $agent, $ref, $scrCnd) = @accdat;	}	#互換
	if (!$url or $url eq $person)
	{

			my $ipadr = pack('C4', split(/\./, $person));
			eval '($url) = gethostbyaddr($ipadr,2);';
			$url = '-' if (!$url);

	}
	
	return 0 if (&chkMyHostAgent($agent, $url, $person));
	$ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$ref = '' if (&chkMyURL($ref));

	my $CTM = &getDateSec($accStr);
	$stayTm =~ s/^ +//;
	my $this = new $class, $person, $agent, $url, $CTM, $stayTm, $ref, $scrCnd, $pageId, $accnt;
	return $this;
}

################################
# データ配列クラス
################################
package AshiatoArray;

sub new
{
	my ($class, $intime) = @_;
	my $this = {
		DATS=>{},
		INTIME=>$intime,
	};
	bless $this;
}

sub getHash
{
	my $this = shift;
	$this->{DATS};
}

sub regist
{
	my ($this, $now) = @_;
	my ($person, $cnt, $diftm);
	$person = $now->getIPaddr;
	if ($this->{DATS}->{$person})
	{
		$diftm = $this->{DATS}->{$person}->getDiffTm($now);
		if ($diftm >= 0 and $diftm <= $this->{INTIME})
		{	$this->{DATS}->{$person}->unify($now);	}
		else
		{
			for ($cnt = 1; $this->{DATS}->{"$person+$cnt"}; $cnt += 1)
			{	}
			$this->{DATS}->{"$person+$cnt"} = $this->{DATS}->{$person};
			$this->{DATS}->{$person} = $now;
		}
	}
	else
	{	$this->{DATS}->{$person} = $now;	}
}

sub readFile
{
	my ($this, $dataFile) = @_;
	my $now;
	open(IN, $dataFile) || return 0;
	while (<IN>)
	{	s/#.*$//;
		s/^[\t ]//;
		$now = newRead AshiatoData($_);
		next unless ($now);
		if ($now->getIPaddr)
		{	$this->regist($now);	}
	}
	close(IN);
	return 1;
}

sub uniqDats
{
	my $this = shift;
	my ($key,@pageId, @uniqId, $ht, $nw);
	foreach $key (sort keys %{$this->{DATS}})
	{	@pageId = split(/>/, $this->{DATS}->{$key}->{pageID});

		$ht = shift @pageId;
		(@uniqId) = ($ht);
		foreach $nw (@pageId)
		{	push @uniqId,$nw if ($ht ne $nw);
			$ht = $nw;
		}

		$this->{DATS}->{$key}->{pageID} = join('>', @uniqId);
	}
}

sub writeFile
{
	my ($this, $dataFile) = @_;
	my $hashref = $this->{DATS};
	my @clist = sort { $hashref->{$b}->getDiffTm( $hashref->{$a} ); } keys %$hashref;
	my ($cip);

	open(FH, ">$dataFile") || return 0;
	print FH "#日時,滞留時間,あしあと,IP,ページ巡回数,URL,エージェント,リンク元,解像度\n";
	foreach $cip (@clist)
	{	$_ = $hashref->{$cip}->write;
		print FH;
	}
	close(FH);
	return 1;
}

################################
# ファイル読み書きクラス
################################
package AshiatoFile;

sub new
{
	my ($class, $wdir, $datafile, $errfile, $lockfile, $timeout, $trytimes, $intime, $updatetm) = @_;
	my $this;
	$this->{ARRAY}	  = new AshiatoArray($intime);
	$this->{DATFILE}  = $wdir . $datafile;
	$this->{ERRFILE}  = $wdir . $errfile;
	$this->{INTERVAL} = $updatetm;
	$this->{LOCK}	  = new FileLock($wdir, $lockfile, $timeout, $trytimes);
	bless $this;
}

sub getHash
{
	my $this = shift;
	$this->{ARRAY}->getHash;
}

sub err_log
{
	my ($this, $errmsg) = @_;

	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
	$mon++;
	$year = 1900+$year;

	open(FH, '>>'.$this->{ERRFILE}) || return 0;
	printf FH ('%d/%.2d/%.2d %.2d:%.2d ',$year,$mon,$mday,$hour,$min);
	print FH "$errmsg\n";
	close(FH);

	return 1;
}

sub makFileName
{
	my ($this, $ftm) = @_;
	
	my ($msec,$mmin,$mhor,$mmday,$mmon,$myear,$mwday) = localtime($ftm);
	my $logstr = sprintf("%.2d%.2d%.2d", ($myear + 1900) % 100, $mmon + 1, $mmday);
	
	$this->{DATFILE}.$logstr.'.csv';
}

#

sub readAccFile
{
	my $this = shift;
	my $rfile = shift;
	my $rtval;
	
	if ($rtval = $this->{LOCK}->my_flock)
	{
		if ($this->{ARRAY}->readFile($rfile))
		{	$this->{ARRAY}->uniqDats;	}
		else
		{	$this->err_log('記録ファイル'.$rfile.'を読み込めませんでした。');	}
		$this->{LOCK}->my_funlock;
		$this->err_log('ロックファイルが残留していました。') if ($rtval < 0);
	}
	return $rtval;
}

sub readWriteAccFile
{
	my $this = shift;
	my $rfile = shift;
	my $rtval;
	
	if ($rtval = $this->{LOCK}->my_flock)
	{
		if ($this->{ARRAY}->readFile($rfile))
		{	$this->{ARRAY}->uniqDats;
			$this->{ARRAY}->writeFile($rfile)
			||	$this->err_log('記録ファイル'.$rfile.'に書き込めませんでした。');
		}
		else
		{	$this->err_log('記録ファイル'.$rfile.'を読み込めませんでした。');	}
		$this->{LOCK}->my_funlock;
		$this->err_log('ロックファイルが残留していました。') if ($rtval < 0);
	}
}

################################
# ファイルロッククラス
################################
package FileLock;

sub new
{
	my ($class, $lockdir, $lockfile, $timeout, $trytimes) = @_;
	my $this = {
		dir => $lockdir, basename => $lockfile, timeout => $timeout, trytime => $trytimes,
		path => '', current => '', #sleepen => ''
	};

	$SIG{HUP} = $SIG{INT} = $SIG{PIPE} = $SIG{QUIT} = $SIG{TERM} = \&my_funlock;
	
	bless $this;
}

sub my_flock 
{
	my $this = shift;
	$this->{path} = $this->{dir} . $this->{basename};
	for (my $i = 0; $i < $this->{trytime}; $i++)
	{	return 1 if (rename($this->{path}, $this->{current} = $this->{path} . time));
		sleep 1;
	}

	opendir(LOCKDIR, $this->{dir});
	my @filelist = readdir(LOCKDIR);
	closedir(LOCKDIR);
	foreach (@filelist)
	{
		if (/^$this->{basename}(\d+)/) {
	    	return -1 if (time - $1 > $this->{timeout} and
	    		rename($this->{dir} . $_, $this->{current} = $this->{path} . time));
			last;
		}
	}
	0;
}

sub my_funlock {
	my $this = shift;
	rename($this->{current}, $this->{path}) if ($this->{current});
}

1;

Zerion Mini Shell 1.0