#!/usr/local/bin/perl -wT
#
# CGI for searching bibliography
#
package Bibs;

use strict;
use CGI;
use DB_File;
use Fcntl;

use vars qw($maxhits $defaultlen $dbprefix $scriptauthor);
use vars qw(@fieldnames);

my @found;
my @keyset;

my $bsrch = new CGI;

$maxhits = 1024;
$defaultlen = 32;
$dbprefix='/www/bib/';
$scriptauthor='webmaster@LTRR.Arizona.EDU';
@fieldnames=('author', 'date', 'title', 'journal', 'language', 'subject',
             'keywords', 'taxa', 'places', 'abstract');

my $ky = $bsrch->param('set');
my $db = $bsrch->param('database');
my $tg = $bsrch->param('target');
my $ll = $bsrch->param('listlen');
my @sp = $bsrch->param('sumparts');
@sp = ('title') unless @sp;
@sp = &fieldsort(\@sp, \@fieldnames);
$ll = $defaultlen unless (defined($ll) && ($ll =~ /^\s*\d+\s*$/) &&
                          ($ll > 0) && ($ll < $maxhits));
print($bsrch->header());
print($bsrch->start_html(-title=>'Summary of refernces found',
                         -author=>$scriptauthor));
my $hashref;
($hashref = new DB_File::HASHINFO ) || &cgidie($bsrch, "couldn't create hash $!") ;
my %DATABASE;
tie(%DATABASE, 'DB_File', "$dbprefix$db", O_RDONLY, 0444, $hashref)
   || &cgidie($bsrch, "couldn't open file for $db ($@): error $!");
if (defined($ky)) {
   @keyset = split(/\s/, $ky);
   my $k;
   foreach $k (@keyset) {
      my $key = sprintf("%7d", int($k))."\0";
      if (defined($DATABASE{$key}) && ($DATABASE{$key} =~ /$tg/io)) {
         push(@found, $key);
      }
   }
} else {
   my ($key, $val);
   while (($key, $val) = each %DATABASE) {
      next unless ($val =~ /$tg/io);
      push(@found, $key);
   }
}
untie(%DATABASE) || &cgidie($bsrch, "couldn't close file for $db");

