#!/usr/bin/perl

# CEP - CGI Encyclopedia in Perl 
#
#  Version 0.4 12/1/97
#
# Okay, what a grandiose name!  This CGI Perl module is designed to
# support listings of definitions and cross-references for topical
# information, and also to automatically generate various kinds of
# HTML listings from that information.  
#
# The CEP should have its down directory in which to run, and it
# will always chdir to that directory on startup.  All data files,
# templates, schema files, supporting Perl modules, and 
# everything all live there.  
#
# This Perl CGI program uses the CGI.pm module by Lincoln Stein.
# 
# As this is a CGI module, it is build to accept various CGI field
# arguments.  Some of these will come from the schema file, but
# the constant ones are listed here.  Notice that they all start
# with _ to distinguish them from actual data fields.  Note that
# every schema must have a primary key (this is sorta like a
# 1-table relational model), and that is simply the first field
# listed in the schema.  Typically, that field will be "name".
# Note that all data field names should be lower-case.
#
#	_add		If present, then this is CGI request
#			is part of an update transaction of 
#			some sort.  A form with database
#			values will be returned.  If pattern 
#			match or a primary key value is given
#			then the form will be populated with
#			that item if it exists.  See also
#			_store, below.  Note that _add, if
#			present, overrides other instructions.
#
#	_alpha		value is a case-insensitive string,
#			each of them a first letter or other
#			char for primary keys.  So, if you want
#			all the definitions that begin with 'd'
#			or 'e' you would send ?_alpha=de
#
#	_diagnose	perform a consistency diagnostic check
#			of the database, checking internal
#			cross-reference and external links.  This
#			can be very time-consuming.
#			[NYI - this will have to be a separate
#			 program, I think, otherwise it will
#			 bloat this one too much.]
#
#	_format		value is an output report format, one
#			of 'index', 'short', or 'full'.  Only
#			first letter is used, case-insensitive.
#			The default is 'full'.
#
#	_get		value is a file name to retrieve, no
#			directory prefix accepted.  Depending
#			on the file extension, the file may
#			be a template (.phtml), straight text,
#			straight html, or image.
#
#	_key		exact value of a primary key, only
#			case-insensitive, output delivered as
#			specified by _format or _add.
#
#	_search		pattern match in data, value is a 
#			regular expression to use for matching.
#			Results returned according to _format
#			or _add if present.
#
#	_searchfield	If set, then apply pattern matching to
#			primary key only, by default matching 
#			is done against all non-empty visible
#			fields (s,S,t,T,u,U,r,R)
#
#	_store		if present along with _add, and all
#			non-optional schema fields are received
#			non-empty, then actually re-write the
#			data files (backing up previous using
#			simple numbering scheme?)
#
#	_total		similar to _alpha, only sends ALL
#			the data in the specified format.
#
#	_usersearch	include a user search form in the
#			heading, for searching the data.
#			Default value is 0 (false).
#
#	_usertab	include a quick-reference set of 
#			alphabetic tabs in the heading, for
#			browsing the data.
#			Default value is 1 (true).
#
#	_userlink	include links section template,
#			default on in basic_mode 0, off
#			otherwise.
#
#
# Note that the design of this module limits it: only one
# CEP database may live in a directory.
#
# The most important file for a CEP database is the schema
# file.  This file consists of lines, each defining a field
# in the CEP database (note that the database may or may
# not be stored in a single file, I haven't decided yet.)
# Each line consists of three strings separated by colons:
#
#		- field CGI form name (identifier)
#		- field user pretty-print name (string)
#		- field type, one of the following:
#			s - short string (default)
#			S - short string optional
#			p - primary key URL (special)
#			e - enumerated short text
#			E - enumerated short text optional?
#			r - cross-ref primary key name(s)
#			R - cross-ref primary key name(s) optional
#			t - multi-line string 
#			T - multi-line string optional
#			u - a link URL string, name=href
#			U - a link URL string optional, name=href
#			i - an image URL string  [NYI]
#			I - an image URL optional [NYI]
#
# When CEP starts up, it reads the schema into a pair of
# hash tables: %fieldNames and and %fieldTypes.  The keys
# of either of these hashes can be used to grab stuff out
# of the query on updates, or out of restored objects on
# loading from a file.
#
# Note the format for the u and U types, if an
# equals sign appears in the string, then the LHS is
# a human-readable name for the link, and the RHS is
# the link URL.
#
# For data storage, we use the CGI::save and CGI::new
# methods, just like my guestbook and other CGI scripts
# do.  (This method is not especially fast, though, so
# I may need to change it later.)
#
#  
# 

