#!/usr/bin/perl

# Name:   latin-motet.cgi
# Author: John F. Hagan
# Date:   01/99 
#
# Purpose: to take Harry Lincoln's TITLES SCRIPT file and separate each	
#          record into its respective RISM.  Lines are italicized properly 
#          first.
#
# Notes:    Subroutine to parse form data taken from
#           "CGI Programming on the World Wide Web,
#           Shishir Gundavaram, O'Reilly & Associates, Inc., 1996
#

#define some variables
$firstlines = "/local/www/faculty/lincoln/firstlines.html";
$sources    = "/local/www/faculty/lincoln/sources.html";
$method    = $ENV{'REQUEST_METHOD'};
   
if ($method eq "GET") {
   &display_form;
}
   elsif ($method eq "POST") {
      &parse_form_data(*input);
      #&check_user_input;
      if ($input{'file'} eq "firstlines") {
         &search_firstlines;
      }
      else {
         &search_sources;
      }
        
   }
      else {
        &return_error (500, "Unsuported Function",
           "The function you have requested is not supported by this script.");
      }
   
#-------------------------- subroutines -------------------------------#

#----------------------------------------------------------------------#
# subroutine name:  check_user_input
# purpose: checks user's input to avoid any funny business 
#----------------------------------------------------------------------#
sub check_user_input
{
unless ($input{rism} =~ /[0-9]{4}\/[0-9]{2}/) {
   &return_error (500, "Improper Format",
           "The data you entered is not in the correct format.");
   }
}


#----------------------------------------------------------------------#
# subroutine name:  display_form
# purpose:  displays form 
#----------------------------------------------------------------------#
sub display_form
{
&print_header("The Latin Motet: Indexes to Printed Collections, 1500-1600");

print <<EndOfFirstPart;
<body bgcolor="#FFFFFF">
<center>
<h1>The Latin Motet: Indexes to Printed Collections, 1500-1600</h1>
<h2>by Harry B. Lincoln</h2>
</center>
With permission of the publisher, The Institute of Mediaeval Music 
(1270 Campman Crescent, Ottowa, Canada, K2C 1P8) Published in 1993.
<p>
In addition to the files at this website the book contains thematic indexes 
(in staff notation) of all voices of the pieces cited, a Thematic Locator 
Index and an Index to Modern Editions.
<p>    
Comments, additions, corrections may be sent to 
<a href="mailto:bg0056\@bingvmb.cc.binghamton.edu">bg0056\@bingvmb.cc.binghamton.edu</a>
<p><hr></p>
<center>
<table border="0" width=80% cellpadding="7" cellspacing="0" bgcolor="#FFFFCC">
   <tr bgcolor="#CCCCFF">
      <td colspan="2">
        Display the entire 
        <a href="firstlines.html"><b>Index to First Lines</b></a><p>
        Display the entire 
        <a href="sources.html"><b>Index to Sources</b></a>
      </td>
   </tr>
   <tr>
      <td colspan="2" align="center">
        <form method="post" action="new-latin-motet.cgi">
        <font size=+1><b>Search</b></font>&nbsp;&nbsp;
        Index to First Lines<input type="radio" name="file" 
        value="firstlines" checked>&nbsp;&nbsp;
        Index to Sources<input type="radio" name="file" value="sources"><p>
      </td>
   </tr>
   <tr align="center">
EndOfFirstPart
          require '/local/www/faculty/lincoln/risms';
          require '/local/www/faculty/lincoln/composers';
print <<EndOfSecondPart;
   </tr>
   <tr>
      <td colspan="2" align="center">        
        by Keyword:<input type="text" name="keyword" size="15">
        <p><hr noshade size="2" width="80%"><p>
        <input type="submit" value="Start Searching">
        <input type="reset" value="Clear Form">
      </td>
   </tr>
</table>
</center>

<p><hr><p><center>Visits to this page since November 23, 1999<p>
<img src="/cgi-bin/Count.cgi?df=lincoln.dat&dd=C"> 
</center>

</form>

</body>
</html>
EndOfSecondPart
}


