# Copyright (c) 2002-2003 the World Wide Web Consortium :
#       Keio University,
#       European Research Consortium for Informatics and Mathematics
#       Massachusetts Institute of Technology.
# written by Olivier Thereaux <ot@w3.org> for W3C
#
# $Id: LogValidator.pm,v 1.12 2004/09/10 00:41:24 ot Exp $

package W3C::LogValidator;
use strict;

require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();
our $VERSION = sprintf "%d.%03d",q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;

our %config;
our $output="";
our $config_filename = undef;
our $verbose;
our %cmdline_conf;
our %hits; # hash URI->hits
our $output_proc;

###########################
# usual package interface #
###########################
sub new
{
	my $self  = {};
        my $proto = shift;
        my $class = ref($proto) || $proto;

	# server config is imported from the config module
        use W3C::LogValidator::Config;
	if (@_)
	{
		$config_filename = shift;
#		print "using config filename  $config_filename \n"; #debug
		if ($config_filename)
		{
	        	%config = W3C::LogValidator::Config->new($config_filename)->configure();
		}
		else
		{
			%config = W3C::LogValidator::Config->new()->configure();
		}
	}
	else
	{ %config = W3C::LogValidator::Config->new()->configure(); }

	# processing other options given at the command line
	if (@_)
	{
	%cmdline_conf= %{(shift)};
	}
	# verbosity : overriding config if given at command line
	if (defined($cmdline_conf{verbose}))
	{
		($config{LogProcessor}{verbose}) = $cmdline_conf{verbose};
		$verbose = $cmdline_conf{verbose};
	}
	# setting default verbosity if not given
	elsif (! defined($config{LogProcessor}{verbose}) )
	{
		($config{LogProcessor}{verbose}) = 1;
		$verbose = 1;
	}
	# output : overriding config if given at command line
	if ( defined($cmdline_conf{"UseOutputModule"}) )
	{
		$config{LogProcessor}{UseOutputModule} = $cmdline_conf{UseOutputModule};
	}
	elsif (! defined($config{LogProcessor}{UseOutputModule}))
	{
		$config{LogProcessor}{UseOutputModule} = "W3C::LogValidator::Output::Raw";
	}
	
	# output to file 
	# no "default value, will output to console if not set!
	if ( defined($cmdline_conf{"OutputTo"} ) )
	{
		$config{LogProcessor}{OutputTo} = $cmdline_conf{"OutputTo"};
	}

	# same for e-mail address to send to 
	# overrding conf file info with cmdline info
	if ( defined($cmdline_conf{"ServerAdmin"}) )	
	{
		$config{LogProcessor}{"ServerAdmin"} = $cmdline_conf{"ServerAdmin"};
	}

	use File::Temp qw/ /;
	my $tmpdir = File::Spec->tmpdir;
	$config{LogProcessor}{tmpfile} = File::Temp::tempnam( $tmpdir, "LogValidator-" );
	bless($self, $class);
	return $self;
}


sub sorted_uris
{
	my $self = shift;
	print "sorting logs: " if $verbose; # non-quiet mode
	my @uris = sort { $hits{$b} <=> $hits{$a} }
		keys %hits;

	my $theuri;
	my  $theuri_hit;
	my @theuriarry;
	@theuriarry = @uris;
	while ( (@theuriarry) and ($verbose > 1))
	{
		$theuri = shift (@theuriarry);
		$theuri_hit = $hits{$theuri};
		print "	$theuri $theuri_hit\n";
	}


	print "Done!\n" if $verbose; # non-quiet mode
	return @uris;
}

###################
# Server routines #
###################

sub add_uri
# usage $self->add_uri('http://foobar')
{
	my $self = shift;
	if (@_)
	{
		my $uri = shift;
		if ( exists($hits{$uri}) )
		{
			$hits{$uri} = $hits{$uri}+1;
		}
		else
		{ $hits{$uri} = 1 }
	}
}

sub read_logfiles
# just looping
{
	my $self = shift;
	my $current_logfile;
	use DB_File;
	my $tmp_file = $config{LogProcessor}{tmpfile};
	tie (%hits, 'DB_File', "$tmp_file") ||
	die ("Cannot create or open $tmp_file");
	
	print "Reading logfiles: " if ($verbose); #non-quiet mode
	print "\n" if ($verbose >1); # verbose or above, we'll have details so linebreak
	my @logfiles = @{$config{LogProcessor}{LogFiles}};
	foreach $current_logfile (@logfiles)
	{
		$self->read_logfile($current_logfile);
	}
	untie %hits;
	print "Done! \n" if ($verbose); #non-quiet mode

}



