#!/usr/local/bin/perl -Tw

# Copyright (c) James Blustein 1996-2002
# 15 Sep 2002 (version 3.0a)
#   This version prints after recording (v2.1.2 redirected after recording)

# -- pragmas
  use strict;
  use integer;
  use CGI qw(:standard); # for cookie code
  use CGI::Carp qw(carpout fatalsToBrowser);
  use diagnostics;

  use constant DEBUG_OUTPUT => 0;
  use constant VERBOSE      => 0;
  use constant VERSION      => 'link-track.pl v3.0a (15 September 2002)';
  use constant LOG_FNAME    => 'log';
  use constant TEXTDIR      => 'http://url.where.the/docs/seem/to/be/';

BEGIN {
    $| = 1;  # unbufferred output
    print "Content-type: text/plain\n\n";
    print "This is `" . VERSION . "'\n" if VERBOSE or DEBUG_OUTPUT;
}

{
   my($home);
   my($input) = new CGI;

   # -- initialization
   $home = "/actual/home/of/the/docs/";

   my(%cookie) = cookie('values');
   my($user)   = $cookie{'user'} || -255;
   my($dir)     = $home . "TPJ/Log";
   my($logfile) = "$dir/u${user}/" . LOG_FNAME;

   # -- sanity checks
   &error('No $home') if (!defined($home));

   if ((1 > $user) || ($user > 5)) {
       warn " ** In testing mode **\n";
   } else { # untaint 
       $user =~ /^([1-5])/;
       $user = $1;
   }

   # -- get paramaters from CGI call
   my($doc)   = $input->param('d');
   my($to)    = $input->param('h');
   my($from)  = $input->param('n');
   my($title) = $input->param('t');

   # -- open log file
   # -- open logfile by changing to directory (I don't know why this is necc.)
   my($chdir_status) = chdir($dir);
   &error("error from chdir($dir): $!\n") if (0 == $chdir_status);
   $chdir_status = chdir("u${user}/");

   &error("error from chdir(u${user}/) " .
          "(cwd=$dir): $!\n")
         if (0 == $chdir_status);

   if (not((-f LOG_FNAME) and (-w LOG_FNAME))) {
       &error("Missing or incorrect logfile\nfilename = \"$logfile\"");
   } 
   open (LOG, ">> " . LOG_FNAME) 
       or &error("opening log file \"$logfile\": $!");


   if ((defined $from) and (defined $to)) {
       # -- write entry to log file
       &log_entry(\*LOG, $from, $to, defined($title)?$title:"");
       close LOG or &error("closing \"$logfile\": $!");

       # -- output to keep browser happy
       print "link-track OK\n";
       exit 0;
   } else {
       close LOG or &error("(no fields by the way) closing \"$logfile\": $!");
       &error("Can't find CGI fields (`from', `to', etc.)\n");
   }
}


# -- subroutines
sub html_quote {
    my($message) = @_;

    $message =~ s/&/&amp\;/g;
    $message =~ s/</&lt\;/g;
    $message =~ s/>/&gt\;/g;

    return $message;
} # html_quote();


sub error {
	   my($message) = @_;
	   
           print "-------------------\n";
	   print "** Error Message **\n";
           print "-------------------\n\n";
	   print $message . "\n";
	   print "Author = J. Blustein\n";
	   die;
} # error()


sub now {
	 use POSIX qw(strftime);

         return strftime("%a %d %b %Y  %X", localtime(time));
     } # now()



	
sub log_entry {
    my($OUT,$from,$to,$extra) = @_;

    print $OUT "\n" . &now . "\n";
    print $OUT "  f='$from'  t='$to'\n  n='$extra'\n";
} # log_entry()