#----------------------------------------------------------------------#
# subroutine name:  parse_form_data
# purpose:  parses input received from HTML form
#----------------------------------------------------------------------#
sub parse_form_data
{
    local (*input) = @_;

    local ($request_method, $post_info, @key_value_pairs,
           $key_value, $key, $value);

    read (STDIN, $post_info, $ENV{'CONTENT_LENGTH'});
    @key_value_pairs = split (/&/, $post_info);
    foreach $key_value (@key_value_pairs) {
       ($key, $value) = split (/=/, $key_value);
       $value =~ tr/+/ /;
       $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

       if (defined($input{$key})) {
           $input{$key} = join ("\0", $input{$key}, $value);
       }
       else {
          $input{$key} = $value;
       }
    }
}


#----------------------------------------------------------------------#
# subroutine name:  print_header
# purpose:          prints top of html page
#----------------------------------------------------------------------#
sub print_header
{
local ($title) = @_;

print <<HEADER;
Content-type: text/html

<html>
<head><title>$title</title></head>

HEADER
}


#----------------------------------------------------------------------#
# subroutine name:  search_firstlines
# purpose:  search Index to first lines for requested information
#----------------------------------------------------------------------#
sub search_firstlines
{

$rism     = $input{'rism'};
$composer = $input{'composer'};
$keywd    = $input{'keyword'};

$count    = 0;	

#compose search term to display at the top of the search results page
if ($rism) { 
   $searchterm = "<b><font color=\"#990000\">Rism<\/font> = $rism<\/b>"; 
}
if ($composer) { 
   $searchterm = "$searchterm  <b><font color=\"#990000\">Composer<\/font> = 
   $composer<\/b>"; 
}
if ($keywd) { 
   $searchterm = "$searchterm  <b><font color=\"#990000\">Keyword<\/font> = 
   $keywd<\/b>"; 
}

open(FIRSTLINES, $firstlines);
&print_header("Search Results");
print "<body bgcolor=\"#FFFFFF\">";
print "<center><font size=+1>Search Results for $searchterm<\/font><\/center>";
print "<p><hr><p>";

while (<FIRSTLINES>) {

  if ($rism && $composer && $keywd) { #rism,composer,keyword search
     if ( /\($rism\)$/ && /\($composer\)/ && /$keywd/ ) { print; $count++; }
  }
  elsif ($rism && $composer) { #rism,composer search
     if ( /\($rism\)$/ && /\($composer\)/ ) { print; $count++; } 
  }
  elsif ($rism && $keywd) { #rism,keyword search
     if ( /\($rism\)$/ && /$keywd/ ) { print; $count++; }
  }
  elsif ($composer && $keywd) { #composer,keyword search
     if ( /\($composer\)/ && /$keywd/ ) { print; $count++; }
  }
  elsif ($rism) { #rism search
     if (/\($rism\)$/) { print; $count++; }
  }
  elsif ($composer) { #composer search
     if ( /\($composer\)/ ) { print; $count++; }
  }
  elsif ($keywd) { #keyword search
     if ( /$keywd/ ) { print; $count++; }
  }

}

print "<p><hr><p>";
print "Your search yielded <b>$count<\/b> item(s).";
print "<\/body><\/html>";

}


#----------------------------------------------------------------------#
# subroutine name:  search_sources
# purpose:  search Index to sources for requested information
#----------------------------------------------------------------------#
sub search_sources
{

&print_header("Search Unavailable");
print "<body bgcolor=\"#FFFFFF\">";
print "<center><h1>Sorry, This search is not yet available<\/h1><\/center>";

}

#----------------------------------------------------------------------#
# subroutine: return_error                                             #
# purpose:    displays any error message to the user                   #
#----------------------------------------------------------------------#
sub return_error
{
    local ($status, $keyword, $message) = @_;

    print "Content-type: text/html", "\n";
    print "Status: ", $status, " ", $keyword, "\n\n";

    print <<End_of_Error;

<html>
<head><title>CGI Program - Unexpected Error</title></head>
<body bgcolor="#ffffff">
<h1>$keyword</h1>
<hr>$message</hr>
</body>
</html>

End_of_Error

    exit(1);
}