# Constants - set these as necessary
$CEP_HOME = $ENV{'HOME'} . '/cgi-bin/cep/';
$CEP_SCHEMA = 'schema.txt';
$CEP_FILE_PREFIX = 'cep-';
$CEP_FILE_SUFFIX = '.dat';
$CEP_FILE_NEW_SUFFIX = '.new';
$CEP_FILE_BAK_SUFFIX = '.bak';

$CEP_ADD    = '_add';
$CEP_ALPHA  = '_alpha';
$CEP_FORMAT = '_format';
$CEP_GET    = '_get';
$CEP_KEY    = '_key';
$CEP_SEARCH = '_search';
$CEP_SEARCHFIELD= '_searchfield';
$CEP_STORE  = '_store';
$CEP_TOTAL  = '_total';
$CEP_USERSEARCH = '_usersearch';
$CEP_USERTAB= '_usertab';
$CEP_USERLINK   = '_userlink';

$CEP_FULL_SET= 'abcdefghijklmnopqrstuvwxyz!';

sub geturl {
    my $q = shift;
    my $ret = $q->script_name();
    # if you need to fix idiocy from server, substitute here!
    # $ret =~ s/www[.]erols/cgibin.erols/;
    return $ret;
}

#################################################################
# templates - these are the HTML+Perl fragments that are used
# 		to build the output HTML pages.   Note that
#		a lot of domain-specific stuff is bound up in
#		these template files (e.g. URLs, titles, 
#		format, colors, names, links) and therefore
#		these files will have different contents for
#		every use of the cep.pl program.  Try to
#		restrict domain-specific stuff to these
#		files and to the schema, keep it out of this
#		perl source code!
%templates = (
	      'header', 'fixed_top.phtml',
	      'index', 'search_index.phtml',
	      'links', 'links.phtml',
	      'notfound', 'notfound.phtml',
	      'footer', 'fixed_bottom.phtml',
	      'addstart', 'add_start.phtml',
	     );

# Operational parameters - set as necessary, can be empty
$CEP_BASE_IMG_URL = 'http://www.erols.com/ziring/';

# globals used throughout the program
$headerSentYet = 0;

# libraries we use
use CGI;

# fundamental subroutines used everywhere
sub ensureHTMLHeader {
    if (!($headerSentYet)) { print $query->header(-type => 'text/html'); }
    $headerSentYet = 1;
}    

sub punt {
    my @args = @_;
    my $lin;

    ensureHTMLHeader();

    print $query->start_html(-title => 'CEP Error');
    print "<p>\n";
    for $lin (@args) {
	print $lin,"<br>\n";
    }
    print "<p>In phase ",$phase,".\n";
    print $query->end_html();
    exit 0;
}

# urlenc - URL-encode a string, return it
#
sub urlenc {
    my($toencode) = @_;
    $toencode=~s/([^a-zA-Z0-9 _\-.])/uc sprintf("%%%02x",ord($1))/eg;
    $toencode =~ tr/ /+/;
    return $toencode;
}



# print_template -
# given a file, read it through, substituting for
# embedded Perl constructs.  The constructs we
# support are:
#
#		%%expr%%          eval expr, substitute
#				  result as a string,
#				  but if expr is just a
#				  identifier, then treat
#				  it as a parameter of
#				  the supplied CGI::
#				  object.
#
# Expressions can set the dynamically scoped scalar
# $enable to 0 to disable output temporarily, and
# can set it to 1 to re-enable output.  This only
# lasts for the current template.
#
# return 1 on success or 0 on error or missing file.
#
sub print_template {
    my ($fname, $q) = @_;
    my $ret;
    my $fline;
    my $exm;
    my $substval;
    local $enable;

    $ret = 0;
    $enable = 1;
    if (open(TFILE, $fname)) {
	while(<TFILE>) {
	    $fline = $_;
	    while ($fline =~ m/%%(([^%]|%[^%])+)%%/) {
		$exm = $1;
		if ($exm =~ m/^\w+$/i) {
		    $substval = $q->param(lc($exm));
		}
		else {
		    $substval = eval($exm);
		    print "<!-- template eval error of '$exm': ",$@," -->\n" if (!(defined($substval)));
		}
		$fline =~ s/%%([^%]|(%[^%]))+%%/$substval/e;
	    }
	    print $fline if $enable;
	}
	$ret = 1;
	close TFILE;
    }
    return $ret;
}


#################################################################
# handle_get - retrieve a raw file and send it
#
#  This routine handles a request to grab a file (not a path).
# 

