#!/usr/local/bin/perl5 -w
#	Add latest URL Information to file
#
require "cgi-lib.pl";
$mailprog = '/usr/lib/sendmail';
#
$statusofread =  &ReadParse(*formdata);
$userdir = 'standalone';
if( $statusofread && exists($formdata{"username"}) ) {
        $userdir = $formdata{"username"} if( defined($formdata{"username"}) );
}
$testuserdir = $userdir;
$testuserdir =~ tr/A-Z/a-z/;
if( ($testuserdir eq 'guest') || ($testuserdir =~ m%^anon%) )   {
        $userdir = 'standalone';
}
#
#	Base URL
$basefordumping = "/usr/local/archives/public/html/users/gcf/nobody/webwisdom/";
#
$today =`date`;
chomp($today);
#
$basefordumping .= $userdir .'/';
#
$filetodumpto = $basefordumping . 'storeurl';
#
$count = 0;
while (!&LockDatabase($filetodumpto)) { # Sleep for a second
        sleep(1);
        ++$count;
        &therewaserror("Server out to lunch -- please email -- lock stuck") if($count > 20);
}
#
#
$dumperrorflag=0;
if(-e $filetodumpto )	{
	open(FILETODUMPTO,'>>'.$filetodumpto) || ($dumperrorflag=1);
}
else	{
	open(FILETODUMPTO,'>'.$filetodumpto) || ($dumperrorflag=1);
	print FILETODUMPTO "List of URL's Visited\n";
}
if( $dumperrorflag == 1 )	{
	print "Location: http://www.npac.syr.edu/users/gcf/webwisdom/StandAloneDumpedError.html\n\n";
	&UnlockDatabase($filetodumpto);
	exit 1;
}
#
print FILETODUMPTO "New URL ",$today," ";
print FILETODUMPTO $ENV{'REMOTE_ADDR'},' ',$ENV{'REMOTE_HOST'},' ';
#
if( $statusofread )	{
	print FILETODUMPTO $formdata{"url"},"\n";
}
else	{
	$dumperrorflag=1;
	print FILETODUMPTO "Error\n";
}
close(FILETODUMPTO);
open(FILETODUMPTO,'>>'.$filetodumpto) || ($dumperrorflag=1);
close(FILETODUMPTO);
#
&UnlockDatabase($filetodumpto);
#
if( $dumperrorflag == 1 )	{
	print "Location: http://www.npac.syr.edu/users/gcf/webwisdom/StandAloneDumpedError.html\n\n";
}
else	{
	print "Location: http://www.npac.syr.edu/users/gcf/webwisdom/StandAloneDumped.html\n\n";
}
exit;
#
sub therewaserror       {

        my($mess) = @_;
#
        print <<EOF;
Content-Type: text/html

<html>
<head>
<title>Error in standalonedump.pl Processing!</title>
</head>
<h2>Error in Processing URL Logging: $mess</H2>
Please correct or if it's our fault
<A HREF="mailto:gcf\@npac.syr.edu?subject=standalonedump.pl Lock Error $mess" onMouseOver="window.status=' Sadness!.';return true">Mail Complaint</A>
<hr>
EOF
	exit;
}
sub LockDatabase {
# PURPOSE: Attempt to "lock" the database by creating a lock file.
# INPUTS:  Database file name
# OUTPUTS: A boolean telling if the lock was successful

        my ($dbfile) = @_;

        if (-e "$dbfile.lock") {  # DB is already locked
                return 0;
        }
        else {
                system("touch $dbfile.lock");  # Create the lock file
                return 1;
        }
}

sub UnlockDatabase {
# PURPOSE: Attempt to "unlock" the database by deleting the lock file.
# INPUTS:  Database file name
# OUTPUTS: None (but should probably check that the unlock was successful)

        my ($dbfile) = @_;
        unless( (unlink("$dbfile.lock")) )      {
                open (MAIL, "|$mailprog gcf") || (&therewaserror("Server Error Can't Mail -- Please email us")) ;
                print MAIL <<EOF;
From:gcf
To:gcf
Subject:Error in unlink
------------------------------------------------------

Please check standalonedump.pl
EOF
                close(MAIL);
        }
}
#
sub cgidebug    {

open(DEBUGFILE,'>>/usr/local/archives/public/html/users/gcf/nobody/webwisdom/debug') || return;
foreach $val (@_)	{
	if(defined($val) )	{
		print DEBUGFILE $val,' ';
	}
	else	{
		print DEBUGFILE 'Undefined ';
	}
}
print DEBUGFILE "\n";
close(DEBUGFILE);
return;
}
#
1;

