File Coverage

blib/lib/FAQ/OMatic/Log.pm

Criterion	Covered	Total	%
statement	9	136	6.6
branch	0	52	0.0
condition	0	17	0.0
subroutine	3	12	25.0
pod	0	9	0.0
total	12	226	5.3

##############################################################################
# The Faq-O-Matic is Copyright 1997 by Jon Howell, all rights reserved.      #
#                                                                            #
# This program is free software; you can redistribute it and/or              #
# modify it under the terms of the GNU General Public License                #
# as published by the Free Software Foundation; either version 2             #
# of the License, or (at your option) any later version.                     #
#                                                                            #
# This program is distributed in the hope that it will be useful,            #
# but WITHOUT ANY WARRANTY; without even the implied warranty of             #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              #
# GNU General Public License for more details.                               #
#                                                                            #
# You should have received a copy of the GNU General Public License          #
# along with this program; if not, write to the Free Software                #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.#
#                                                                            #
# Jon Howell can be contacted at:                                            #
# 6211 Sudikoff Lab, Dartmouth College                                       #
# Hanover, NH  03755-3510                                                    #
# [e-mail]                                                      #
#                                                                            #
# An electronic copy of the GPL is available at:                             #
# http://www.gnu.org/copyleft/gpl.html                                       #
#                                                                            #
##############################################################################

use strict;

##
## FaqLog.pm -- access logging facilities
##

package FAQ::OMatic::Log;

use FAQ::OMatic;
use Time::Local;

# given 'YYYY-MM-DD' and a number of days, return a 'YYYY-MM-DD' that far
# away.
sub adddays {
	my $date = shift;		# YYYY-MM-DD
	my $daydiff = shift;	# int
	my ($year,$mo,$day) = split('-',$date);
	my (@localt) = (0,0,9,$day,$mo-1,$year-1900);
		# I use 9:00 AM because 24 hours before midnight 1997-04-07 is
		# 11 pm 1997-04-05, which is not what I meant. Darn DST. Watch
		# out for that.

	my $unixtime = Time::Local::timelocal(@localt);
	my ($sec2,$min2,$hr2,$day2,$mo2,$yr2,$wday2,$yday2,$isdst2) =
		localtime($unixtime+3600*24*$daydiff);
	return sprintf("%04d-%02d-%02d",
				$yr2+1900, $mo2+1, $day2);
}

# man, why doesn't anybody ever include this or max or min in their
# dumb libraries?
sub round {
	my $arg = shift;
	return ($arg < 0) ? int($arg-0.5) : int($arg+0.5);
}

# give the difference in days between two given days in 'YYYY-MM-DD' form
sub subTwoDays {
	my $day1 = shift;	# YYYY-MM-DD
	my $day2 = shift;	# YYYY-MM-DD

	my ($y,$m,$d) = split('-', $day1);
	my @localt = (0,0,9,$d,$m-1,$y-1900);
	my $unixt1 = Time::Local::timelocal(@localt);

	my ($y2,$m2,$d2) = split('-', $day2);
	my @localt2 = (0,0,9,$d2,$m2-1,$y2-1900);
	my $unixt2 = Time::Local::timelocal(@localt2);

	return round(($unixt1 - $unixt2)/86400);
}

# return today in 'YYYY-MM-DD' form
sub numericToday {
	my ($sec,$min,$hr,$day,$mo,$yr,$wday,$yday,$isdst) = localtime(time());
	return sprintf("%04d-%02d-%02d",
				$yr+1900, $mo+1, $day);
}

# return today in 'YYYY-MM-DD-HH-MM' form
sub numericDate {
	my ($sec,$min,$hr,$day,$mo,$yr,$wday,$yday,$isdst) = localtime(time());
	return sprintf("%04d-%02d-%02d-%02d-%02d-%02d",
				$yr+1900, $mo+1, $day, $hr, $min, $sec);
}

sub logEvent {
	my $params = shift;

	my $date = numericDate();
	my $host = $ENV{'REMOTE_HOST'} || 'unknown-host';
	$host = '-' if ($host eq '');
	my $prog = FAQ::OMatic::commandName();
	my $args = $params->{'file'} || '';
	my $browser = $ENV{'HTTP_USER_AGENT'} || 'unknown-agent';
	$browser =~ s/\s//g;

	$args .= "/".$params->{'partnum'}
		if (defined $params->{'partnum'});

	my $logfile = $FAQ::OMatic::Config::metaDir."/".numericToday().".rawlog";
	if (not open LOG, ">>$logfile") {
		FAQ::OMatic::gripe('problem',
			"FAQ::OMatic::Log::logEvent: The access logging system is "
			."not working. open failed ($!)");
		return;
	}
	print LOG "$date $host $prog $args $browser\n";
	close LOG;
}

