Viewing gather.cgi

#!/usr/local/bin/perl5

package main;

use strict;
use CGI;
use File::stat;
use lib '/www/lib', '/usr/local/www/lib';
require 'chtml-template.pl';
require './browserlib.pl';
require 'lockfile.pl';

sub grindtmpl ($$$$);
sub grindtab ($$$);
sub abort ($$);

my $cgi = new CGI;
my $imgwid = 400;        # Maximum width the bars will be

my $tmpl = $ENV{'SCRIPT_FILENAME'};
$tmpl =~ s{[^/]*$}{gather.tmpl};
my $data = $tmpl;
$data =~ s{[^/]*$}{gather.data};
my $file = chtml_procfile ($tmpl);

abort ($cgi, "Couldn't open template") unless open F, "<$file";
my $text = undef;
while (<F>) {
    $text .= $_;
}
close F;

abort ($cgi, "Couldn't get data file") unless open F, "<$data";
my $ab = <F>;        # all browser
my $ap = <F>;        # all platform
my $wb = <F>;        # week browser
my $wp = <F>;        # week platform
close F;

#
# First we fill in the tables with everything except the usage bars.
# We want the length of the bars to be proportional to usage, and the
# maximum bar length should be the same as the maximum single usage
# entry.  Since we won't know the maximum until we actually generate
# the code for the tables, we put in placeholders for this first pass.
#
my $max = 0;
$text =~ s{<!--GATH all-->(.*)<!--GATH /all-->}
            {grindtmpl ($1, $ab, $ap, \$max)}es;
$text =~ s{<!--GATH week-->(.*)<!--GATH /week-->}
            {grindtmpl ($1, $wb, $wp, \$max)}es;

#
# Now that we know what the maximum value is, we can compute the bar lengths
#
$text =~ s{<!--GATH usage (\d+)-->}
            {'<img src="1pix.gif" width="' . int ($imgwid * $1 / $max) .
                '" height="10">'}ge;

#
# Save the user agent string.  Note we only do so if we can lock the file!
#
my $ua = $ENV{'HTTP_USER_AGENT'};
my $gfile = $ENV{'SERVER_GATHER'} . '/webinfo_case_gather';
my $warnstr = '';
unless (lockfile ($gfile)) {
    $warnstr = " (but couldn't save results - stray lock)";
} else {
    #
    # The process which will read the data from the gather directories
    # won't be able to clear the input file, so we use a timestamp created
    # by the data-reading process.  We clear the gather file if it was
    # read more recently than last written.
    #
    my $gfilewhen = "$gfile.READ";
    if (-f $gfile && -f $gfilewhen) {        # no gather file?  already empty!
        my $filest = stat $gfile;
        my $whenst = stat $gfilewhen;
        unlink $gfile if $filest->mtime < $whenst->mtime;
    }
    if (open F, ">>$gfile") {
        print F $ua, "\n";
        close F;
    } else {
        $warnstr = " (but couldn't save results - permission denied)";
    }
    unlockfile ($gfile);
}

#
# Now figure out what this user is using
#
my ($browser, $platform) = whatbrowser ($ua);
$text =~ s/<!--GATH browser-->/$browser/;
$text =~ s/<!--GATH platform-->/$platform $warnstr/;

print $cgi->header ('-content-length' => length $text), $text;

sub grindtmpl ($$$$) {
    my ($tmpl, $br, $pl, $max) = @_;
    $tmpl =~ s{<!--GATH btmpl-->(.*)<!--GATH /btmpl-->}
                {grindtab ($1, $br, $max)}es;
    $tmpl =~ s{<!--GATH ptmpl-->(.*)<!--GATH /ptmpl-->}
                {grindtab ($1, $pl, $max)}es;
    $tmpl;
}

sub grindtab ($$$) {
    my ($tmpl, $datain, $max) = @_;
    chomp $datain;
    my %data = split /\|/, $datain;
    my $sum = 0;
    foreach my $item (values %data) {
        $sum += $item;
        $$max = $item if $item > $$max;
    }
    my $out = undef;
    foreach my $item (sort {$data{$b} <=> $data{$a}} keys %data) {
        my $t = $tmpl;
        $t =~ s/<!--GATH tag-->/$item/;
        my $val = $data{$item};
        my $cnt = $val * 100.0 / $sum;
        $cnt .= '.0' unless $cnt =~ s/(\.\d)(.*)/$1/;
        $t =~ s/<!--GATH count-->/$val ($cnt\%)/;
        $t =~ s/<!--GATH usage-->/<!--GATH usage $val-->/;
        $out .= $t;
    }
    $out;
}

sub abort ($$) {
    my ($cgi, $str) = @_;
    my $data = $cgi->start_html (-title => 'Error') .
                $cgi->h1 ('Error') . $str . $cgi->end_html . "\n";
    print $cgi->header ('-content-length' => length $data), $data;
    exit 1;
}