#!/usr/bin/perl
# find the Web usage information for a specific user in the weekly
# report, and display it

$ICON_REG='http://www.columbia.edu/httpd/getstats/getstats.gif';
$ICON_SEC='https://www1.columbia.edu/icons/getstats.gif';

$SRVPORT=$ENV{'SERVER_PORT'};		# get server's port number
if ($SRVPORT eq '443') {		# secure server
  $ICON_OUT=$ICON_SEC;
  $basedir='/etc/httpd/data/sec/acis/rad/web-usage/homepag';
  $baseurl='https://www1.columbia.edu/sec/acis/rad/web-usage/homepag';
} else {				# regular server
  $ICON_OUT=$ICON_REG;
  $basedir='/etc/httpd/data/httpd/homepag';
  $baseurl='http://www.columbia.edu/httpd/homepag';
}

					# set defaults
$reptype='dtr';
$server='www';				# default server
$repdate='';
$webdir='';
$detail=2;
$honly='';
$sortkey='req';				# alp or req
$debug='';

if ($ENV{'REQUEST_METHOD'} eq 'GET') {	# get the input using method=GET
  $buffer = $ENV{'QUERY_STRING'};
} else {				# get the input using method=POST
  read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@pairs = split(/&/, $buffer);		# split the name-value pairs

foreach $pair (@pairs)			# put values into scalar variables
{
  ($name, $value) = split(/=/, $pair);

  # Un-Webify plus signs, undo the %-encoding
  $value =~ tr/+/ /;
  $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

  if ($name eq 'reptype') {		# report type: dtr, dom, red
    $reptype = $value;
  } elsif ($name eq 'server') {		# web server short name
    $server = $value;
  } elsif ($name eq 'repdate') {	# 8 digit report date
    $repdate = $value;
  } elsif ($name eq 'webdir') {		# desired directory
    $webdir = $value;
  } elsif ($name eq 'detail') {		# levels of detail
    $detail = $value;
  } elsif ($name eq 'honly') {		# count HTML files only
    $honly = $value;
  } elsif ($name eq 'sortkey') {	# alp or req
    $sortkey = $value;
  } elsif ($name eq 'debug') {
    $debug = $value;
  } else {
    &errmsg2("not a supported option: $name=$value");
  }
}

&errmsg2("repdate must be specified") unless $repdate;
&errmsg2("repdate must be numeric: $repdate")
				if $repdate =~ /\D/;
&errmsg2("repdate must be eight digits: $repdate")
				unless length($repdate)==8;

$repdir=$basedir;
$webdir =~ s|/$||;			# remove trailing slash
$webdirq='';
if ($webdir) {
  $webdir = '~' . $webdir unless $webdir =~ m|~|;  # add tilde
  $webdirq=$webdir;
  $webdir = '/' . $webdir unless $webdir =~ m|^/|; # add leading slash
  $webdir = "/Personal web pages$webdir"; # personal dirs are down one level
  @wdirs = split('/', $webdir);		# count the slashes in webdir
  $detail = $#wdirs if $detail < $#wdirs; # increase detail if necessary
  undef(@wdirs);
}

&errmsg2("$reptype reports not available for personal web pages")
     unless $reptype eq 'dtr';
&errmsg2("no personal web pages on server $server")
     unless $server eq 'www';

$honly='';
$sortkey='req';
$detail=2 if $detail<2;
$detail=4 if $detail>4;

unless ($webdir) {			# user wants FULL REPORT
		# URL of the form /httpd/homepag/19970816.dtrreq3.html
  print "Location: $baseurl/$repdate.$reptype$sortkey$detail.html\n\n";
  exit;
}

print "Content-type: text/html\n\n";	# user wants partial dir tree report

# construct file name of the form "19950114.dtrreq3.html"
$repfilnam = "$repdir/$repdate.$reptype$sortkey$detail.html";
if (!open(REP, "<$repfilnam")) {
  &errmsg("Can't open report file $repfilnam: $!");
}

$visible=1;
$dtr_header='';
while (<REP>) {
  # skip the summary and the top 10 list
  # save the Directory Tree Report header in memory

  # must display icon from server this CGI script is running on
  #  to prevent Netscape warnings about mixing secure and unsecure data
  s|$ICON_REG|$ICON_OUT|o;
  s|$ICON_SEC|$ICON_OUT|o;
  if (/\<!-- end summary --\>/) {
    $visible=1;
    next;
  }
  $visible='' if /\<!-- begin summary --\>/;
  s/Directory Tree Report/$& for $webdirq/;	# append dir name
  $dtr_header .= $_ if $visible;

  if ($visible && /------------------/) { # line after "Dir/file Req"
    $doffset = length($`);		# find starting column for URLs
    last;
  }
}

&errmsg("$webdir not found in $detail level report for $srv server")
		unless &extract_section($webdir, $dtr_header);

$visible='';
while (<REP>) {
    $visible=1 if /Created by /;
    print if $visible;
}
close REP;
exit;

########################################

sub extract_section {
    # print the relevant portion of the web usage report
    # returns 1 on success, '' otherwise

    local($webdir, $dheader) = @_;
    local($visible, $dirlevel, $offset, $tlev, $m, $j);
    local(@wdirs) = split('/', $webdir);

    # directory components are stored in the @wdirs array
    # e.g. /~abc34/gifs is translated to
    #    $wdir[1] = 'Personal web pages'
    #    $wdir[2] = '~abc34/'
    #    $wdir[3] = 'gifs/'


    $dirlevel = $#wdirs;		# levels specified by the user
    foreach $wdir (@wdirs) {
	$wdir .= '/' unless $wdir eq 'Personal web pages';
    }

repline:
    while (<REP>) {
	last repline if m|^\</pre\>|;
	chop($rline=$_);
	# set $tlev to the level of the current line (0 to 6)
	# set $dirname[$tlev] to the directory name
	for ($tlev = 0; $tlev <= 6; $tlev++) {
	    local($rlev) = $tlev;
	    local($roffset) = 0;	# level 0, indent 0
	    if ($rlev) {		# level 1, indent 1
		$roffset++;
		$rlev--;
	    }
	    $roffset += $rlev*3;	# indent 3 for each level past 1
	    $offset = $doffset+$roffset;
	    if (substr($rline, $offset, 1) ne ' ') {
		$dirname[$tlev] = substr($rline, $offset);
		last;
	    }
	}
	if ($visible) {
	    if (($tlev < $dirlevel) ||
		(($tlev == $dirlevel) && ($wdirs[$tlev] ne $dirname[$tlev]))) {
		last repline;		# we are done
	    }
	    print "$rline\n";
	} else {
	    next repline if $tlev != $dirlevel; # keep looking
	    $m = 1;
	    for ($j = 1; $j <= $dirlevel; $j++) {
		if ($wdirs[$j] ne $dirname[$j]) {
		    $m = 0;
		    last;
		}
	    }
	    if ($m == 1) {		# found beginning of section
		$visible = 1;
		print $dheader;
		print "$rline\n";
	    }
	}
    }
    return $visible;
} # extract_section



sub errmsg {				# print an error message
    local($mess) = @_;
    print "<head><title>Showstats Error</title></head>
<body><h1>Showstats Error</h1>
$mess</body>";
    exit;
}



sub errmsg2 {				# header + error message
    local($mess) = @_;
    print "Content-type: text/html\n
<head><title>Showstats Error</title></head>
<body><h1>Showstats Error</h1>
$mess</body>";
    exit;
}