%mimetypes = ('gif', "image/gif",
	      'jpg', "image/jpeg", 'jpeg', "image/jpeg", 'jfif', "image/jpeg",
	      'txt', "text/plain", 'text', "text/plain",
	      'pl', "text/plain", 'cgi', "text/plain",
	      'phtml', "TEXT/HTML", 'htm', "text/html",
	      'html', "text/html", '\w*', "application/unknown"
	      );

sub handle_get {
    my $fname = shift;
    my $q = shift;
    my $ftype = 'text/plain';
    my $ext = '';
    my $pat;
    
    $fname =~ s,^.*/,,;
    EXTS: foreach $ext (keys %mimetypes) {
	$pat = '[.]' . $ext . '$';
	if ($fname =~ m/$pat/) {
	    $ftype = $mimetypes{$ext};
	    last EXTS;
	}
    }
    
    if ($fname ne '') {
	if (open(GETFILE, $fname)) {
	    print $query->header(-type => lc($ftype));
	    if ($ftype eq "TEXT/HTML") {
		close GETFILE;
		print_template($fname,$q);
	    }
	    else {
		my ($temp,$ino,$mode,$nlink,$uid,$gid,$rdev,$size) = stat($fname);
		read(GETFILE, $temp, $size);
		print $temp;
	    }
	    close GETFILE;
	}
	else {
	    punt("Could not open requested file:",$fname);
	}
    }
    else {
	punt("Bad file name in parameter:",$fname);
    }

    return 0;
}

#################################################################
# Phase 0 - start-up stuff that is always the same
#
$phase = 0;
$query = new CGI;
chdir($CEP_HOME);  # or punt("CEP directory seems to be missing:",$CEP_HOME);


#################################################################
# Phase 1 - read the schema
# We fail with a dire error message if we can't get our schema.
#
$phase = 1;
open(SCHEMA, $CEP_SCHEMA) or punt("Can't open schema file!");
  
$fieldCount = 0;
@fieldKeys = ();
%fieldNames = ();
%fieldTypes = ();
%fieldExtra = ();

$fieldNamePrimary = '';

while (<SCHEMA>) {
    chomp;
    my @ff = split(/:/);
    if ($#ff >= 2) {
	if ($fieldNamePrimary eq '') {
	    $fieldNamePrimary = $ff[0];
	}
	$fieldKeys[$fieldCount] = $ff[0];
	$fieldNames{$ff[0]} = $ff[1];
	$fieldTypes{$ff[0]} = $ff[2];
	$fieldExtra{$ff[0]} = $ff[3];
	$fieldCount += 1;
    }
}

punt("Bad schema") if ($fieldCount == 0);

#################################################################
# Phase 2 - determine base operational mode for this request...
#
# basic modes - 0=default, 1=alpha or total dump, 2=search dump, 
#		3=update form dump, 4=update confirmation dump,
#		5=literal get
#
$phase = 2;
$basic_mode = 0;

if (defined($query->param($CEP_ADD))) {
    $basic_mode = 3;

    if ($query->param($CEP_STORE)) {
	$basic_mode = 4;
    }
}
elsif ($query->param($CEP_GET)) {
	$basic_mode = 5;
	handle_get($query->param($CEP_GET),$query);
	exit 0;
}
else {
    if (($query->param($CEP_ALPHA)) || ($query->param($CEP_TOTAL))) {
	$basic_mode = 1;
    }
    if (($query->param($CEP_KEY)) || ($query->param($CEP_SEARCH))) {
	$basic_mode = 2;
    }
}


# set default query parameters in some cases
if (!defined($query->param($CEP_USERTAB))) {
    $query->param($CEP_USERTAB, 1);
}
if (!defined($query->param($CEP_USERSEARCH))) {
    $query->param($CEP_USERSEARCH, 0);
}
if (!defined($query->param($CEP_FORMAT))) {
    $query->param($CEP_FORMAT, 'full');
}
if ($basic_mode == 0) {
    $query->param($CEP_USERSEARCH, 1);
    $query->param($CEP_USERLINK, 1);
}



################################################################
# Okay, now we know what we're doing and we know our database 
# setup.  Steps below are interleaved for maximum performance:
#
#        phase 3 - output fixed top section of page
#	 phase 4 - output index section of page, as
#		   needed per basic mode and other params.
#	 phase 5 - Retrieve data and do appropriate thing
#		   with it - three possibilities:
#			5a - output search results data using
#			     _search, _key, _alpha, formatted
#		   or   5b - output add form, get data
#			     using _key
#		   or   5c - perform database update and confirm
#	 phase 6 - output links section of page, if needed
#	 phase 7 - output fixed bottom section of page
#