sub read_logfile
#read logfile, push uris  one by one with the appropriate sub
{
	my $self = shift;
	my $tmp_record;
	my $entriesperlogfile = $config{LogProcessor}{EntriesPerLogfile};
	my $entriescounter=0;
	if (@_)
	{
		my $logfile = shift;
		if (open (LOGFILE, "$logfile")) {
			print "	$logfile...\n" if ($verbose > 1); # verbose or above
			$entriescounter=0;
			while ( (($entriescounter < $entriesperlogfile ) or (!$entriesperlogfile)) # limit number of entries
			and ($tmp_record = <LOGFILE>)) 
			      
	 		{
				$tmp_record =~ chomp;
				my $logtype = $config{LogProcessor}{LogType}{$logfile};
				if ($tmp_record) # not a blank line
				{
					$tmp_record = $self->find_uri($tmp_record, $logtype);
					#print "$tmp_record \n" if ($verbose >2);
					if ($self->no_cgi($tmp_record)) {$self->add_uri($tmp_record);}
				}
				$entriescounter++;
			}
			close LOGFILE;
		} elsif ($logfile) {
			die "could not open log file $logfile : $!";
		}
	}
}

sub no_cgi
{
	my $self = shift;
	if (@_)
	{
		my $tmp_uri = shift;
		return (!($tmp_uri =~ /\?/));
	}
}


sub find_uri
# finds the "real" URI from a log record
{
	my $self = shift;
	if (@_)
	{
		my $tmprecord = shift;
		my @record_arry;
		@record_arry = split(" ", $tmprecord);
		# hardcoded to most apache log formats, included common and combined
		# for the moment... TODO
		my $logtype = shift;
		# print "log type $logtype" if ($verbose > 2);
		if ($logtype eq "plain")
		{
			$tmprecord = $record_arry[0];
		}
		elsif ($logtype eq "w3") # our W3C in-house log format
		{
			$tmprecord = $record_arry[4];
			# an oddity of W3C log formats
			my $serverstring = join ("",'http://',$config{LogProcessor}{ServerName});
			$tmprecord =~ s/$serverstring//;
			my $path = $config{LogProcessor}{DocumentRoot};
			$tmprecord =~ s/$path/\//;
			$tmprecord = $self->remove_duplicates($tmprecord);
			$tmprecord = join ("",'http://',$config{LogProcessor}{ServerName},$tmprecord);
			
		}
		else #common combined or full
		{
			$tmprecord = $record_arry[6];
			$tmprecord = $self->remove_duplicates($tmprecord);
			$tmprecord = join ("",'http://',$config{LogProcessor}{ServerName},$tmprecord);
		}
	return $tmprecord;
	}
}

sub remove_duplicates
# removes "directory index" suffixes such as index.html, etc
# so that http://foobar/ and http://foobar/index.html be counted as one resource
{
	my $self = shift;
	my $tmprecord;
	if (@_) { $tmprecord = shift;}
	my $index_file;
	foreach $index_file (split (" ",$config{LogProcessor}{DirectoryIndex}))
	{
		$tmprecord =~ s/$index_file$// if ($tmprecord);
	}
	return $tmprecord;

}



sub hit
{
	my $self = shift;
	my $uri=undef;
	if (@_) {$uri=shift}
	return $hits{$uri};
}

sub config_module
{
	my $self = shift;
	my $module_used; #= undef;
	if (@_)
	{ 	
		$module_used = shift;
	}
	my %tmpconfig = %{$config{LogProcessor}};
	#add module specific variables, override if necessary.
	if ( ($module_used) and (defined ($config{$module_used})))
	{	
		foreach my $modkey (keys %{$config{$module_used}})
		{
			if ( $config{$module_used}{$modkey} ) 
			{
				$tmpconfig{$modkey} = $config{$module_used}{$modkey}
			}
		}
	}
	return %tmpconfig;
}
	

sub use_modules
{
	my $self = shift;
	my @modules;
	# the value of the hash may be an array or a single value, 
	# we have to check this
	if (defined @{ $config{LogProcessor}{UseValidationModule} }) 
	{
		@modules = @{$config{LogProcessor}{UseValidationModule}} 	
	} 
	else # single entry that we push in an array
	{
		push @modules, $config{LogProcessor}{UseValidationModule};
	}
	foreach my $module_to_use (@modules)
	{
		eval "use $module_to_use";
		my $process_module;
		my %mod_config=$self->config_module($module_to_use);
		$process_module = $module_to_use->new(\%mod_config);
	#	$process_module->uris($self->sorted_uris); # not used anymore
		my %results = $process_module->process_list;
		

		# We're applying the output module and getting its (potential) output 
		my $output_tmp = $output_proc->output(\%results);
		$output = $output.$output_tmp;
		# TODO maybe make this a hash, one output string per output module used
		# that would allow us to have several output modules at the time... 
		# is this very useful?
	}
}