my $hits = @found;
if (!$hits) {
   print("<H3>No references found.</H3>\n");
} elsif ($hits > $maxhits) {
   print("<H3>Too many references specified!</H3>\n");
   print("<STRONG>Your query found $hits references, ");
   print(" but we can't handle more than $maxhits.</STRONG><P>\n");
} elsif ($hits <= $ll) {
   if (@keyset) {
      print("<H3>Narrowed previous list to $hits references.</H3>\n");
   } else {
      print("<H3>Found $hits references.</H3>\n");
   }
   &refsummary($bsrch, \@found, \@sp);
} else {
   grep(s/[\s\0]//g, @found);
   my $keytext = join(' ', @found);
   print("<H3>Found $hits references, but can't display more than $ll.</H3>\n");
   print("Please narrow your selection by searching within the list of references you have found.<P>\n");
   &narrow($bsrch, $keytext, $ll, \@sp);
}
&bsfooter();
print($bsrch->end_html());

sub fieldsort {
   my($rawfld, $canfld) = @_;
   my %present;
   my $f;
   foreach $f (@$rawfld) {
      $present{$f}++;
   }
   my @tidy = ();
   my $c;
   foreach $c (@$canfld) {
      push(@tidy, $c) if $present{$c};
   }
   return @tidy;
}

sub refsummary {
   my($bs, $keysfound, $sumparts) = @_;
   my @sumflds = ('author', 'date', @$sumparts);
   my %sumvals;
   my %summary;
   my %tied;
   print("This is a summary list,\n");
   print("from which you can select more details about particular references.<P>\n");
   my $sfld;
   foreach $sfld (@sumflds) {
      $tied{$sfld} = +{ };
      tie(%{$tied{$sfld}}, 'DB_File', "$dbprefix$sfld", O_RDONLY, 0444, $DB_HASH)
         || &cgidie($bs, "can't open $sfld file ($!)");
   }
   my $reckey;
   foreach $reckey (@$keysfound) {
      my $sf;
      foreach $sf (@sumflds) {
         $sumvals{$sf} = (defined($tied{$sf}->{$reckey})) ? $tied{$sf}->{$reckey} : "\0";
         chop($sumvals{$sf});
      }
      my $details = $reckey;
      $details =~ s/[\s\0]//g;
      $details .= "=";
      my @outflds = @sumflds;
      my $nxtfld = shift(@outflds);
      my $sumkey = $sumvals{$nxtfld};
      if (@outflds) {
         $nxtfld = shift(@outflds);
         $sumkey = join(" ", $sumkey, $sumvals{$nxtfld});
      }
      if (@outflds) {
         $nxtfld = shift(@outflds);
         $details = join("", $details, $sumvals{$nxtfld});
      }
      my $resfld;
      foreach $resfld (@outflds) {
         $details = join(', ', $details, $sumvals{$resfld});
      }
      if (defined($summary{$sumkey})) {
         my $letter = ord('b');
         my $z = ord('z');
         my $testkey = join('', $sumkey, chr($letter));
         while (defined($summary{$testkey}) && ($letter <= $z)) {
            $testkey = join('', $sumkey, chr($letter++));
         }
         $sumkey = $testkey;
      }
      $summary{$sumkey} = $details;
   }
   print("<OL>\n");
   my $sk;
   foreach $sk (sort keys(%summary)) {
      my ($keytxt, $detail) = split(/=/, $summary{$sk}, 2);
      print("<LI><A HREF=\"/cgi-bin/biblioitem.pl?$keytxt\">$sk</A> $detail\n");
   }
   print("</OL>\n");
   foreach $sfld (@sumflds) {
      untie(%{$tied{$sfld}}) || &cgidie($bs, "can't close $sfld file ($!)");
   }
}

sub narrow {
   my($bs, $keytxt, $listlen, $sumpart) = @_;
   my %fieldlabels = (
      author=>'Author names.',
      date=>'Date of publication.',
      title=>'Title of paper or monograph.',
      journal=>'Journal or publication details.',
      language=>'Languages used in the publication.',
      subject=>'General subject area.',
      keywords=>'Specific keywords.',
      taxa=>'Names of taxa.',
      places=>'Geographical locations.',
      abstract=>'Abstract.'
   );
   my @allowed = ('title', 'journal', 'language', 'subject', 'keywords',
                  'taxa', 'places');
   print($bs->startform('POST', '/cgi-bin/bibliosearch.pl',
                        'application/x-www-form-urlencoded'));
   print($bs->submit(-value=>'Narrow Search',
                     -name=>'narrow'));
   print($bs->hidden(-name=>'set',
                     -default=>$keytxt));
   print("<BR><BR><STRONG>Text to search for :</STRONG><BR>");
   print($bs->textfield(-name=>'target',
                        -size=>64,
                        -maxlength=>80));
   print("\n<BR><BR>\n<STRONG>Field in which to search:</STRONG><BR>\n");
   print($bs->radio_group(-name=>'database',
                          -"values"=>\@fieldnames,
                          -default=>'author',
                          -linebreak=>'true',
                          -labels=>\%fieldlabels,
                          -columns=>2));
   print("<BR>\n<STRONG>Maximum number of references in summary:</STRONG><BR>\n");
   print($bs->textfield(-name=>'listlen',
                        -size=>4,
                        -maxlength=>4,
                        -default=>$listlen));
   print("<BR><BR>\n<STRONG>Parts of reference to show in summary:</STRONG><BR>\n");
   print($bs->checkbox_group(-name=>'sumparts',
                             -"values"=>\@allowed,
                             -default=>$sumpart,
                             -linebreak=>'true',
                             -labels=>\%fieldlabels,
                             -columns=>2));
   print($bs->endform);
}

sub bsfooter{
   print <<END_OF_FOOTER;
<HR>
<H5><A HREF="/~grissino/henri.htm"><IMG SRC="/~grissino/ultiring.gif">
    Henri's pages</A> | 
<A HREF="http://www.LTRR.Arizona.EDU/labinfo.html"><IMG SRC="/treeringtiny.gif">
    Laboratory information</A> | 
<A HREF="/bib/howto.html">bibliography search instructions</A></H5>
<HR>
<ADDRESS>Bibliography content compiled by
<A HREF="mailto:grissino\@LTRR.Arizona.EDU">Henri Grissino-Mayer</A>. 
If you have problems with the search, contact
<A HREF="mailto:$scriptauthor">$scriptauthor</A>.
  Last modified 1-Dec-1996.
</ADDRESS>
END_OF_FOOTER
}

sub cgidie {
   my($bs, $errtext) = @_;
   print("<H2>$errtext, reference display abandoned.</H2>\n");
   print("Please contact <A HREF=\"mailto:$scriptauthor\">$scriptauthor</A>.\n");
   print($bs->end_html);
   die($errtext, "stopped");
}