#################################################################
# Phase 3 - output fixed top section of page as a template
#
#
$phase = 3;

ensureHTMLHeader();
if (print_template($templates{'header'}, $query) == 0) {
    punt("Could not begin to build page");
}


#################################################################
# Phase 4 - output index area at top of page
#
#	Normally, I expect the index area to have several
#  things in it:
#			- an explanation
#			- links for letters of the alphabet
#			  that employ the _alpha parameter.
#			- a link for a full dump of the data
#			  employing the _total parameter.
#			- a search form with text field and
#			  submit button, employing the 
#			  _search parameter.
#
#	Of course, none of this need be present in the 'index'
# 
#
$phase = 4;
if ($basic_mode == 0 || $basic_mode == 1 || $basic_mode == 2) {
    if (print_template($templates{'index'}, $query) == 0) {
	punt("Could not build body of page");
    }
}




#################################################################
# Phase 5 - grab database records as needed
#
#	This is the search phase.  This is a little tricky,
#   because we want to store the data reasonably efficiently,
#   and yet we don't want this code to get too bloated.
#   
#	The routine retreive_next_record simply returns 1 item
#   at a time according to the search criteria given in its 
#   three args.  Check it out further below.
#   The routine print_record formats a record according to
#   the format given as its first arg.  It also accepts a
#   count so that it can put in an entry number or do 
#   special stuff on the first record.  
#

$cnt = 0;
$fmt = lc(substr($query->param($CEP_FORMAT),0,1));

if ($basic_mode == 1) {
    $rset = $query->param($CEP_ALPHA);
    if ($query->param($CEP_TOTAL)) { $rset = $CEP_FULL_SET; }
    print "<dl>\n";
    while ($qret = retrieve_next_record($rset,'','')) {
	print_record($fmt, $qret, $cnt);
	$cnt += 1;
    }
    if ($cnt == 0) { print_template($templates{'notfound'},$query); }
    else {
	print "<p> </p>\n";
	print "<dt>",$cnt," ",(($cnt > 1)?("entries"):("entry"))," retrieved.";
	print "</dt>\n";
    }
    print "</dl>\n";
}
elsif ($basic_mode == 2) {
    $rset = $CEP_FULL_SET; 
    $kpat = $query->param($CEP_KEY);
    if (!defined($kpat) || ($kpat eq '')) {
	$kpat = '';
	$spat = $query->param($CEP_SEARCH);
    }
    else { $spat = ''; }
print "\n<!-- kpat=",$kpat," and spat=",$spat," -->\n";
    print "<dl>\n";
    while ($qret = retrieve_next_record($rset, $kpat, $spat)) {
	print_record($fmt, $qret, $cnt);
	$cnt += 1;
    }
    if ($cnt == 0) { print_template($templates{'notfound'},$query); }
    print "</dl>\n";
}
elsif ($basic_mode == 3) {
    my $addme = $query->param($CEP_ADD);
    if ($addme eq ' ') {
	print_template($templates{'addstart'},$query);
    }
    else {
	my $add1 = ($addme =~ m/^([a-z])/i)?($1):('!');
	my $qret = retrieve_next_record($add1,$addme,'');
	if (!($qret)) { 
	    $qret = new CGI;
	    $qret->param($fieldNamePrimary, $query->param($CEP_ADD));
	}
	# print_add_form uses the schema heavily
	print_add_form($qret);
    }
}
elsif ($basic_mode == 4) {
    # first check that all non-optional fields are non-empty,
    # lower-case field type means mandatory!
    my $ok = 1;
    my $offender;
    KEYS: foreach $fn (@fieldKeys) {
	if ($fieldTypes{$fn} eq lc($fieldTypes{$fn})) {
	    if (!($query->param($fn))) {
		$ok = 0;
		$offender = $fn;
		last KEYS;
	    }
	}
    }
    if ($ok) {
	my $add1 = lc(substr($query->param($fieldNamePrimary),0,1));
	$add1 = '!' if (!($add1 =~ m/^[a-z]/));
	my $errmsg = update_record($add1, $query);
	if (!($errmsg)) {
	    print "The following record added to the dictionary under ",uc($add1),":\n";
	    print "<dl>\n";
	    print_record('full',$query,-1);
	    print "</dl>\n";
	    
	    print "<p><center>\n";
	    print '<a href="',geturl($query),'?',$CEP_ADD,'=+','"><b>';
	    print '** Click Here to Add Another **';
	    print "</b></a>\n";
	    print "</center>\n";
	}
	else {
	    print "<p>\n";
	    print "Could not add record to the dictionary: ",$errmsg;
	    print "<p>\n";
	}
    }
    else {
	print "<p>\n";
	print "<b>Error: required field missing, database not changed.</b>\n";
	print "<p>\n";
	print "Sorry, mandatory field '",$fieldNames{$offender},"' ($offender) is empty.";
	print "<p>\n";
	print "Please hit the BACK button on your browser and fix it!";
	print "<p>\n";
    }
}
    