sub process
# this is the main routine
# processes the logfile, sorts the uris, and uses the chosen modules
{
	my $self = shift;
	if ($verbose > 2) #debug
	{
		print "showing general config : \n";
		foreach my $key ( keys %config)
		{
			my %modname = %{$config{$key}};
			print "Module	$key\n";
			foreach my $modkey (keys %{$config{$key}})
			{
				my $value = $config{$key}{$modkey};
				print " $modkey $value\n";
			}
		}
		print "End of config\n\n"
	}
	

	$self->read_logfiles;
	my $outputmodule = $config{LogProcessor}{UseOutputModule};
	eval "use $outputmodule";
	$output_proc = $outputmodule->new(\%{$config{LogProcessor}});
	$self->use_modules;
	$output_proc->finish($output);
	
}

package W3C::LogValidator;
1;

__END__

=head1 NAME

W3C::LogValidator - The W3C Log Validator - Quality-focused Web Server log processing engine 

Checks quality/validity of most popular content on a Web server

=head1 SYNOPSIS

Generic, basic use of the C<W3C::LogValidator> module. Parse configuration file and process relevant logs.

    use W3C::LogValidator;
    my $logprocessor = W3C::LogValidator->new("sample.conf");
    $logprocessor->process;

Alternatively (use default config and process logs)

    my $logprocessor = W3C::LogValidator->new;
    $logprocessor->process;


=head1 DESCRIPTION

C<W3C::LogValidator> is the main module for the W3C Log Validator, a combination of Web Server log analysis and statistics tool and Web Content quality checker.

As an easy alternative to using this module, the perl script logprocess.pl is bundled in the W3C::LogValidator distribution.

=head1 API

=head2 Constructor

=over 2 

=item $processor = W3C::LogValidator->new

Constructs a new C<W3C::LogValidator> processor.  You might pass a configuration file name, 
as well as a hash of attribute-value pairs as parameters to the constructor.  


I<e.g.> for mail output:

  %conf = (
    "UseOutputModule" => "W3C::LogValidator::Output::Mail",
    "ServerAdmin" => 'webmaster@example.com',
    "verbose" => "3"
    );
  $processor = W3C::LogValidator->new("path/to/config.conf", \%conf);

Or I<e.g.> for HTML output:

  %conf = (
    "UseOutputModule" => "W3C::LogValidator::Output::HTML",
    "OutputTo" => 'path/to/file.html',
    "verbose" => "0"
    );
  $processor = W3C::LogValidator->new("path/to/config.conf", \%conf);

If given the path to a configuration file, C<new()> will call the L<W3C::LogValidator::Config> module to get its configuration variables. 
Otherwise, a default set of values is used.

=back

=head2 Main processing method

=over 4

=item $processor->process

Do-it-all method:
Read configuration file (if any), parse log files, run them through processing modules, send result to output module.

=back

=head2 Modules methods

=over 4

=item $processor->config_module

Creates a configuration hash for a specific module, adding module-specific configuration variables, overriding if necessary

=item $processor->use_modules

Run the data parsed off the log files through the various processing (validation) modules specified by UseValidationModule in the configuration.

=back

=head2 Log parsing and URI methods

=over 4 

=item $processor->read_logfiles

Loops through and parses all log files specified in the configuration

=item $processor->read_logfile('path/to.file')

Extracts URIs and number of hits from a given log file, and feeds it to the processor's URI/Hits table

=item $processor->find_uri

Given a log record and the type of the log (common log format, flat list of URIs, etc), extracts the URI

=item $processor->remove_duplicates

Given a URI, removes "directory index" suffixes such as index.html, etc so that http://foobar/ and http://foobar/index.html be counted as one resource

=item $processor->add_uri

Add a URI to the processor's URI/Hits table

=item $processor->sorted_uris

Returns the list of URIs in the processor's table, sorted by popularity (hits)

=item $processor->no_cgi

Tests whether a given URI contains a CGI query string

=item $processor->hit

Returns the number of hits for a given URI. 
Basically a "public" method accessing $hits{$uri};

=back

=head1 BUGS

Public bug-tracking interface at http://www.w3.org/Bugs/Public/

=head1 AUTHOR

Olivier Thereaux <ot@w3.org> for The World Wide Web Consortium

=head1 SEE ALSO

perl(1).
Up-to-date information on this tool at http://www.w3.org/QA/Tools/LogValidator/

=cut

