#!/opt/perl-5.004/bin/perl -w
#
# $Id: treecounter.pl,v 1.2 1997/06/20 10:00:23 webadm Exp $
#
#
# DESCRIPTION: treecounter.pl - read referer and input, count for the
#   statistics and response with an appropriate message or a redirect
#
# URL: none yet
#
# AUTHOR: Cord Beermann (cord@Wunder-Nett.org)
#
# Thanks to: Ralf Begemann (begemann@cc.fh-lippe.de)
#	     Gerold Meerkoetter (gerold@noc.fh-lippe.de)
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# A Perl script is "correct" if it gets the job done before your boss fires
# you.
# ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen
#   & Randal. L. Schwartz)
#
# Bugs and shortcomings
# none yet
#
# Todo
# * write instructions
#
### Configuration ###
#
$DBROOT='/fhl/dvz/loesungen';
$WEBROOT='/var/infosystems/www/webroot';
$URLROOT='http://www.fh-lippe.de';
$SUCCESS_DB="$WEBROOT$DBROOT/.success.db";
#
### End of Configuration ###

# Initialize Variables
use vars qw ! $WEBROOT $DBROOT $SUCCESS_DB %success_db ! ;

# include perl-modules
use CGI::Carp;
use CGI qw(:standard);
use CGI qw(:shortcuts);
use POSIX;
use GDBM_File;

# initialize the CGI-Module and load the input
$query = new CGI;
$query->autoEscape(undef);

# get the current url, the referer and the request
$url = $query->url;
$self_url = $query->self_url;
$referer = $query->referer();
@request = $query->keywords;

# open the Database
tie(%success_db, GDBM_File, $SUCCESS_DB, O_CREAT|O_RDWR, 0644) or
    die("open $SUCCESS_DB: $!\n");

# set $request if unset
$request[0]='none' unless $request[0];

# ugly hack to put field name and referer together, but tie doesn't allow us
#  to store more demansional fields yet...

# if request is 'ja' and a referer is set do this:
if ($request[0] eq 'ja' and $referer) {
    # count $referer?ja
    ++$success_db{"$referer?ja"};
    # print a nice response to make the user happy ;-)
    &responsehead;
    print h2('Zähler');
    print p('Vielen Dank');
    # make a link back to the previous page
    print p(a({href=>"$referer"}, 'zurück zur Lösung'));
    &responsefoot;
# if request is 'nein' and a referer is set do this:
} elsif ($request[0] eq 'nein' and $referer) {
    # count $referer?nein
    ++$success_db{"$referer?nein"};
    # send the user on a feedback-page to tell us what made him to do this.
    print $query->redirect("$URLROOT" . '/cgi-bin/quick-report-page.pl?OPTION_betreff=' . $referer );
# if request is 'silent' and a document-URI is set do this.
} elsif ($request[0] eq 'silent' and $ENV{'DOCUMENT_URI'}) {
    # print a HTTP-Header
    print $query->header;
    # count $referer?count
    ++$success_db{"$URLROOT$ENV{'DOCUMENT_URI'}?count"};
# if request is 'log'
} elsif ($request[0] eq 'log') {
    # print a HTML-Page
    &responsehead;
    print(h2('Zählerstand'),
	  '<pre>'
	  );
    # table-head
    printf("zugr   ja nein Dokument\n");
    # print each known document sorted by counts.
    foreach $referer (sort {$success_db{$b} <=> $success_db{$a}}
		      keys(%success_db)) {
	# skip if $referer doesn't end on count
	next unless $referer =~ /\?count$/;
	# strip all after the questionmark from the URL
	$referer =~ s/\?.*$//;
	# store the URL in $referer
	$refname = $referer;
	# strip Servername and Path to the root of the DB from the URL
	$refname =~ s/$URLROOT$DBROOT\///;
	# print 
	printf("%4d %4d %4d <A HREF=\"%s\">%s</a>\n",
	       $success_db{"$referer?count"},
	       $success_db{"$referer?ja"},
	       $success_db{"$referer?nein"},
	       $referer,
	       $refname
	       );
    }
    # print a footer
    print('</pre>');
    &responsefoot;
# if the above things doesn't match do this:
} else {
    # if a referer is et send the user back to the place he came from
    if ($referer) {
	print $query->redirect("$referer");
    # else send himto the DB-Root
    } else {
	print $query->redirect("$URLROOT" . "$DBROOT" . '/');
    }
}

# close DB-File
untie(%success_db);

# subroutine to print a HTML-Header.
sub responsehead {
    print $query->header;
    print $query->start_html(-"title"=>'L&ouml;sungsdatenbank - Z&auml;hler',
			     -"author"=>'gnats@thalassa.cc.fh-lippe.de',
			     -"base"=>'true',
			     -"text"=>'#000000',
			     -"BGCOLOR"=>'#FFFFF7');
    print "\n";
    print img {-src=>'/Images/fhl/fh-picto.030tc3d-2.gif',-alt=>'Logo'};
    print("\n",
	  a({href=>'/'}, 'Einstiegsseite'), 
	  " /\n", 
	  a({href=>'/fhl/'}, 'FH Lippe'),
	  " /\n",
	  a({href=>'/fhl/dvz/'}, 'DVZ'),
	  " /\n",
	  a({href=>'/fhl/dvz/loesungen/'}, 'L&ouml;sungsdatenbank'),
	  "\n",
	  hr, 
	  "\n",
	  h1('L&ouml;sungsdatenbank')
	  );
}

# subroutine to print a HTML-footer.
sub responsefoot {
	print hr, address('Autor: ' . a({href=>'http://Cord.de/'}, 'Cord Beermann')), "\n";
	print $query->end_html;
}