#!/usr/local/bin/perl

=pod
faking it so sitemap generator will have something to read
<HTML><HEAD><TITLE>Guestbook</TITLE></HEAD><BODY>&nbsp;</BODY></HTML>
=cut


$path = "/1/u3/v/r/vrexplor/public_html";

use CGI;




$query = new CGI;

if (lc($query->param('name')) eq 'update sitemap' and $query->param('email') =~ /kittyboy/){
   
    ($arg = $query->param('email') ) =~ s/kittyboy//;  #kittyboy -d for debug
	system "$path/gensitemap.pl  $arg>  $path/usingsite/sitemap/sitemap.draft.html";
    
	print $query->redirect('http://www.virtualexplorers.org/usingsite/sitemap/update_frameset.html');
	exit;
}
#Can't open usingsite//highlite.htm: No such file or directory at /usr/local/lib/perl5/site_perl/HTML/Parser.pm line 228. 


$self_url = $query->url;
print $query->header;

#foreach $k ($query->param){
#   print "$k: ",$query->param($k),"<br>\n";
# }



if ($query->param('Submit')){
   &update_file;
}

&get_doc;

print $TOP;

&print_gb_entries;

print $BOTTOM;


# ***************************************************
# UPDATE_FILE
# adds incoming information to guestbook file
# ***************************************************
sub update_file {
   foreach $var (qw (name email url comments)){
      $$var = $query->param($var);      
   }
   $url =~ s|http://||i;
   #return unless ($name or $email or $comments);
   return unless ($name and $email);
   return if &fail_ck822($email);
   $address = $ENV{'REMOTE_ADDR'};
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
                                            localtime(time);
   $mon += 1;
   $year += 1900;                                         
   $time = "$mon/$mday/$year";
   $datetime = scalar localtime;
   
   $data = join ("\t",$name, $email, $url, $comments, $time, $address, $datetime);
   #take out any html tags they might have embedded
   $data =~ s/</&lt;/g;
   $data =~ s/>/&gt;/g;
   #change any line breaks to <BR>
   $data =~ s/\n//g;
   $data =~ s/\r/<BR>/g;
   #if more than five line breaks, take 'em all out
   my $numbreaks = 0;
   while ($data =~ /<BR>/g){
		++$numbreaks;
	}
	if ($numbreaks > 5){
		$data =~ s/<BR>/ /g;
	}

   #security, take out anything not a likely ascii character
   $data =~ s/[^\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f]//g;
   #security, take the first thousand bytes
   $data = substr($data,0, 1000 );#> length($data) ? 1000 : $data);
   open (GB, ">>$path/_gb/guestbook") or print "can't open $path/_gb/guestbook $! ";
   print GB "$data\n";
   close GB;


}

# ****************************************************
# PRINT_GB_ENTRIES
# prints out 10 or so entries from the guestbook in the 
# middle of the page
# ****************************************************
sub print_gb_entries {
    $start_line = $query->param('Next 10') | $query->param('Back 10') | 0;
    
    if ($query->param('Next 10')){
       $start_line = $query->param('start_line') + 10;
    }elsif ($query->param('Back 10')){
       $start_line = $query->param('start_line') - 10;
    }
    $start_line = 0 if ($start_line < 0);
    
    $query->param('start_line',$start_line);
    print $query->hidden('start_line'),"<br\n>";
    
    open(GB, "$path/_gb/guestbook") or return; #print "can't open guestbook  $path/_gb/guestbook $!";
    print qq|<TABLE BORDER="3" CELLPADDING="1" CELLSPACING="1" WIDTH="100%">\n|;
    
    my $x;
    
    #need to get the last 50 lines from GB file
    $MAX_GB = 50;
    while (<GB>){
    	$GB[$x++ % $MAX_GB] = $_;
    	#push (@GB, $_);
    	#shift @GB if ($# >= 49);
    }
    close GB;

	#and print them out starting at the last one
	while ($_ = $GB[--$x % $MAX_GB]){
    #foreach (reverse @GB){    
       next unless (++$linenum > $start_line );
    
       ($name, $email, $url, $comment, $date, $addr) = split (/\t/);
       $color = $linenum%2 ? 'BGCOLOR="#CCFFCC"' : 'BGCOLOR="#FFFFFF"';
       print <<"EOLINE";
       
    	<TR>
       		<TD WIDTH="31%" $color>$date &nbsp;</TD>
             <TD WIDTH="69%" $color ROWSPAN="3">$comment &nbsp;</TD>
       </TR>	
       <TR>	<TD WIDTH="31%" $color>$name &nbsp;</TD>
       </TR>
       <TR>
             <TD WIDTH="31%" $color><A href="http://$url"> $url </a> &nbsp;</TD>
       </TR>
       
    
EOLINE
    
       last if ($linenum >= $start_line + 10);
    }
       
    ++$more_lines if (@GB > $linenum);    
    
    print "</TABLE>\n";
    
    if ($more_lines){
       print $query->submit(-name=>'Next 10',
                            -value=>'Next 10');
    }
    if ($start_line >= 10){
       print $query->submit(-name=>'Back 10',
                            -value=>'Back 10');
    }
}    

# ****************************************************
# GET_DOC
# stuffs doc into $TOP and $BOTTOM, in the middle goes
# the guestbook
# ****************************************************
sub get_doc {
	open (DOC, "$path/Using/contact/contact.template");
	$state = 'TOP';
	while (<DOC>){
		if (/INSERT GUESTBOOK/){
			$state = 'BOTTOM';
			next;
		}
		s/%self_url%/$self_url/;
		$$state .= $_;
	}
	close DOC;	
}


# **************************************************************
# ck822 -- check whether address is valid rfc 822 address
# tchrist@perl.com
#
# pattern developed in program by jfriedl; 
# see "Mastering Regular Expressions" from ORA for details

# this will error on something like "ftp.perl.com." because
# even though dns wants it, rfc822 hates it.  shucks.
# **************************************************************
sub fail_ck822 { 


   local $hispass = shift;
   local $_;

   #$is_a_valid_rfc_822_addr = '';

   unless ($is_a_valid_rfc_822_addr){  #only read it in once
      while (<main::DATA>) {
         chomp;
         $is_a_valid_rfc_822_addr .= $_;
       } 
   }

   if ($hispass !~ /^${is_a_valid_rfc_822_addr}$/o){
      return 1;
   }
   
      
   #print "$address: $hispass is good\n" if $DEBUG;
   return 0;
}


__END__
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\
xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"
]|\\[^\x80-\xff])*")(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[
^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;
:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))
*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\
n\015()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\04
0)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\(
(?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\
\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*|(?:[^(\040)<>@,;:".\\\[\]\000-\0
37\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xf
f\n\015"]|\\[^\x80-\xff])*")(?:[^()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\03
7]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff])*\))*\)|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")*<(?:[\04
0\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]
|\\[^\x80-\xff])*\))*\))*(?:@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x
80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
)|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\
\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff
])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-
\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\01
5()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*,(?
:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\0
15()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^
\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xf
f])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\x
ff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:
[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\00
0-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x8
0-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*)*:(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*)
?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000
-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")(?:(?:[\040\t]
|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[
^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\
\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:
[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*@
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff
]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\]))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x8
0-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*>)(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*