#################################################################
# Phase 6 - output fixed links section of page as a template
#
#
$phase = 6;

if ($query->param($CEP_USERLINK)) {
    if (print_template($templates{'links'}, $query) == 0) {
	print "\n","<hr><p>Could not output link section, phase $phase. Sorry";
    }
}



#################################################################
# Phase 7 - output fixed bottom section of page as a template
#
#
$phase = 7;

if (print_template($templates{'footer'}, $query) == 0) {
    print "\n","<hr><p>Could not output regular page footer, phase $phase. Sorry";
    print "\n","</body>\n</html>\n";
}




#################################################################
# all done, bye

exit 0;  


##################################################################
#
# Database and form subroutines

sub print_add_form {
    my $q = shift;
    my $fkey;
    my $fnam;
    my $ftyp;
    
    # print "<!-- add/edit form made from schema -->";
    # print "<!-- query object at this point is:\n";
    # print $q->dump();
    # print "\n-->\n";
    print "<p>\n";
    print "Edit the entry below, then click on SUBMIT.<br>\n";
    print "Note that fields marked '(req.)' must be filled in.";
    print "<p>\n";
    print '<form name="addform" method=POST action="';
    # print $q->start_form(-name => 'addform'),"\n";
    $sn = $q->script_name;
    $sn =~ s/[?].+$//;
    print $sn;
    print '">';
    print "\n";
    print "<table border=0 cellpadding=2 cellspacing=1>\n";

    foreach $fkey (@fieldKeys) {
	$fnam = $fieldNames{$fkey};
	$ftyp = $fieldTypes{$fkey};
	print "<tr><td align=right valign=top>";
	print "<i>",$fnam,":</i></td><td>\n";

      SWITCH: 
	{
	    if (lc($ftyp) eq 's') {
		if ($fkey eq 'date') {
		    my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time );
		    $year = $year - 100 if $year > 99;
		    $q->param($fkey, sprintf("Last updated %d/%d/%02d",$mon + 1,$mday,$year));
		}
		print $q->textfield(-name => $fkey, -size => 50);
		print "<small>&nbsp;(opt.)</small><br>\n" if ($ftyp eq 'S');
		print "<small>&nbsp;(req.)</small><br>\n" if ($ftyp eq 's');
		last SWITCH;
	    }
	    
	    if (lc($ftyp) eq 'p') {
		print $q->textfield(-name => $fkey, -size => 45);
		print "<small>&nbsp;(URL, opt.)</small><br>\n" if ($ftyp eq 'P');
		print "<small>&nbsp;(URL, req.)</small><br>\n" if ($ftyp eq 'p');
		last SWITCH;
	    }

	    if (lc($ftyp) eq 'e') {
		my @labels = split(/, */,$fieldExtra{$fkey});
		if ($#labels > 0) {
		    print $q->popup_menu(-name => $fkey,
					 '-values' => \@labels,
					 -default => $labels[0]);
		}
	    }

	    if (lc($ftyp) eq 'r') {
		print $q->textfield(-name => $fkey, -size => 45);
		print "<small>&nbsp;(names, req.)</small><br>\n" if ($ftyp eq 'r');
		print "<small>&nbsp;(names, opt.)</small><br>\n" if ($ftyp eq 'R');
		last SWITCH;
	    }

	    if (lc($ftyp) eq 't') {
		print $q->textarea(-name => $fkey, -rows => 7, -columns => 46);
		print "<br><small>&nbsp;(req.)</small><br>\n" if ($ftyp eq 't');
		print "<br><small>&nbsp;(opt.)</small><br>\n" if ($ftyp eq 'T');
	    }

	    if (lc($ftyp) eq 'u') {
		print $q->textfield(-name => $fkey, -size => 45);
		print "<small>&nbsp;(URL, req.)</small><br>\n" if ($ftyp eq 'u');
		print "<small>&nbsp;(URL, opt.)</small><br>\n" if ($ftyp eq 'U');
		last SWITCH;
	    }

	    if (lc($ftyp) eq 'i') {
		print $q->textfield(-name => $fkey, -size => 45);
		print "<small>&nbsp;(URL, opt.)</small><br>\n" if ($ftyp eq 'i');
		print "<small>&nbsp;(URL, req.)</small><br>\n" if ($ftyp eq 'I');
		print "<br><small>[Image data syntax  XXxYY=proto://path]</small>\n";
		last SWITCH;
	    }
	}
	print "\n</td></tr>\n";
    }
    print "\n</table><p>\n";
    print $q->hidden(-name => $CEP_STORE, -value => 1);
    print $q->hidden(-name => $CEP_ADD);
    print "\n";
    print "<font size='+1'><center>\n",$q->submit(-value => "SUBMIT"),"\n</center></font>\n";
    print $q->end_form(),"\n";
    print "<p>\n";
    print "Note - there is currently no way to delete a record via this CGI\n";
    print "script.  The only way to delete an entry right now is to edit\n";
    print "the data files directly.  Hopefully this deficiency will be\n";
    print "remedied soon.\n";
    print "<p>\n";

    return 1;
}



