#!/usr/local/bin/perl

# -----------------------------------------------------------------
# CGIParse -- from cgi-lib, parses the POST and GET arguments
# -----------------------------------------------------------------
sub CGIParse {
    if (@_) {
	local (*in) = @_;
    }

    local ($i, $loc, $key, $val);

    # Read in text
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
	for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
	    $in .= getc;
	}
    } else {
	&CGIError("This program processes POST messages only.");
    }
    @in = split(/&/,$in);

    foreach $i (0 .. $#in) {
	# Convert plus's to spaces
	$in[$i] =~ s/\+/ /g;

	# Convert %XX from hex numbers to alphanumeric
	$in[$i] =~ s/%(..)/pack("c",hex($1))/ge;

	# Split into key and value.
	$loc = index($in[$i],"=");
	$key = substr($in[$i],0,$loc);
	$val = substr($in[$i],$loc+1);
	$in{$key} .= '&' if (defined($in{$key})); # \0 is the separator
	$in{$key} .= $val;

    }

    return 1; # just for fun


}

# -----------------------------------------------------------------
# CGIError -- prints a nicely formated error message
# -----------------------------------------------------------------
sub CGIError {
    local($msg) = @_;

    print STDOUT <<EOM;
<HTML>
<HEAD>
<TITLE>Description File Maintenance Error</TITLE>
</HEAD>
<BODY>
<H1>Description File Error</H1>
An error occured while processing the request:
<PRE>
    <B>$msg</B>
</PRE>
<A HREF="$cgidesc">Return</A> to query form.
</BODY>
</HTML>
EOM
    exit(1);
}







# -----------------------------------------------------------------
# CGIHeader -- Mime content header
# -----------------------------------------------------------------
sub CGIHeader {
    print "HTTP/1.0 200 OK\n";
    print "MIME-Version: 1.0\n";
    print "Content-Type: text/html\n";
    print "Content-Transfer-Encoding: binary\n";
    print "\n";
}


# -----------------------------------------------------------------
# showresults -- display records added to repository file
# -----------------------------------------------------------------
sub REPShow {
    print "<HEAD>\n";
    print "<TITLE> Description File Maintenance </TITLE>\n";
    print "</HEAD>\n";
    print "<BODY>\n";
    print "<P><H1> Descripiton File Maintenance </H1>\n\n";
   
    print "The Desription file has been ";
    print "updated.  It now has the following"; 
    print "information . </P>\n\n"; 
    
    print "<P><STRONG>Description File:</STRONG> $url \n";
    print "<P><STRONG>QueryPages:</STRONG> $qp\n";
    foreach $k (sort keys %in){
	if ($k ne "URL" && $k ne "QPURL" && $in{$k} ne "" && 
	    substr($k,o,4) ne "OPTV")
	{
	    if (substr($k,0,4) eq "OPTF")
	    {
		print "<P><STRONG>$in{$k}</STRONG>: ";
		$val =  $in{"OPTV".substr($k,4,1)};
		print"$val \n";
	    }
	    else
	    {
		print "<P><STRONG>$k</STRONG>: $in{$k}\n";
	    }
	   }
     }
    print "<P><A HREF=\"$cgidesc\">Return</A> to query form.<\P>\n";
    print "</BODY>\n";
}
 
# ----------------------------------------------------------------
# RepProcesses - create a new desc file.
# ----------------------------------------------------------------

sub RepProcess{
    $output ="";
    #check that mandatory fields have been input

    
    if ($in{"URL"} ne "") {$url = $in{"URL"};}
    else {&CGIError("The decription file of the object must be specified.");}
  if (defined $in{"WRITEUP"}) 
  { if($in{"WRITEUP"} ne "") {$w = $in{"WRITEUP"};}
    else
    {&CGIError("The one paragraph writeup of the object must be specified.");}
  }
    if ($in{"Type"} ne ""){$type = $in{"Type"};
			   $output = $output . "<STRONG>Type</STRONG>: ".
			   $type. "\n<P>\n"; }
    else {&CGIError("The Template type of the object must be specified.");}
    if ($in{"Host"} ne ""){$host = $in{"Host"};
			   $output = $output . "<STRONG>Host</STRONG>: ".
			   $host . "\n<P>\n";}
    else {&CGIError("The Host name of the object must be specified.");}
    if ($in{"Port"} ne ""){$port = $in{"Port"};
		           $output = $output . "<STRONG>Port</STRONG>: ".
			    $port . "\n<P>\n";}    
    else {&CGIError("The Port number of the object must be specified.");}
    if ($in{"Maintainer"} ne ""){ $maint = $in{"Maintainer"};
			     $output = $output."<STRONG>Maintainer</STRONG>: ".
			      $maint . "\n<P>\n";}
    else {&CGIError("The email addrs of the Maintainer of the object must be specified.");}
    if ($in{"QPURL"} ne ""){$qp = $in{"QPURL"};}
    else {&CGIError("The URLS of the Query Pages of the object must be specified.");}

 #read the rest of the attributes, whatever they may be
    foreach $k(sort keys %in)
    {
	if ($k ne "URL" && $k ne "QPURL" && $k ne "Type" && $k ne "Host" &&
	    $k ne "Maintainer" && $k ne "Port" && $k ne "WRITEUP" && 
	    substr($k,0,4) ne "OPTV")
	{
	    if ($in{$k} ne "")
	    {
		if (substr($k,0,4) eq "OPTF")
		{
		    $output = $output . "<STRONG>".$in{$k}."</STRONG>: ";
	       
		    $output = $output . $in{"OPTV".substr($k,4,1)}."\n<P>\n";
		}
		else
		{
		    $output = $output."<STRONG>".$k."</STRONG>: ".$in{$k}.
			"\n<P>\n";
		}
            }
        }
    }
 #create new file
    $descfile = "";
     $descfile =   ">/local/httpd/cgi-bin/test/".$url;
     open (DESC, $descfile) ||  &CGIError("error in writing desc file");
     print DESC "<HTML>\n<HEAD>\n<TITLE>\nDescription file for Harvest ",
     $type,"\n</TITLE>\n</HEAD>\n<BODY>\n<P>\nThis is the description",
     " file for the \n<a href=\"",$qp,"\">",$type,"</a>\nwhich has ",
     "the following specifications:\n";
      print DESC "<P>\n<P>\n<P>\n";
    print DESC "<STRONG>Write-Up</STRONG>: ";
    print DESC $w;
 print DESC "\n<P>\n";

      print DESC $output;
    print DESC  "<STRONG>Time-of-Last-Update</STRONG>: ", time, "\n";
      print DESC "<P>\n<P>\n</BODY>\n</HTML>\n";
      close DESC;
      
}




# -----------------------------------------------------------------
# main
# -----------------------------------------------------------------


$cgidesc   = "http://grand.central.org/cgi-bin/test/desc";



&CGIHeader;

&CGIParse;


&RepProcess;

&REPShow;

exit(0);
































































