#! /usr/local/bin/perl 

#############################################################################
#  
#  The LivingPage(TM) software is copyrighted by NPAC and CSNet.   
#  
#  Name: URL Item Object  
#  
#  File: addURL.pl
#
#  Author: Paul Coddington
#
#  Version: 0.2  
#
#  Date: January 17, 1996
#
#  Input: CGI input ('QUERY_STRING') 
#          QUERY_STRING: $filename      (the file to be updated)
#                        $listname      (the list to be updated)
#                        $url           (the URL to be added)
#                        $title         (the title of the document)
#                        $description   (a description of the document)
#                        $name          (name of the submitter)
#                        $email         (email of the submitter)
#                        $institution   (institution of the submitter)
#                        @lpvar         (for TEMPLATE option) 
#
#  Output: Add an HTML entry to list $listname in document $filename.
#  The default is to add a hyperlink to a document (specified by a
#  URL and title) annotated by some description of the document, and 
#  an HTML comment specifying the name of the person submitting the
#  entry along with the date.
#
#  The listname, the format of the list, and where the new entry should be
#  positioned in the list, are all described by the LIVINGPAGE tag, which
#  indicates which part of the document is writable. 
#
#  It is also possible using the TEMPLATE option to add an arbitrary
#  format entry, in which case the variables in the array @lpvar
#  could be anything. 
#
#  For more information, see http://www.infomall.org/CSNet/livingpage/
#
#  TO BE ADDED:
#      File locking
#      URL checking
#      Template
#      Security (do we need it to sends a magic cookie or something
#                so people can't mock up the http request?)
#
#############################################################################


#####################################
#  
# MAIN FUNCTION
#  
#####################################


%in = ();
&ParseArg(*in);		# Parse arguments passed by http server

# DEBUG
# &PrintHeader;
# print STDOUT "DEBUG ON \n";

&EditPage;            # Do the edit
&Confirm;             # Confirm that the edit was made


#############################################################################
#  
#   SUBROUTINES
#
#############################################################################