#################################################################
# print_record - print a record according to the given format
#		 
#	The basic approach here is to check the format, and
#   then do one of two things:
#
#		1. for index format, just print the name
#		   as a link, along with a number
#
#		2. for short or full format, print the
#		   fields along with their names, the
#		   rule for short format is, skip all
#		   optional long text fields and skip
#		   all links and images.
#

$prev_first_ltr = '*';

sub print_record {
    my $fmt = shift;
    my $q = shift;
    my $cnt = shift;
    my $prevname = '';

    $fmt = substr $fmt,0,1;

    if ($fmt eq 'i') {
	my $lnam = $q->param($fieldNamePrimary);
	my $indxnum; 
	print "\n","<dd>";
	$indxnum = sprintf("%4d. %s",($cnt + 1),"<b>");
	$indxnum =~ s/ /&nbsp;/g;
	print $indxnum;
	print $q->a({-href => (geturl($query) . "?_key=" . urlenc($lnam)) },
		    $q->param($fieldNamePrimary));
	print "\n</b></dd>\n";
    }
    else {
	my $fkey;
	my $fnam;
	my $ftyp;

	if ((defined($query->param($CEP_ALPHA)) || (defined($query->param($CEP_TOTAL)) && ($fmt ne 'i')))
	    &&
	    !($prev_first_ltr eq uc(substr($q->param($fieldNamePrimary),0,1))))
	{
	    print "<!-- in big letter print area. -->\n";
	    $prev_first_ltr = uc(substr($q->param($fieldNamePrimary),0,1));
	    $prev_first_ltr = 'Other' if ($prev_first_ltr eq '!');
	    print "<p><dt><b><font size='+5'>",$prev_first_ltr,"</font></b></dt>\n";
	}

	
  KEYS: foreach $fkey (@fieldKeys) {
	    $fnam = $fieldNames{$fkey};
	    $ftyp = $fieldTypes{$fkey};
	    $fa = 0;
	    my $closer = "\n";


	    if ((($fmt eq 'f') && ($ftyp =~ m/[sSeEtTrRuUiI]/)) ||
		 (($fmt eq 's') && ($ftyp =~ m/[sSetr]/)))
	    {
		next KEYS if (($ftyp eq uc($ftyp)) && (!($q->param($fkey))));

		if  ($fkey eq $fieldNamePrimary) {
		    print "<br clear=both>\n<dt><b><font size='+1'>";
		    $closer = "\n</font></b></dt>\n";
		}
		elsif (lc($ftyp) ne 'i') {
		    print "\n<dd>";
		    print "<i>",$fnam,":</i>" if ($fkey =~ m/[^2-9]$/);
		    print "\n<ul><font size='-1'>";
		    $closer = "</ul></font><p></dd>\n";
		}

		if (lc($ftyp) eq 'i') {
		    if ($q->param($fkey)) {
			my $imgfield = $q->param($fkey);
			if ($imgfield =~ m/^ *([1-9][0-9]*)[xX]([1-9][0-9]*)=(.*)/) {
			    my ($imgwid, $imghgt, $imgurl) = ($1,$2,$3);
			    $imgurl = $CEP_BASE_IMG_URL . $imgurl if (index($imgurl,'/') < 0);
			    print '<img src="',$imgurl,'" align=right ',
			          "hspace=3 width=$imgwid height=$imghgt>\n";
			}
		    }
		}
		elsif ((lc($ftyp) eq 'r')) {
		    my @xrefstrings = split(/, */,$q->param($fkey));
		    my $xrefstr;
		    foreach $xrefstr (@xrefstrings) {
			print "<a href='",geturl($query),'?',$CEP_KEY,'=',urlenc($xrefstr),"'>\n";
			print $xrefstr;
			print '</a>&nbsp;&nbsp;&nbsp;';
			print "\n";
		    }
		}
		else {
		    my $tval = $q->param($fkey);
		    my $lval;

		    if ((lc($ftyp) eq 's') && ($q->param($fkey . "URL"))) {
			print "<a href='",$q->param($fkey . "URL"),"'>\n";
			$fa = 1;
		    }
		    elsif (lc($ftyp) eq 'u') {
			if ($tval =~ m/([^=]+)=(.*)$/) {
			    $tval = $1;
			    $lval = $2;
			} else { $lval = $tval; }
			print "<a href='",$lval,"'>\n";
			$fa = 1;
		    }
		    print $tval,"\n";
		    print "\n</a>\n" if ($fa);
		}

		print $closer;
	    }
	}

    }

    return 1;
}


