#!/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
$inputfile = "/local/www/faculty/lincoln/firstlines.html";
$outputdir = "/local/www/faculty/lincoln/titles";
$method    = $ENV{'REQUEST_METHOD'};
   
if ($method eq "GET") {
   &display_form;
   }
   elsif ($method eq "POST") {
      &parse_form_data(*input);
      &check_user_input;
      &process_data;
      }
      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 <<END_OF_FORM
<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>
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>

<form method="post" action="latin-motet.cgi">
Search the Index to First Lines by RISM number (e.g. 1502/01):
<input type="text" name="rism" size="7" maxlength="7">  
<p>
<input type="submit" value="Start Searching">
<input type="reset" value="Clear Form">

<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>
END_OF_FORM
}


#----------------------------------------------------------------------#
# 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:  process_data
# purpose:  returns data requested by the user who fills out the form
#----------------------------------------------------------------------#
sub process_data
{
open(TITLES, $inputfile);
&print_header("Search Results");
print "<body bgcolor=\"#FFFFFF\">";
print "<center><h1>Search Results for RISM $input{rism}<\/h1><\/center>";
while (<TITLES>) {
    
   if (/\($input{rism}\)$/) {
      print;
      }
   }
print "<\/body><\/html>";
}


#----------------------------------------------------------------------#
# 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);
}