#####################################
# Edit the Page
#####################################
sub EditPage {          
   
  $date = `date`;
  chop($date);

  # Sort out the variables passed from the form 
  $lpfile = $in{'filename'};
  $listname = $in{'listname'};
  $url = $in{'url'};
  $title = $in{'title'};
  $description = $in{'description'};
  $name = $in{'name'};
  $email = $in{'email'};

# DEBUG
# print STDOUT "<BR> lpfile = $lpfile \n";
# print STDOUT "<BR> listname = $listname \n";
# print STDOUT "<BR> url = $url \n";
# print STDOUT "<BR> title = $title \n";
# print STDOUT "<BR> description = $description \n";
# print STDOUT "<BR> name = $name \n";
# print STDOUT "<BR> email = $email \n";
  
  # Check that the filename is correct 
  # (and we have permission to open it?)
  if (!open(LIVINGPAGE, $lpfile) ) {
	&PrintHeader;
 	print "cannot open $lpfile";
 	return 0;
  }
  close(LIVINGPAGE);

#
# Do an "in place" edit on the LivingPage, i.e. copy $lpfile
# to $lpfile~ and create a new $lpfile with the addition appended
#
  $^I = "~"; 
  @ARGV = ($lpfile);
  $living = 0;
  $continue = 0;
  $found = 0;
  $para = 0;

# DEBUG
# print STDOUT "<BR> Opening $lpfile \n";

  while (<>) {

# DEBUG
# print STDOUT "Next: $_";

    if (/<LIVINGPAGE/i) {   # Find the <LIVINGPAGE> tag (ignore case)

# DEBUG
# print STDOUT "<BR> Found the LIVINGPAGE tag \n";

      if (/>/) {           # Found the end of the <LIVINGPAGE> tag 
        &ParseTag;           # Get information from the tag parameters
        if ("\U$thislistname" eq "\U$listname") {  # Check it's the right list
          $living = 1;
          $found = 1;

# DEBUG
# print STDOUT "<BR> Found the right list = $listname \n";

        }
        else {
          $living = 0;

# DEBUG
# print STDOUT "<BR> Not the right list = $listname \n";

        }
      }
      else {
        $continue = 1;
        $tag = $_;  # Store this line 
      }
      print;
      next;
    }
    if ($continue) {   # Read another line to get all the LIVINGPAGE tag info
      $tag .= $_;  # Append the new line 
      if (/>/) {   # Found the end of the <LIVINGPAGE> tag 
        $_ = $tag;  
        &ParseTag;           # Get information from the tag parameters
        $continue = 0;
        $living = 1;
      }
      print;
      next;
    }    
    if ($living) {  # This is the list we want to update
       if ( ((/<UL>/i) || (/<OL>/i) || (/<DL>/i)) && ($position eq "TOP")) {  
          # Add the new site
          print;
          &AddSite;           
          $living = 0;
          next;
       }
       if ( ((/<\/UL>/i) || (/<\/OL>/i) || (/<\/DL>/i)) && ($position eq "BOTTOM")) {  
          # Add the new site
          &AddSite;           
          $living = 0;
          print;
          next;
       }
       if (/<\/LIVINGPAGE>/i) {  # No list yet, so need to start one
          if ($list eq "UL") { 
            print "<UL>\n";
            &AddSite;           
            print "</UL>\n";
          } 
          if ($list eq "OL") { 
            print "<OL>\n";
            &AddSite;           
            print "</OL>\n";
            print;
          } 
          if ($list eq "DL") { 
            print "<DL>\n";
            &AddSite;           
            print "</DL>\n";
          } 
          if ($list eq "IMG") { 
            &AddSite;           
          } 
          if ($list eq "TEMPLATE") { 
            &AddSite;           
          } 
          print;
          $living = 0;
          next;
       }
       if (/<P>/i) {  # Put paragraph markers between the list elements
         $para = 1;
         print;
       }
       # else 
       print;
    }
    else {  # Just regurgitate the line
         print;
    }
  }
}


#########################################
# Display confirmation of the addition
#########################################
sub Confirm {

  &PrintHeader;

  if (!$found) {
    $error = "Couldn't find list $listname\n";
  }
  if ($error) {
     &PrintHeader;
     print "<BR> ERROR: $error\n";
     return 1;
  }
  else {
  print "<HTML>\n";
  print "<TITLE> LivingPage Update</TITLE>\n";
  print "<H2> LivingPage Update</H2>\n";
  print "<HR>\n";
  print "Your update to the <B>$listname</B> section of \n";
  print "the LivingPage at <B>$lpfile</B> is: \n"; 
  print "<UL>";
  print "<LI>\n";
  print "<A HREF=\"$url\">$title</A>\n";
  print "$description \n";
  print "</UL>\n";
  print "<P>";
  print "Added by $name ($email) on $date \n";
  print "<P><HR><P>";
  print "Return to the LivingPage \n";
  print "and <B>Reload</B> to see your new entry.\n";
  print "</HTML>";
  }
  return 0;
}