sub summarizeDay {
	my $date = shift;
	$date = numericToday() if (not $date);	# summarize today
	my $prevdate = adddays($date, -1);
	my %uniquehosts;

	$date =~ m/([\d-]*)/;		# untaint $date
	$date = $1;

	#$ENV{'IFS'} = '';
	#$ENV{'PATH'} = '';
	# First, copy the unique hosts database from the previous day to today
	if ($FAQ::OMatic::Config::statUniqueHosts) {
		my $dbfile;
		foreach $dbfile (FAQ::OMatic::safeGlob($FAQ::OMatic::Config::metaDir,
					"^$prevdate.uhdb")) {
			my $newname = $dbfile;
			$newname =~ s#/$prevdate#/$date#;
			my @msrc = FAQ::OMatic::mySystem("cp $dbfile $newname");
			if (scalar(@msrc)) {
				FAQ::OMatic::gripe('note',
				"FAQ::OMatic::Log::summarizeDay: cp $dbfile $newname failed: "
					.join(', ', @msrc));
				# assume yesterday is just plain broken, and start fresh
				my $file;
				foreach $file (FAQ::OMatic::safeGlob(
								$FAQ::OMatic::Config::metaDir,
								"^$date.uhdb")) {
					unlink $file;
				}

				# touch the dbm files so we'll see them later
				if (not dbmopen(%uniquehosts,
						"$FAQ::OMatic::Config::metaDir/$date.uhdb", 0600)) {
					FAQ::OMatic::gripe('abort',
		"FAQ::OMatic::Log::summarizeDay: Can't create $FAQ::OMatic::Config::metaDir/$date.uhdb");
				}
				dbmclose %uniquehosts;
				last;
			}
		}
	}

	# now open $date's dbfile and insert the new hosts as we compute the
	# other statistics for the day.
	if ($FAQ::OMatic::Config::statUniqueHosts) {
		if (not dbmopen(%uniquehosts,
				"$FAQ::OMatic::Config::metaDir/$date.uhdb", 0400)) {
			FAQ::OMatic::gripe('abort',
				"FAQ::OMatic::Log::summarizeDay: Couldn't open "
				."dbm file $FAQ::OMatic::Config::metaDir/$date.uhdb. ($!)");
		}
	}

	# recycle nice hashed property mechanism of FAQ::OMatic::Items for summaries
	my $oldItem = new FAQ::OMatic::Item("$prevdate.smry", $FAQ::OMatic::Config::metaDir);
	my $item = new FAQ::OMatic::Item();
	$item->setProperty('Title', 'Faq-O-Matic Access Summary');

	# treat missing logs as very uninteresting days
	if (open LOG, "$FAQ::OMatic::Config::metaDir/$date.rawlog") {
		while (defined($_=)) {
			chomp;
			my ($date,$host,$op,$arg) = split(' ');
			$host = '' if (not defined $host);
			#$op =~ s/\.pl$//;	# '.pl' suffix is ugly, 'pl' is worse
			$op =~ s/\W//g;		# prevent bogus property keys
			if ($FAQ::OMatic::Config::statUniqueHosts) {
				# TODO: still not sure how to keep this from producing
				# bogus warnings.
				$uniquehosts{$host} = 1;
			}
			$item->{"Operation-$op"}++;
			$item->{'Hits'}++;
		}
		close LOG;
	}

	# store unique hosts stats
	if ($FAQ::OMatic::Config::statUniqueHosts) {
		my $oldCum = $oldItem->{'CumUniqueHosts'} || 0;
		$item->{'CumUniqueHosts'} = scalar(keys %uniquehosts);
		$item->{'UniqueHosts'} = $item->{'CumUniqueHosts'} - $oldCum;
	}

	# compute cumulative stats for Operations and Hits
	my %opnames=('Hits'=>1);
	my $key;
	foreach $key (keys %{$oldItem}) {
		$opnames{$key}=1 if ($key =~ m/^Oper/);
		$key =~ s/^Cum//;
		$opnames{$key}=1 if ($key =~ m/^Oper/);
	}
	foreach $key (keys %{$item}) {
		$opnames{$key}=1 if ($key =~ m/^Oper/);
	}
	foreach $key (keys %opnames) {
		my $newv = $item->{$key} || 0;
		my $oldc = $oldItem->{"Cum$key"} || 0;
		$item->{"Cum$key"} = $newv + $oldc;
		$item->{$key} = 0 if (not defined $item->{$key});
	}

	# compute derived stats
	if (($item->{'CumUniqueHosts'}||0) != 0) {
		$item->{'HitsPerHost'} = $item->{'CumHits'} / $item->{'CumUniqueHosts'};
	} else {
		$item->{'HitsPerHost'} = 0;
	}

	$date =~ m/^([\d-]*)$/;
	$date = $1;
	$item->saveToFile("$date.smry", $FAQ::OMatic::Config::metaDir);
	if ($FAQ::OMatic::Config::statUniqueHosts) {
		dbmclose(%uniquehosts);
		#dbmclose %uniquehosts
	}
}

# return the 'YYYY-MM-DD' of the earliest .smry file in metaDir.
sub earliestSmry {
	my $direntry;
	my $earliest;
	undef $earliest;

	# check for a hint
	if (open(HINT, "<$FAQ::OMatic::Config::metaDir/earliestLogHint")) {
		$earliest = ;
		chomp $earliest;
		close HINT;
	}

	# make sure the hint is valid
	if ((not defined $earliest) or
		(not -f "$FAQ::OMatic::Config::metaDir/$earliest.smry")) {

		# rediscover the earliest .smry
		$earliest = 'Z';	# should sort before anything
		opendir META, $FAQ::OMatic::Config::metaDir;
		while (defined($direntry = readdir META)) {
			next if (not $direntry =~ m/\.smry$/);
			$direntry =~ s/\.smry$//;
			$earliest = $direntry if ($direntry lt $earliest);
		}
		closedir META;
		return (undef) if ($earliest eq 'Z');

		# write out the hint
		if (open(HINT, ">$FAQ::OMatic::Config::metaDir/earliestLogHint")) {
			print HINT "$earliest\n";
			close HINT;
		}
	}

	return $earliest;
}

sub rebuildAllSummaries {
	# TODO:
	# notice we start at earliestSmry -- not the earliest rawlog. If
	# we weren't lame, we'd figure out the earliest rawlog and work from
	# there.
	my $earliest = earliestSmry();
	my $today = numericToday();
	my $dayi;

	for ($dayi=$earliest; $dayi lt $today; $dayi = adddays($dayi, 1)) {
		summarizeDay($dayi);

		my $twoDaysAgo = adddays($dayi, -2);
		# delete those uhdbs
	}
}

1;