#################################################################
# Database reading and writing routines
#
#   The current design of the database is very simple: items
#   live in files as CGI.pm objects.  There is one file for each
#   letter of the alphabet, plus one more for non-alpha.  Items
#   belong to each file based on the first character of their
#   primary key: the item "animal" would be stored in the file
#   "cep-a.dat", the item "Turbine" would be stored in the
#   file "cep-t.dat", and the item "123" would be stored in the
#   file "cep-!.dat".  Items are always stored in alphabetical
#   order by case-insensitive primary key in their files, to
#   save having to sort them for output.
#
#   Retrieval consists of reading the records one by one and
#   matching their fields against a search pattern or key name.
#   As a special hack, the query parameter _alpha specifies 
#   which files we need to check, this is used for dictionary
#   style retrievals which I'm assuming will be most common.
#
#   Updating is slow but fortunately we shouldn't need to do
#   it very much.  Basically, to update one of the files, we
#   stream it though a sorted insertion and write the results
#   to a file "cep-*.new".  Then, we rename the file we had
#   been reading to "cep-*.bak" and rename the temporary to
#   "cep-*.dat".  At the start of the update, we check whether
#   the ".new" file exists, and if it does then we wait 3
#   seconds and look again.  This should prevent collisions
#   without making the user redo any work.
#

# state variables
$dbcurfile = undef;		# current file, by name
@dbalphalist = ();
$dbcurhandle = undef;		# ref to current file handle
$dbfinished = 0;

#
# retrieve_restart - call to reset db routines before starting
#    a second sequence through the database.  No need to call
#    this if you are only going to walk the db once.
#
sub retrieve_restart {
    $dbcurfile = undef;
    if (ref($dbcurhandle)) { close $dbcurhandle; }
    $dbcurhandle = undef;
    @dbalphalist = ();
    $dbfinished = 0;
    return 0;
}

# 
# retrieve_next_record - return ref to next record, or
#			 undef if no records remain.
#
#   This subr accepts 3 args.  If given, each must be a
#   string and they represent:
#
#		1. The set of alphabet letters we have
#		   to stream over, for example 'def'.
#	
#		2. The key to find, overrides other
#		   args, case insensitive match.  Also
#		   assumes keys are unique.
#
#		3. The search pattern, a regexp to
#		   look for in the data.
#