#########################################
# Parse the LIVINGPAGE tag information 
#########################################
sub ParseTag {    
     
  if (/NAME=/i) {   # Find the list NAME (ignore case)
    &WordAfter("NAME=");
    $thislistname = $nextword;

# DEBUG
# print STDOUT "<BR> ParseTag: listname = $thislistname \n";

  }
     
  if (/LIST=/i) {   # Find the LIST type (ignore case)

    # Find the list type
    &WordAfter("LIST=");
    $list = $nextword;

# DEBUG
# print STDOUT "<BR> ParseTag: list = $list\n";

    if ($list eq "IMG") {     # Use image for bullet  
      if (/SRC=/i) {   # Find the SRC tag (ignore case)
        &WordAfter("SRC=");
        $imgfile = $nextword;
      }
      else {
        $error = "SRC file not specified for IMG tag.";
      }
      if (-e $imgfile) {   # Find the image file
        $src = 0;
      }
      else {
        $src = 1;
        $error = "Cannot find SRC file $imgfile for IMG tag.";
      }
    }
    if ($list eq "TEMPLATE") {   
      if (/SRC=/i) {   # Find the SRC tag (ignore case)
        &WordAfter("SRC=");
        $template = $nextword;
      }
      else {
        $error = "SRC file not specified for TEMPLATE tag.";
      }
      if (-e $template) {   # Find the template file
        $src = 0;
      }
      else {
        $src = 1;
        $error = "Cannot find SRC file $template for TEMPLATE tag.";
      }
    }
  }
  else {
    $error = "LIST type not specified.";
  }
     
  if (/POSITION=/i) {   # Find the POSITION (ignore case)
    &WordAfter("POSITION=");
    $position = $nextword;

# DEBUG
# print STDOUT "<BR> ParseTag: position = $position\n";

  }
  else {
    # Put it at the end
    $position = "BOTTOM";
  }

}


#########################################
# Find the word after the given expression
#########################################
sub WordAfter {
  $prevstring = $_[0];
  # Find everything after $prevstring (ignore case)
  ($junk,$wordstring) = split(/$prevstring/i);  

  if ($wordstring =~ /^"/) {  # The first non-whitespace character is a quote

    # Grab what's inside the quotes
    # Remove the first quotation mark
    $wordstring =~ s/"//;   

    # and then split out everything before the next quotation mark
    ($word,$junk) = split(/"/, $wordstring);  
  }
  else { 

    # Grab the next word
    ($word,$junk) = split(/\s+/,$wordstring);  # Split out the first word
    $word =~ s/"//g;                           # Remove any unwanted quotes
  }

  if ($prevstring ne "NAME=") { 
    $word = "\U$word";           # Convert to upper case
  }

  $word =~ s/>//;
  $nextword = $word;

}    


#########################################
# Add the information for the new site
#########################################
sub AddSite {    

# DEBUG
# print STDOUT "<BR> AddSite: list = $list\n";


   if ( ($list eq "UL") || ($list eq "OL") ) {
     print "\n";
     print "<!-- Added by $name ($email) on $date -->\n";
     if ($para) {
       print "<P>\n";
     }
     print "<LI>\n";
     print "<A HREF=\"$url\">$title</A> \n";
     print "$description \n";
   }
   if ($list eq "DL") {
     print "\n";
     print "<!-- Added by $name ($email) on $date -->\n";
     if ($para) {
       print "<P>\n";
     }
     print "<DT>\n";
     print "<A HREF=\"$url\">$title</A> \n";
     print "<DD>\n";
     print "$description \n";
   }
}


#########################################
# Add the information using a TEMPLATE 
#########################################
# sub UseTemplate {    
# }


### DEBUG

sub Debug {
    local($debug_string) = @_;
    print "Content-type\: text/html\n\n";
    print "$debug_string \n";
}



##########################################################################
# Standard CGI interface stuff
#########################################


sub PrintHeader {                      # Print out the Header for HTML
  print "Content-type: text/html\n\n";
  print "\n";
}


sub ParseArg {                        # reads the passed arguments
    local ($i, $loc, $key, $val);
    local (*in) = @_;

    if ($ENV{'REQUEST_METHOD'} eq "GET") {                      # Read in text
       $in = $ENV{'QUERY_STRING'};
    } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
      for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
        $in .=getc;
      }
    }

    @in = split(/&/,$in);

    foreach $i (0 .. $#in) {
      $in[$i] =~ s/\+/ /g;                          # Convert plus's to spaces
      $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
                                # Convert %XX from hex numbers to alphanumeric
      $loc = index($in[$i], "=");                  # Split onto key and value.
      $key = substr($in[$i],0,$loc);
      $val = substr($in[$i],$loc+1);
      $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
      $in{$key} .= $val;
   }
}
1;


