#!/usr/bin/perl
####################################################
#                                                  #
# YAWSP                                            #
# Yet Another Web Statistics [Program | in Perl]   #
#                                                  #
# (C) January 2001 Stefano Selleri                 #
#           Quid alia facieri meliora non habet... #
#                                                  #
####################################################
# usage                                            #
#       yawsp.pl --help and read                   #
####################################################
# CAVEAT                                           #
#  Needs Getopt::Long and GD                       #
#  Please note that this program just builds PNG   #
#  images of statistics, so the HTML is up to you. #
#  gd diden't compiled with FreeType on my system, #
#  SIGH!!!!                                        #
#                                                  #
#  Developed with EDUCATIONAL purpouses for my     #
#  PERL class students (let's call them thais way) #
####################################################
# HYSTORIA                                         #
# 04-Jan-01 - 0.0.0 Project Starts                 #
# 05-Jan-01 - 0.0.1 Bug fixed in Agent/Os decoding #
#                                        [selleri] #
# 11-Jan-01 - 0.0.2 Ohh:                           #
#                   1 - Independent configuration  #
#                       file                       #
#                   2 - More colorfull             #
#                   3 - Help is smarter            #
#                   4 - POD subproject starting :) #
#                   4 - Comments are made nicer :) #
####################################################
$version = "0.0.2";

####################################################
# Load Appropriate modules:                        #
####################################################
use Getopt::Long;      # This plays with command line options
use GD;		       # Well, a little graphics...

####################################################
# Configuration stuff, change this as needed       #
####################################################
$WIDTH  = 600;
$OFFSET = 200;
@BGCOL  = (255,255,255);
$NCOL   = 2;
@{$COL[0]} = (255,0,0);
@{$COL[1]} = (0,0,255);

####################################################
# Get Options                                      #
####################################################
GetOptions ('help' => \$help,
            'log=s' => \$logfile,
            'rc=s' => \$rcfile
	   );

####################################################
# Configuration Stuff                              #
####################################################
# The Excellent and Learned Reader is kindly asked
# to note how the || operator is used to check, with
# a given order, various possible locations for the
# configuration file

open (FC,"<$rcfile") ||
open (FC,"<yawsp.rc") || 
open (FC,"<.yawsp.rc") || 
open (FC,"<$ENV{HOME}/.yawsp.rc") ||
open (FC,"</etc/yawsp.rc") ||
print "Hey! I can't find an RC file!\n\nRC file can be:\n\t./yawsp.rc\n\t./.yawsp.rc\n\t~/.yawsp.rc\n\t/etc/yawsp.rc\n\n\tor be specified with the --rc=file.rc switch.\n\n For this time I will use defaults ;)\n\n";