sub retrieve_next_record {
    my $alphaset = shift;
    my $keynam = shift;
    my $pat = shift;
    my $ret = undef;
    my $keypat = $query->param($CEP_SEARCHFIELD);
    my $qobj;

    return(undef) if ($dbfinished);

    # handle burden of opening a file if necessary
    $keynam =~ s/^[ 	]+//;
    if ($#dbalphalist < 0) {
	$alphaset = lc(substr($keynam,0,1)) if (!($keynam eq ''));
	@dbalphalist = split //,$alphaset;
    }

    $keypat = '.' if (!defined($keypat) || $keypat eq '');


    # if we get this far, then $dbcurhandle is a valid file handle
    while(!(defined($ret))) {
	if (defined($dbcurhandle) && eof($dbcurhandle)) {
	    close DATFILE;
	    shift @dbalphalist;
	    $dbcurfile = undef;
	    $dbcurhandle = undef;
	    # Test for end-of-stream condition, how the heck did it
	    # end up way in here?!
	    if ($#dbalphalist < 0) { $dbfinished = 1; return undef; }
	}
	while (!(defined($dbcurhandle))) {
	    $dbcurfile = $CEP_FILE_PREFIX . $dbalphalist[0] . $CEP_FILE_SUFFIX;
	    # print "<!-- file name set to ",$dbcurfile," -->\n";
	    if (open(DATFILE,$dbcurfile)) {
		$dbcurhandle = \*DATFILE;
		# print "<!-- opened file ",$dbcurfile," -->\n";
	    }
	    else {
		shift @dbalphalist;
		$dbcurfile = undef;
		$dbcurhandle = undef;
		# Test for end-of-stream condition, how the heck did it
		# end up way in here?!
		if ($#dbalphalist < 0) { $dbfinished = 1; return undef; }
	    }
	}

	# get something from the file, hopefully this wont fail...
	$qobj = new CGI(DATFILE);

#	print "<!-- read record for ",$qobj->param($fieldNamePrimary)," -->\n";
#	print "<!-- full record is ",$qobj->dump()," -->\n";

	# check whether this is an object we want
	if (defined($qobj) && ($qobj->param($fieldNamePrimary) ne '')) {
	    if ($basic_mode == 1) {
		$ret = $qobj;
	    }
	    else {

		if ($keynam ne '') {
		    if (lc($keynam) eq lc($qobj->param($fieldNamePrimary)))
		    {
			$ret = $qobj;
		    }
		}
		else
		{
		    my $fkey;
		    @keylist = @fieldKeys;

		    KEY: foreach $fkey (@keylist) {

			if (($fieldTypes{$fkey} =~ m/[sSeEtTuUrR]/) &&
			    (defined($qobj->param($fkey))) && 
			    ($qobj->param($fkey) ne '') &&
			    ($fkey =~ m/$keypat/i) &&
			    ($qobj->param($fkey) =~ m/$pat/i))
			{
			    $ret = $qobj;
			    last KEY;
			}
		    }
		}
	    }
	}

    }

    return $ret;
}



#
# update_record - add or change a record in the dictionary
#
#	This subr changes the database by sticking a record into
#  a specified dictionary file.  Our first arg is the file letter 
#  to stick the query object into, and the second arg is the ref
#  to the query object.  Basically, it works like this:
#
#		0. determine file name
#		1. wait for the new file not to exist
#		2. create the new file
#		3. stream over records of the old file,
#		   and do insert at right position.
#		4. rename the old file as a backup file
#		5. rename the new file as data file
#
#	This approach does still leave the possibility of
#  a race condition, but it is a very small window.
#
#	For insertion, we use a very simple criterion, 
#  lexicographic ordering of the primary key.  Note that if
#  the old file does not exist, then we simply end up
#  creating it.
#

sub update_record {
    my $falpha = shift;
    my $qrec = shift;
    my $cnt = 0;
    my $addedyet = 0;

    my $newfname = $CEP_FILE_PREFIX . $falpha . $CEP_FILE_NEW_SUFFIX;
    my $bakfname = $CEP_FILE_PREFIX . $falpha . $CEP_FILE_BAK_SUFFIX;
    my $datfname = $CEP_FILE_PREFIX . $falpha . $CEP_FILE_SUFFIX;

    for($cnt = 0; ($cnt < 10) && (-e $newfname); $cnt += 1) {
	sleep 3;
    }
    
    return "Could not create update file" if (-e $newfname);
    if (open(NEWF, ">" . $newfname)) {
	if (open(DATF, $datfname)) {
	    my $orec;
	    while(!(eof(DATF))) {
		$orec = new CGI(DATF);
		if (!($addedyet)) {
		    if (lc($qrec->param($fieldNamePrimary)) eq 
			lc($orec->param($fieldNamePrimary)))
		    {
			$qrec->save(NEWF);

			$addedyet = 1;
		    }
		    elsif (lc($qrec->param($fieldNamePrimary)) lt 
			   lc($orec->param($fieldNamePrimary)))
		    {
			$qrec->save(NEWF);

			$addedyet = 1;

			$orec->save(NEWF);
		    }
		    else {

			$orec->save(NEWF); 
		    }
		}
		else { 

		    $orec->save(NEWF); 
		}
	    }
	    if (!($addedyet)) { 

		$qrec->save(NEWF); 
	    }
	    close DATF;
	}
	else {
	    $qrec->save(NEWF);
	}
	close NEWF;
    }
    else { return "Could not open update file $newfname for writing"; }

    rename $datfname,$bakfname;
    rename $newfname,$datfname;

    return '';
}