while (<FC>) {
  while(s/^ //){}
  while(s/ =/=/g){}
  while(s/= /=/g){}
  chomp();
  if (/^LOGFILE/ && ! defined $logfile) {($a,$logfile)=split(/=/)}
  # Note again that if $logfile is on the command line it takes precedence...
  if (/^WIDTH/i)     {($a,$WIDTH)=split(/=/)};
  if (/^OFFSET/i)    {($a,$OFFSET)=split(/=/)};
  if (/^BACKGROUND/i){($a,$b)=split(/=/); @BGCOL=split(/\,/,$b)}
  if (/^COLOR/i)     {($a,$b)=split(/=/);
		      $a=~s/COLOR//i;
		      @{$COL[$a]}=split(/\,/,$b);
		      if ($a+1>$NCOL) {$NCOL=$a+1}
		    }

}
close (FC);

####################################################
# help requested or something wrong with logfile   #
####################################################
if ($logfile eq "") {&help}
if ($help) {&longhelp}

####################################################
# Open LOG file                                    #
####################################################
open (LH,"<$logfile") || die "Cannot open $logfile\n";

$ACC=0;
while (<LH>) {
  ####################################################
  # Log is space separated, unfortunately items may  #
  # contain spaces, this is something Mr. Apache     #
  # shouldn't have done...                           #
  # Mask is  IP IDENT AUTHUSER [DATE] "REQUEST"      #
  # STATUS BYTES_SENT "PROVENIENCE" "AGENT"          #
  ####################################################
  /(.*?) (.*?) (.*?) \[(.*?)\] \"(.*?)\" (.*?) (.*?) \"(.*?)\" \"(.*?)\"/;
  $ip        = $1;
  $ident     = $2;
  $authuser  = $3;
  $date      = $4;
  $request   = $5;
  $status    = $6;
  $bytes     = $7;
  $prov      = $8;
  $agent     = $9;

  ####################################################
  # Statistics: Accesses                             #
  ####################################################
  $ACC++;

  ####################################################
  # Statistics: Hosts                                #
  ####################################################
  $IP{$ip}++;

  ####################################################
  # Statistics: Days                                 #
  ####################################################
  ($day,@junk)=split(/:/,$date);
  $DAY{$day}++;

  ####################################################
  # Statistics: Document                             #
  ####################################################
  $request=~s/^(.*?) (.*) (.*?)$/$2/g;
  if ($request=~/gif$/ || $request=~/png$/ || $request=~/jpg$/) {
    $IMG{$request}++;
  } else {
    $DOC{$request}++;
  }

  ####################################################
  # Statistics: Agent                                #
  ####################################################
  $agent=~s/\[(.*)\]//g;
  $agent=~/(.*?) \((.*?);(.*?)\)/;
  $agent = $1;
  $os    = $2;
  $AGENT{$agent}++;
  $OS{$os}++;

}

####################################################
# Ok, it's DRAW TIME!                              #
####################################################
&drawimage("ip.png","Hits vs. IP",\%IP);
&drawimage("day.png","Hits vs. Date",\%DAY);
&drawimage("img.png","Hits vs. Doc(Image)",\%IMG);
&drawimage("doc.png","Hits vs. Doc(HTML)",\%DOC);
&drawimage("agent.png","Hits vs. Browser Type",\%AGENT);
&drawimage("os.png","Hits vs. Guest OS",\%OS);

####################################################
# SUB Drawimage                                    #
####################################################
sub drawimage {
  my $imgname = shift;
  my $caption = shift;
  my $hashref = shift;

  my $nip = keys(%$hashref);

  ####################################################
  # Image & Color Allocations                        #
  ####################################################
  my $img = new GD::Image($WIDTH,20*($nip+1));
  my $back  = $img->colorAllocate(@BGCOL);
  my $black = $img->colorAllocate(0,0,0);
  my @col;
  for ($i=0;$i<$NCOL;$i++) {
    $col[$i]  = $img->colorAllocate(@{$COL[$i]});
  }
  $img->string(gdMediumBoldFont,3,3,$caption,$black);

  ####################################################
  # Some preliminaries                               #
  ####################################################
  my $max=0; 
  foreach $i (keys(%$hashref)) {
    if($$hashref{$i} > $max) {$max = $$hashref{$i}}
  }  

  for ($i=0;$i<=10;$i++) {
    $x = ($WIDTH-$OFFSET)*$i/10+$OFFSET;
    $grade = int($i*$max/10);
    $img->line($x-1,0,$x-1,20*($nip+1),$black);
    $img->string(gdMediumBoldFont,$x-length("$grade")*8,
		 3+20*$ii,$grade,$black);
  }

  $img->line(0,18,$WIDTH,18,$black);
  $img->line(0,20,$WIDTH,20,$black);

  ####################################################
  # Actual Drawing                                   #
  ####################################################
  my $ii=1; 
  foreach $i (sort(keys(%$hashref))) {
    $img->string(gdMediumBoldFont,$OFFSET-length($i)*8,
		 3+20*$ii,$i,$black);
    my $col = $col[$ii%$NCOL];
    $img->filledRectangle($OFFSET,5+20*$ii,$OFFSET+
			  $$hashref{$i}*($WIDTH-$OFFSET)/$max,
			  15+20*$ii,$col);
    $ii++;
  }  

  ####################################################
  # To Disk!                                         #
  ####################################################
  open (FH,">$imgname");
  print FH $img->png;
  close (FH);
}

####################################################
# SUB help                                         #
####################################################
sub help {
  print "yawsp.pl v. $version \n\nusage:\n\n";
  print "    yawsp.pl [--help] [--log=logfile] [--rc=rcfile] \n\n";
}

####################################################
# SUB longhelp                                     #
####################################################
sub longhelp {
  print "yawsp.pl v. $version \n\nusage:\n\n";
  print "    yawsp.pl [--help] [--log=logfile] [--rc=rcfile] \n\n";
  print "              --help | -h: prints this help.\n\n";
  print "              --log=logfile | -l logfile: tells yawsp which\n";
  print "                file to scan. A LOGFILE directive may be present\n";
  print "                in the rcfile, so this is optional. In any case\n";
  print "                command line switches takes precedence over \n";
  print "                configuration file directive.\n\n";
  print "              --rc=rcfile | -r rcfile: tells yawsp to use rcfile\n";
  print "                as the configuration file. Without this a file\n";
  print "                yawsp.rc is sought for in the current directory,\n";
  print "                in the user's home directory, in /etc. In this order.\n";
  print "                A rcfile is NOT mandatory. If it does not exist \n";
  print "                defaults are used.\n\n";
}

####################################################
# Good Old POD                                     #
####################################################

__END__

=head1 NAME

yawsp - Yet Another Web Statistic [Program | in Perl]

=head1 DESCRIPTION

soon to be released

=head1 USAGE

soon to be released (but later)

=head1 AUTHOR

This script is the product of Florence.pm Perl Mongers Group. Even if
started by B<Stefano Selleri> it has later on been largely improved
by... hey! I _need_ help!

=cut