#!../bin/perl
# Pre-process a user query; send it to a k2tunnel or pattunnel for search; process
# the output.  (See end of file for history.)
# (NOTE: NIPO/UK must uncomment one line in filter_IC)

# Input name/value pairs which will override our defaults are:
#  &app=currentResults (the default)|pdfExpress|dataExtract|snapshot|clustering|patentLab|fhist
#                             and the value determines the tab content
#  &GENERAL=query             a complete user query, often including Verity search language
#                             elements
#  &-g=n                      n=1 is the default and it writes html to stdout which
#                                 includes the site header/footer, the tabs and tab content
#                                 for the &app application, and a result set for the query
#                             n=3 writes an xml result set to stdout
#                             n=4 causes the patent numbers and scores of the result set
#                                 to be written into db2, followed by a redirect to
#                                 whatever is in patquery's REDIR_URL environment, or
#                                 whatever is specified in the -r value
#                             n=5 causes both 1 and 4 to be done
#  &-m=pagesize               the default is 20 (and 0 is allowed)
#  &-s=startrow               the default is 1
#  &-c=list-of-collections    the list may be comma separated; multiple -c's are allowed
#  &-i=list-of-fields to show the list may be comma separated; multiple -i's are allowed
#                             (and the number after the i, e.g. -i6, determines the order)
#  &-o=field-name             the sort column (default is score); ties are resolved by
#                             later issued date, then by patent number
#  &-r=cluster or wisdomain or a url   cluster and wisdomain get translated to appropriate
#                             url's (and their are some security checks) -- default is empty
#  &-e=add'l-args, for the -r multiple -e's are allowed; a number after the e is allowed
#  &-l=name-of-invoking-page  this value will appear in the patquery log files
#                             (any page/code calling either patsearch or a patquery tunnel
#                              should supply this value, so we can easily track where searches
#                              are originating)
#  &pn=list-of-selected-patents  Any patent in this list will get a check mark
#  &pf=1                      produce printer-friendly html (only with -g=1)
#  &k2=0                      to use pattunnel instead of the default k2tunnel
#  &vs=dephds0NN              to change to a Verity server instead of localhost
#  &fulltext=                 if present, with a value of 1 or y(es) or t(rue), all collections named are upgraded to their
#                             named are upgraded to their fulltext versions, and downgraded with any
#                             other non-empty value
#  &GENSTART/&GENEND=query fragment   the query becomes GENSTART(GENERAL)GENEND -- cht's
#                             hack for adding a <yesno> on the front and/or a date
#                             restriction on the back, of a GENERAL query
#  &qid=1                     should only be used by the saved search/run search world and
#                             it results in a "call" to IPNqrytime after a -g=1 page has
#                             been formed
#  &nchost=wwwX or elephant or full https:// url -- to change nc server
#  &cr=n1+n2+n3               (obsolete) sets the startrow to 1/n1/n2/n3 depending on
#                             whether we have First.x, Prev.x, Next.x or Last.x present
#  &language=de  or  es ...   to change languages (obsolete)
#  &Search.x or .y            ignored (for use with a Search button)
#                             (some other .x .y arguments are ignored as well)
#  &skipX=anything            is ignored (X can be any string allowed in a name, or empty)
#
#  &workfile= &wlref= &add=   are arguments only used in the Workfile
#    &wlname=                 part of the current results page (it also uses &pn).
#  NOTE!  Anything not mentioned above becomes part of the query.  In particular, the
#  &FieldNN_Type= and &FieldNN_Text=  arguments passed by the various search forms become
#  part of the query passed on through the patquery tunnel.  All of the "-" arguments
#  are passed on through the tunnel, for example, -a (see warning below).

use strict;
sub text_filter_sed(\$);
sub getDatasrc(\%);
sub getImagePages(\%);
sub getDerwentTitle(\%);
sub getAge($);
sub getInventor(\%);
sub renderThumbnail($$$$);
sub trim(\$;\$\$\$\$);
sub hashDump(\%);
sub sortFields(\@\@);
sub getUserLists($);
sub getAbstract($$);
sub details_url($);
sub formatILang($);
sub ul1_open($);
sub ul1_close($);
sub ul1_closebr($);
sub getPndisp(\$$);
sub insertHitTable($\@);
sub getHitTable($$\@);
sub displayHtlmError($);
sub setDelphionCookie(\%\$);
sub trimPath(\$);
sub url_decode($);
sub url_encode($);
sub trackQuery($$);
sub callTrack($);
sub flushout($);
sub readproperties($);

use CGI qw/:standard/;
use CGI::Cookie;
use FCGI;
use constant PnhashDatasrc => 0;
use constant PnhashImagePages => 1;
use constant PnhashDrawing => 2;
use constant PnhashQueryTps => 3;
use constant PnhashIsOnTps => 4;
use constant PnhashDwPan => 5;
use constant PnhashDwTitle => 6;
use constant PnhashInventor => 7;

my $fcgiRequest = FCGI::Request();
my $max_fcgi_requests = 1000;
my $fcgi_requests = 0;

my $use_db2 = 1;
use DBI qw(:sql_types);

use LWP::Simple qw(get);
use HTTP::Request::Common;
use LWP::UserAgent;

use File::Basename;
my $patsearch;
if ($0 =~ /.*\/(.*)\/(.*)/) {
  $patsearch = "/$1/$2";
} else {
  $patsearch = "/cgi-bin/patsearch";
}

my $debug = 0;
my $netdatasnap=1;

#------- Set (some of) our global variables -------
my (%free_coll, %hitlist_op);
$free_coll{"bibonly"} = 1;
$free_coll{"lblistings"} = 1;

my $default_pagesize = 20;
my $default_body_color = qq(BGCOLOR="WHITE");
my $default_left_color = qq(BGCOLOR="#cccc99");
my $default_showsort_color = qq(BGCOLOR="#dddddd");
my ($body_color, $left_color, $showsort_color);
my $default_row1_color = qq(BGCOLOR="WHITE");
my $default_row2_color = qq(BGCOLOR="#FAFAEA");
my $geneva = qq!FACE="Verdana,Geneva,Arial,Helvetica"!;
my $empty_col  = "  <TD>&nbsp;</TD>\n";
my $nbsp = "&nbsp;"; # makes code a little less ugly, no major upside
my $A_etag = "</a>";
use constant HeaderLineCt => 3;
use constant QueryInListCt => 50;

# Remove this hash when non-subscriber popups are removed +++
$hitlist_op{"scroll"} = 1;
$hitlist_op{"refine"} = 1;
$hitlist_op{"sort"} = 1;
$hitlist_op{"choose"} = 1;

# for doing complete urlencoding - from RFC 1738...
my %urlenc;
for (my $i=0x20; $i<=0x7e; $i++) {
    $urlenc{chr($i)}=chr($i);
}
$urlenc{' '}="+";
$urlenc{'"'}="%22"; # how bout that
$urlenc{'#'}="%23";
$urlenc{'%'}="%25";
$urlenc{'&'}="%26";
$urlenc{':'}="%3A";
$urlenc{';'}="%3B";
$urlenc{'<'}="%3C";
$urlenc{'='}="%3D";
$urlenc{'>'}="%3E";
$urlenc{'?'}="%3F";
$urlenc{'@'}="%40";
$urlenc{'['}="%5B";
$urlenc{'\\'}="%5C";
$urlenc{']'}="%5D";
$urlenc{'^'}="%5E";
$urlenc{'`'}="%60";
$urlenc{'{'}="%7B";
$urlenc{'}'}="%7D";
$urlenc{'|'}="%7C";
$urlenc{'~'}="%7E";

my %opposite_coll=(
  usapps => 'usappsft',
  usappsft => 'usapps',
  bibonly => 'patentft',
  patentft => 'bibonly',
  epa => 'epaft',
  epaft => 'epa',
  epb => 'epbft',
  epbft => 'epb',
  pct => 'pctft',
  pctft => 'pct',
  deapps => 'deappsft',
  deappsft => 'deapps',
  de => 'deft',
  deft => 'de'
);

my $txt_contact_support  = "Please feel free to contact our customer support team should you have any questions:\n";
   $txt_contact_support .= qq!  <A HREF="http://www.scientific.thomson.com/support/techsupport">Contact Customer Support</A>.\n!;

# preload HTML template file(s)
my %template;
my %templatefiles;

$templatefiles{'tabs'}="../templates/patsearchTabs.html";
$templatefiles{'currentResults'}="../templates/currentResults.html";
$templatefiles{'0results'}="../templates/currentResults0.html";
$templatefiles{'topNav'}="../templates/currentResults2.html";
$templatefiles{'bottomNav'}="../templates/currentResults3.html";
$templatefiles{'choose'}="../templates/currentResults4.html";
$templatefiles{'orderBox'}="../templates/orderBox.html";
$templatefiles{'workFile'}="../templates/workFile.html";
$templatefiles{'clustering'}="../templates/clustering.html";
$templatefiles{'snapshot'}="../templates/snapshot.html";
$templatefiles{'printerfriendly'}="../templates/printerFriendly.html";
$templatefiles{'printerfriendlyTop'}="../templates/printerFriendly2.html";
$templatefiles{'trailer'}="../htdocs/hti/trailer.hti";
$templatefiles{'header'}="../htdocs/hti/header.hti";

while (my ($key,$fn) = each %templatefiles) {
  $template{"$key"}="";
  if (open(DATA,$fn)) {
    while (<DATA>) {
      $template{"$key"}.=$_;
    }
    close DATA;
  } else {
    print STDERR "patsearch: missing template file $fn\n";
  }
}

my %preferences;


# ------- Global constants belonging to g1OutputFilter, here because we use fcgi -------
# strings for various "wordings"
my $txt_ia_fast_buy = "PDF";
my $txt_ia_fast_buy_short = "PDF";
my $txt_ia_add_cart_short = "Select";
my $txt_pl_fields = "Show fields:&nbsp;";

my $txt_desc = "Sort descending";
my $txt_asc = "Sort ascending";
my $sort_href_title = "Sort DIRECTION";
my $sort_href_windowstatus = "Click to sort DIRECTION";
my $ascending_direction = "ascending";
my $descending_direction = "descending";
my $txt_sort_help = "(To sort a column, click label at top)";
my $txt_sick_server = "We are experiencing a temporary service outage and we are unable to complete your search.\n";
   $txt_sick_server .= "  We are working to fix this problem as quickly as possible and apologize for any inconvenience.\n";
   $txt_sick_server .= "  We appreciate your patience; please try your search again later.\n";
my $txt_bad_collection  = "We do not recognize the collection you specified.\n";
   $txt_bad_collection .= "  Please recreate your search using one of our search pages,\n";
   $txt_bad_collection .= qq!the <A HREF="/simple">Quick/Number</A>\n!;
   $txt_bad_collection .= " search page is a good place to start.\n";
   $txt_bad_collection .= "  You can also review descriptions of all of our collections on our\n";
   $txt_bad_collection .= qq! <A HREF="/collect_descrip">Collection Details</A> page.\n!;

# g1OutputFilter's constant hashes and arrays
my (%hd_txt,%hd_sort,%colldesc,%col_pos);
my (@selectable_colls,@selectable_ftcolls,@non_ftcolls);
# col_order indicates left-to-right column positioning, col names must be same as hd_txt, hd_sort, etc.
my @col_order = ("VDKVGWKEY","IMG", "TITLE","DWT", "AB", "INVT", "ASSG","PD","AD","DP","CLAS","PATN","WEEK","ASSC", "SCORE");
$hd_txt{"VDKVGWKEY"} = "Publication";
$hd_txt{"PD"} = "Pub. Date";
$hd_txt{"TITLE"} = "Title";
$hd_txt{"CLAS"} = "IPC&nbsp;Code";
$hd_txt{"ASSG"} = "Assignee";
$hd_txt{"SCORE"} = "Score";
$hd_txt{"PATN"} = "Patent";   # Derwent extra fields from here
$hd_txt{"WEEK"} = "Week";
$hd_txt{"AD"} = "Filed";
$hd_txt{"DP"} = "Priority";
$hd_txt{"ASSC"} = "Code";
$hd_txt{"INVT"} = "Inventors";
$hd_txt{"AB"} =   "Abstract";
$hd_txt{"DWT"} =  "Derwent Title";

# Default sort directions (0 is descending; 1 is ascending)
$hd_sort{"VDKVGWKEY"} = 0;
$hd_sort{"PD"} = 0;
$hd_sort{"CLAS"} = 1;
$hd_sort{"ASSG"} = 1;
$hd_sort{"TITLE"} = 1;
$hd_sort{"SCORE"} = 0;
$hd_sort{"PATN"} = 0;                 # Derwent extra fields from here
$hd_sort{"WEEK"} = 0;
$hd_sort{"AD"} = 0;
$hd_sort{"DP"} = 0;
$hd_sort{"ASSC"} = 1;
$hd_sort{"INVT"} = 1;

$colldesc{"usapps"} = "US (Applications)";
$colldesc{"usappsft"} = "US (Applications - Full text)";
$colldesc{"bibonly"} = "US (Granted)";
$colldesc{"patentft"} = "US (Granted - Full text)";
$colldesc{"epa"} = "European (Applications)";
$colldesc{"epb"} = "European (Granted)";
$colldesc{"epaft"} = "European (Applications - Full text)";
$colldesc{"epbft"} = "European (Granted - Full text)";
$colldesc{"deapps"} = "German (Applications)";
$colldesc{"de"} = "German (Granted)";
$colldesc{"deappsft"} = "German (Applications - Full text)";
$colldesc{"deft"} = "German (Granted - Full text)";
$colldesc{"japan"} = "Abstracts of Japan";
$colldesc{"pct"} = "WIPO PCT Publications";
$colldesc{"pctft"} = "WIPO PCT Publications (Full text)";
$colldesc{"inpadoc"} = "INPADOC";
$colldesc{"derwent"} = "Derwent (Test)";
$colldesc{"derdemo"} = "Derwent (Demo)";
$colldesc{"lblistings"} = "Patents with IP Listings";
$colldesc{"ipcom"} = "IP.com";

@selectable_colls=qw(bibonly usapps epb epa de deapps japan pct inpadoc);
@selectable_ftcolls=qw(patentft usappsft epbft epaft deft deappsft pctft);
@non_ftcolls=qw(japan inpadoc lblistings);
my %subset_coll=(epaft=>1, epbft=>1, deappsft=>1, deft=>1, pctft=>1);

# one-time initialization for the CurrentResults and other apps (before the fcgi loop)
my $header_body_color = $default_body_color;
my $header_left_color = $default_left_color;
my $header_showsort_color = $default_showsort_color;
# get colors from lines like:
# <!--#set var="body_color" value="BGCOLOR=\"WHITE\"" -->
if ($template{'header'} =~ /<!--\#set var=\"body_color\" value=\"(BGCOLOR=.*)\" -->/) {
  $header_body_color = $1;
  $header_body_color =~ s/\\//g;
}
if ($template{'header'} =~ /<!--\#set var=\"left_color\" value=\"(BGCOLOR=.*)\" -->/) {
  $header_left_color = $1;
  $header_left_color =~ s/\\//g;
}
if ($template{'header'} =~ /<!--\#set var=\"showsort_color\" value=\"(BGCOLOR=.*)\" -->/) {
  $header_showsort_color = $1;
  $header_showsort_color =~ s/\\//g;
}

my %info;
my ($yyyy,$mmdd)=split(' ',`date +"%Y /%m/%d"`);
$info{"refineOneyear"}=sprintf(" AND PD&gt;%4d%s",$yyyy-1,$mmdd);
$info{"refineTwoyears"}=sprintf(" AND PD&gt;%4d%s",$yyyy-2,$mmdd);
$info{"refineThreeyears"}=sprintf(" AND PD&gt;%4d%s",$yyyy-3,$mmdd);
$info{"refineFiveyears"}=sprintf(" AND PD&gt;%4d%s",$yyyy-5,$mmdd);
$info{"refineTenyears"}=sprintf(" AND PD&gt;%4d%s",$yyyy-10,$mmdd);

# Capture values from the initial environment, before we enter the fcgi request loop
# (where %ENV will have a different request environment, each time)
my $default_gmode = $ENV{'DEFAULT_GMODE'};
my $IPNROOT = $ENV{'IPNROOT'};
if(!$IPNROOT) {
    $IPNROOT = "..";  # .. = devel/ipn/, prod/ipn/, stage/ipn
}

# Determine Verity Server to be used (if &vs= isn't set in the QUERY_STRING)
# (All verity servers use port 80)
# We also set the default tunnel here, and the default database,
# since they also depend on which environment we are running in.
my ($default_verity_server, $default_tunnel);
my $RULE_FILE = $ENV{'RULE_FILE'};
my $default_pqdatabase;
if (defined($RULE_FILE)) {
  $RULE_FILE =~ m|(.*/)?(.+)|;
  if (index("$2","dev") >= 0) {  # use localhost for development nodes
    $default_verity_server="localhost";
    $default_tunnel = "pattunnel";
    $default_pqdatabase = "pdbfree"
  } elsif (index("$2","ipn") >= 0) {  # use network dispatched searchfree for regular nodes
    $default_verity_server="search";
    $default_tunnel = "k2tunnel";
    $default_pqdatabase = "pdbfree"
  } else {  # use localhost/k2tunnel for any other environment
    $default_verity_server="localhost";
    $default_tunnel = "k2tunnel";
    $default_pqdatabase = "pdbfree"
  }
} else {
  $default_verity_server="localhost";
  $default_tunnel = "k2tunnel";
  $default_pqdatabase = "patent"
}

my $PQDATABASE = $ENV{'PQDATABASE'};
$PQDATABASE = $default_pqdatabase unless ($PQDATABASE);
my $PQUSERID = $ENV{'PQUSERID'};
$PQUSERID = "ipsrun" unless ($PQUSERID);
my $PQPW = $ENV{'PQPW'};
$PQPW = "ipsrun_password" unless ($PQPW);

my $unique = $ENV{'RANDOM'};
$unique = $$ unless $unique;
my $response_html  = "/tmp/search.$unique.html";
my $response_http  = "/tmp/search.$unique.http";
my $qsfilename = "/tmp/search.$unique.qs";

my $httppost   = "$IPNROOT/bin/httppost";
my $httppost_mode = ($debug) ? "-g" : "";

my $fcgi_mode = $fcgiRequest->IsFastCGI();
my $only_once = ($fcgi_mode) ? 0 : 1;
my $TrackableApp = '^(quicksearch|advquery|boolquery)$';

# Connect to db2 just once if we are using fcgi, and prepare our selects for image pages
# and for testing the database status (i.e. is it now out of rotation)
my ($db2h, $db2sth, $statsth, $db2dsrch, $db2imagh, $db2ageh, $db2dwtitle, $db2dwtitleh, $db2invth);
if ($fcgi_mode && $use_db2) {
  setupDB2();
  connectDB2();
}

# Declarations of global variables set in our fcgi accept() loop
my ($hprefix, $cookie, $userid, $shopperid, $userLevel, $server, $server_addr, $annotation, $features);
my ($remote_addr, $request_uri, $whoami, $debugfromenv);
my ($gmode,$pagesize,$lval, $pf, $k2, $tunnel, $vs, $url_to_call, $nchost, $dbname);
my ($language, $langarg, $workfile, $qid, $genstart, $genend, $isExplicitFields);
my ($SINPUT, %SARRAY);
my $appName;
my (%coll_index, $fulltext_field);
my @pn;
my %delphionCookie;

# set up a signal to quit gracefully
my $gotsig = 0;
$SIG{'INT'} = sub {$gotsig = 1; print "$patsearch($$)...Quitting as requested\n"};

while($only_once ||
      ($fcgi_mode && !$gotsig && $fcgi_requests++ < $max_fcgi_requests && $fcgiRequest->Accept() >= 0)) {
  # How do we set an FCGI ExitStatus in this perl world? +++
  $only_once = 0;
  print STDOUT "Content-type: text/html\n\n<BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>Debugging<BR>" if ($debug > 1);

  # Everytime we get a new request, if we are in fcgi mode, we do a quick check to
  # see if the database we are using is still in rotation.  If it is not, we set up
  # to exceed our life quota, but, we do process this current request with the current db.
  if ($db2h && $statsth && $fcgi_mode) {
    my $rotation = "";
    my $ok = $statsth->execute();
    if ($ok) {
      my ($attval, $attname);
      $statsth->bind_col(1, \$attval);
      $statsth->bind_col(2, \$attname);
      while ($statsth->fetch()) {
         trim($attname, $attval);
         if ($attname eq 'DBSTATUS') {$rotation = $attval;}
         elsif ($attname eq 'DBNAME') {$dbname = $attval;}
      }
    } else {
      warn "$patsearch($$): fetch of dbstatus failed\n  ", $db2h->errstr;
      $rotation = "OUT";  # if we can't get there, it must be out of service
    }
    $statsth->finish();
    if (uc($rotation) eq "OUT") {
      $fcgi_requests = $max_fcgi_requests;
      warn "$patsearch($$): quitting after this request, dbstatus of $PQDATABASE is OUT\n";
    }
  }

  $hprefix = "http";
  $hprefix = "https" if (defined($ENV{HTTPS}) && uc($ENV{'HTTPS'}) eq 'ON');  # ON if ssl, reliably
  $cookie = (defined($ENV{HTTP_COOKIE})) ? $ENV{'HTTP_COOKIE'} : "";
  $server = (defined($ENV{SERVER_NAME})) ? $ENV{'SERVER_NAME'} : "";
  $server_addr = $ENV{'SERVER_ADDR'};
  $remote_addr = $ENV{'REMOTE_ADDR'};
  $request_uri = (defined($ENV{"REQUEST_URI"})) ? $ENV{"REQUEST_URI"} : $patsearch;
  $whoami = ($request_uri =~ /(.*)\?.*/) ? $1 : $request_uri;

  %delphionCookie = (); # clear/reset
  setDelphionCookie(%delphionCookie, $cookie);
  $userid = "";
  $shopperid = "";
  $userLevel="unknown";
  if ($delphionCookie{"IPNuser.user"}) {
    $userid=$delphionCookie{"IPNuser.user"};
    $userLevel="basic";  # he is at least a basic user -- the features test could upgrade
  }
  $annotation="";
  if ($delphionCookie{"IPNuser.annotval"}) {
    # this value is url encoded; decode and minimally html encode
    $annotation=$delphionCookie{"IPNuser.annotval"};
    $annotation =~ s/\+/ /g;
    $annotation =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
    $annotation = minimal_htmlencode($annotation);
  }
  if ($delphionCookie{"Ticket.id"}) {
    $shopperid=$delphionCookie{"Ticket.id"};
  }
  $features="";
  if ($delphionCookie{"Ticket.features"}) {
    # this value has just letters, numbers, and _'s so no html encode needed
    $features=$delphionCookie{"Ticket.features"};
    if ($features =~ /(premier|unlimited)/i) {
      $userLevel=lc($1);
    }
  }

  # Get our input string
  my $METHOD = (defined($ENV{REQUEST_METHOD})) ? $ENV{'REQUEST_METHOD'} : "";
  if ( $METHOD eq 'POST')
  {
    read(STDIN, $SINPUT, $ENV{'CONTENT_LENGTH'});
    # POSTs may have a trailing newline
    chomp $SINPUT;
  }
  elsif ($METHOD eq 'GET' )
  {
    $SINPUT = $ENV{'QUERY_STRING'};
  }
  else
  {
    print STDERR "patsearch($hprefix): invoked with invalid REQUEST_METHOD: $METHOD\n";
    print STDOUT "Content-type: text/html\n\n";
    print STDOUT "<FONT COLOR=red>UNEXPECTED METHOD $METHOD</FONT>\n";
    if ($debug>1) {
      print STDOUT "<br><br>Environment:\n";
      while (my ($key,$value) = each %ENV) {
        print STDOUT "<br>$key=$value\n";
      }
    }
    next;
    $fcgi_requests += 100;  # lose 100 lives, instead of exit(1);
  }
  $debugfromenv  = qq| <!-- qstring: "$SINPUT" -->\n|;
  $debugfromenv .= qq| <!-- cookie: "$cookie" -->\n|;
  $debugfromenv .= qq| <!-- userid: "$userid"  userlevel: "$userLevel" -->\n|;
  $debugfromenv .= qq| <!-- whoami: "$whoami" -->\n|;
  $debugfromenv .= qq| <!-- remote_addr: "$remote_addr" -->\n|;

  if ($SINPUT eq "") {
    # Would it be better to return HTTP error, and let server handle reply?
    select(STDOUT); $| = 1;
    print STDOUT "Content-type: text/html\n\n";
    OutputHeader("No search terms supplied","error");
    print STDOUT $debugfromenv if ($debug);
    my $tail = "<BR><BR><CENTER><STRONG>";
    $tail .= "No search terms were supplied.";
    $tail .= "</STRONG></CENTER>\n";
    $tail .= "<BR>To continue, please choose one of the IP Search items ";
    $tail .= "or use your browser's Back button.  \n";
    $tail .= "Bookmarking of search results is not supported.\n";
    $tail .= "<BR><BR>\n";
    $tail .= "</TD></TR></TABLE>\n";  # end the table started by OutputHeader()
    print STDOUT $tail;
    OutputTrailer();
    next;
  }

  # Build the hash with name/value pairs, removing the url encoding
  undef %SARRAY;
  $isExplicitFields = 0;
  my @combo = split(/&/, $SINPUT);
  foreach my $combo (@combo)
  {
    $combo =~ s/\+/ /g;
    my ($input_name, $value) = split(/=/,$combo);
    if (!$isExplicitFields && $input_name =~ /^-i/) {$isExplicitFields = 1;}

    $input_name =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
    $value      =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
    $value      =~ s/\s/ /g;  # embedded \n's and such need to get normalized

    print "[$combo][$input_name][$value]<BR>\n" if ($debug > 2);

    next if ($input_name =~ /^skip/i);  # remove all tags named skipXXX
    if($SARRAY{$input_name}) {
      # If an entry appears more than once, append a space and new
      #  value to the old value.   (ex:  -c coll_f ... -c coll_b -> -c coll_f coll_b)
      $SARRAY{$input_name} .= " $value";
    } else {
      $SARRAY{$input_name} = $value;
    }
  }

  # JTI the app value is the application mode (tab button) to display
  $appName="currentResults";  # default mode
  if (defined($SARRAY{"app"})) {
      $appName=$SARRAY{"app"};
      delete $SARRAY{"app"};
  }
  # (Leave in the original, not-quite-right, argument name for a while +++)
  if (defined($SARRAY{"-app"})) {
      $appName=$SARRAY{"-app"};
      delete $SARRAY{"-app"};
  }

  # The -l value was supposed to be a simple name, identifying the html page this patsearch
  # was invoked from.  But, some pages don't seem to pass this at all (which causes us not
  # to log the search on the Verity Server), and some pages seem to think that is a good
  # name for a patsearch-invoking button.  Try to repair any mess here.
  delete $SARRAY{"x"};
  delete $SARRAY{"y"};
  delete $SARRAY{"-l.x"};
  delete $SARRAY{"-l.y"};
  $lval = $SARRAY{"-l"};
  if (!defined($lval) || $lval eq "") {
    $lval = "unknown";
    $SARRAY{"-l"} = "$lval";
  }

  # See if our user is permitted to search other than free collections
  # (This test quickly skims off the obvious cases -- we check again
  # later, after we have completely filtered the input.)
  if (TestSubscriber() == 1) {
    next;  # we redirected him
  }

  # Look for the "g" mode tag and value; set default if not present
  $gmode = $SARRAY{"-g"};
  if (!defined($gmode) || $gmode eq "") {
    $gmode = ($default_gmode) ? $default_gmode : "1";
    $SARRAY{"-g"} = "$gmode";
  }

  $pagesize = $SARRAY{"-m"};
  if (!defined($pagesize) || !($pagesize =~ /\d+/)) {
    $pagesize = $default_pagesize;   # default
    $SARRAY{"-m"} = $pagesize if ($gmode eq '1' || $gmode eq '5');  # tell patquery
  }

  # Reject xml requests (-g 3) if not from localhost
  if (($gmode eq "3") && ($remote_addr !~ /localhost|127\.0\.0\.1|$server_addr/)) {
    OutputXML401();
    next;
  }

  # Only for -g 1 mode, respect a request for a printer-friendly page
  $pf = $SARRAY{"pf"};
  if (defined($pf)) {
    delete $SARRAY{"pf"};  # remove from the query
    $pf = 0 if ($gmode ne "1");  # +++ what is gmode for derwent?
  }

  # Obtain k2 Server tag and value, if present
  $k2 = $SARRAY{"k2"};
  if (defined($k2)) {
    $tunnel = ($k2) ? "k2tunnel" : (("$k2" eq "0")?"pattunnel":$default_tunnel);
    delete $SARRAY{"k2"};  # remove from the query
  } else {
    $tunnel = $default_tunnel;
  }

  # Obtain Verity Server tag and value, if present
  $vs = $SARRAY{"vs"};
  if ($vs) {
    $url_to_call="http://$vs/fcgi-bin/$tunnel";
  } else {
    $url_to_call="http://$default_verity_server/fcgi-bin/$tunnel";
  }
  delete $SARRAY{"vs"} if (defined($vs));

  # Obtain the language, if present, and remove from the query
  $language = $SARRAY{"language"};
  delete $SARRAY{"language"} if (defined($language));
  $langarg = ($language) ? "&language=$language" : "";

  # Obtain nchost tag and value, if present, and remove from the query.
  # Or, set from the environment if NCHOST is present.
  $nchost = $SARRAY{"nchost"};
  if (defined($nchost)) {
    delete $SARRAY{"nchost"};
  } else {
    $nchost = $ENV{'NCHOST'};
  }

  # Remove any "search" tag from the query (the Search button uses these
  # so that netscape users will get a nice mouseover display).
  delete $SARRAY{"Search.x"}; delete $SARRAY{"Search.y"};
  delete $SARRAY{"search.x"}; delete $SARRAY{"search.y"};
  delete $SARRAY{"SEARCH.x"}; delete $SARRAY{"SEARCH.y"};

  # Remove any sorting button, and print friendly button, tags from the query
  # (If the NAME we put on the button changes, these have to change.)
  delete $SARRAY{"Sort ascending.x"}; delete $SARRAY{"Sort ascending.y"};
  delete $SARRAY{"Sort descending.x"}; delete $SARRAY{"Sort descending.y"};
  delete $SARRAY{"printer friendly.x"}; delete $SARRAY{"printer friendly.y"};

  # Set -s for navigation  (cr is now unused and should be removed soon +++)
  my $cr = $SARRAY{"cr"};
  if(defined($cr)) {
    delete $SARRAY{"cr"};
    $cr =~ /(\d*)(\s)+(\d*)(\s)+(\d*)/;
    $SARRAY{"-s1"} = 1 if(defined($SARRAY{"First.x"}));
    $SARRAY{"-s$1"} = 1 if(defined($SARRAY{"Prev.x"}));
    $SARRAY{"-s$3"} = 1 if(defined($SARRAY{"Next.x"}));
    $SARRAY{"-s$5"} = 1 if(defined($SARRAY{"Last.x"}));
    delete $SARRAY{"First.x"}; delete $SARRAY{"First.y"};
    delete $SARRAY{"Prev.x"}; delete $SARRAY{"Prev.y"};
    delete $SARRAY{"Next.x"}; delete $SARRAY{"Next.y"};
    delete $SARRAY{"Last.x"}; delete $SARRAY{"Last.y"};
  }

  if (defined($SARRAY{"-r"})) {
    # Lookup table for -r value
    my %url_hash;
    $url_hash{"cluster"} = "http://localhost/cluster";
    $url_hash{"wisdomain"} ="$nchost/servlet/com.delphion.ipn.user.IPNAddWDItem";
    # Before we overwrite a -r value, ensure proper clustering authentication
    if ($SARRAY{"-r"} eq "cluster" && basename($0) ne "clustersearch") {
      # Tom said to put in this check, but didn't say what he wanted
      # to do for failure, so, put a message in the httpd-error log and
      # say something about not being authorized to the user.
      print STDERR "Unauthorized clustering requested, $0 was called\n";
      OutputUnauthorized();
      next;
    }
    $SARRAY{"-r"} = $url_hash{$SARRAY{"-r"}};
  }

  # Alter collection names, based on the setting of the fulltext arg
  if (defined($SARRAY{"fulltext"})) {
    my $fulltext = $SARRAY{"fulltext"};
    delete $SARRAY{"fulltext"};

    if (defined(my $collections = $SARRAY{"-c"}) && $fulltext ne "") {
      $fulltext = $fulltext =~ /^[1yt]/i;
      my @colls = split(/[\ ,]+/, $collections);
      $collections="";
      foreach my $cname (@colls) {
        if (($cname =~ /ft/ && !$fulltext)||($cname !~ /ft/ && $fulltext)) {
          $cname = $opposite_coll{$cname} if (defined($opposite_coll{$cname}));
        }
        $collections .= " $cname";
      }
      $SARRAY{"-c"} = substr($collections, 1);
    }
  }

  # Get the qid of a saved search (passed by a Run of a saved search)
  $qid = $SARRAY{"qid"};
  if (defined($qid)) {
    delete $SARRAY{"qid"};
  }

  if (defined($SARRAY{'pn'})) {
    @pn = split(/[,\s]+/, $SARRAY{'pn'});
    delete $SARRAY{'pn'};
  } else {
    @pn = ();
  }

  # Names of collections which may cause various transforms
  my @cnames = qw(bibonly patent patentft usapps usappsft epb epbft epa epaft de deft deapps deappsft pct pctft japan inpadoc inpadup);
  undef %coll_index;
  foreach my $cname (@cnames) {
    $coll_index{$cname} = -1;
  }

  # Do filtering on what is left of the whole array (should only be query parts now).
  inputFilter();

  # Now double-check on whether the user is really allowed to do this search
  if (TestSubscriber() == 1) {
    next;  # we redirected him
  }

  # Modify the filtered GENERAL query string by any GENSTART and GENEND values
  $genstart = $SARRAY{"GENSTART"};
  $genend = $SARRAY{"GENEND"};
  delete $SARRAY{"GENSTART"} if (defined($genstart));
  delete $SARRAY{"GENEND"} if (defined($genend));
  if (($genstart || $genend) && defined($SARRAY{"GENERAL"})) {
    $SARRAY{"GENERAL"} = "$genstart(".$SARRAY{"GENERAL"}.")$genend";
  }

  # Check for assigneefamily
  my $input_name_test;
  my $value_test;
  my $af_seen = 0;
#== DISABLED ==
  my $NEVER = 0;
if($NEVER){
  while ( ($input_name_test, $value_test) = each(%SARRAY) ) {
    if(($input_name_test =~ /assigneefamily/i)||($value_test =~ /assigneefamily/i)) {
      print STDERR "Denied assigneefamily field use, $0 was called\n";
      OutputUnauthorized("The assigneefamily field has been temporarily disabled.</strong><br />\nFor more information please see <a href=\"/products/research/popups/hierarchy\" target=\"_new\">Hierarchy Data Availability</a>.<strong>");
      $af_seen=1;
      last;
    }
  }
}
  if($af_seen) {
    $af_seen=0;
    next;
  }

  # If work file administration
  $workfile = $SARRAY{"workfile.x"};
  if (defined($workfile)) {
    delete $SARRAY{"workfile.x"};  # remove from the query
    delete $SARRAY{"workfile.y"};
    ManageWorkfile();  # This will redirect
    next;
  }

  if (!$isExplicitFields) {
    $SARRAY{"-i"} = "VDKVGWKEY TITLE PD SCORE";
  } elsif ($gmode!=3 && ($SARRAY{"-i"} . $SARRAY{"-i0"} . $SARRAY{"-i1"}) !~ /VDKVGWKEY/i) {
    # patquery doesn't force key column into output so make sure all result sets have key
    $SARRAY{"-i"} = "VDKVGWKEY " . $SARRAY{"-i"};
    # (the above test, and the assignment, need "code improvement" +++)
  }

  # Build the url encoded query string.
  my $amper = "";
  my $i = 0;
  my $out_qstring = "";
  foreach my $tag (%SARRAY)
  {
    if ($i == 0) {
      my $value = $SARRAY{$tag};
      $tag   =~ s/([^ a-zA-Z0-9-_])/sprintf("%%%02lx",unpack('C',$1))/ge;
      $tag   =~ s/[ ]/+/g;
      $value =~ s/([^ a-zA-Z0-9-_])/sprintf("%%%02lx",unpack('C',$1))/ge;
      $value =~ s/[ ]/+/g;
      print "tag=$tag val=$value<BR>\n" if ($debug > 1);
      $out_qstring .= $amper . $tag . "=" . $value;
      $amper = "&";
    }
    $i = !$i;
  }


  # Create a file containing the QUERY_STRING
  # (This is never supposed to fail. If it does, the httppost will fail, so there will
  #  be no html file to process and we will end up telling the user that the server is
  #  down -- better than a die here.)
  open(QSFILE, ">$qsfilename");
  print QSFILE "$out_qstring";
  close(QSFILE);

  # Call URL and save responses, both HTML and HTTPS
  system "$httppost $httppost_mode \"$url_to_call?\" $qsfilename $response_html >$response_http;" ;

  # Depending on the mode used to invoked the patquery tunnel, write the
  # proper output, based on the response file, to STDOUT.  See patquery help text for gmode explanation.
  if ($gmode eq "4" || $gmode eq "8") {
    redirOutputFilter();
  } elsif ($gmode eq "3") {
    # Perhaps someday we should avoid the extra write/read from disk +++
    g3PassThru();
  } else {
    g1OutputFilter();
  }

  # Cleanup  (for non-fcgi_mode, redirOutputFilter did its own and never returned)
  unlink ($qsfilename, $response_http) unless ($debug);
  unlink ($response_html) unless ($debug);
  exit(0) if (!$fcgi_mode);
  $fcgiRequest->Flush();
  $debug = 0;  # Don't leave debug on, for the next user, in fcgi-mode
}  # while FCGI accept()

# cleanup before exiting
if ($db2sth) {
  $db2sth->finish();
  $db2h->disconnect();
}
print STDERR "$patsearch($$): $max_fcgi_requests lives used up, exiting...\n" if ($fcgi_requests>$max_fcgi_requests);
exit(0);

# Subroutine to test whether or not the current search is allowed.  If not,
# we redirect the user off to access jail.
#   returns 1 if the user was sent to jail; 0 otherwise
#
sub TestSubscriber
{
  return 0 if ($debug>1);  # +++ debug +++
  return 0 if ($remote_addr =~ /localhost|127\.0\.0\.1|$server_addr/);
  my @colls = split(/[\ ,]+/, $SARRAY{"-c"});
  my $allfree = 1;
  my @opts = split(/[\ ,]+/, $SARRAY{"-l"});
  foreach my $opname (@opts) {
        if($opname eq "wisdomain"){
                $allfree = 0;
                last;
        }
  }
  foreach my $cname (@colls) {
    if (!$free_coll{$cname}) {
      $allfree = 0;
      last;
    }
  }
  if (!($allfree) and
      ($userLevel !~ /premier|unlimited/) and
      !($hitlist_op{$lval})) {
    # He's not
    select(STDOUT); $| = 1;
    my $location = "/access_control/go.html.en$whoami?$SINPUT\n";
    print "Location: $location";
    print "Content-type: text/html\n\n";
    system("echo \"$location\" >$qsfilename") if ($debug);
    return(1);
  } else {
    return(0);
  }
} # TestSubscriber


# ---------------------------------------------------------------------------------
# Here we loop through our HTML-variables, mostly to detect search strings that we
# need to filter, but we also process -c (collection name).
#
# There can be great confusion in this discussion if one didn't clearly understand
# the term "field".  In most cases, e.g. in Delphion's Help pages, in the Boolean
# screen's "All Fields" box, or even here referring to the FieldNN_Type variable
# names, "field" just means anything searchable, but in the Verity world there's a
# big difference between a zone and a field.  Here, I use "field" to mean anything
# searchable, and I hereby coin "Vfield" to designate a Verity field.
#
# The 5 cases for search strings, are
#   1) The variable's name is GENERAL, whose value is the search string, which
#      might contain the full Verity syntax.
#
#   2) The variable's name is of the form FieldNN_Type (where NN is a number),
#      whose value is RAW, in which case the corresponding FieldNN_Text variable
#      contains the search string, which also may contain the full Verity syntax.
#
#   3) The variable's name is of the form FieldNN_Type, whose value is not RAW.
#      In this case, the variable's value specifies the zone/Vfield to search, and
#      the corresponding FieldNN_Text variable contains the search string, which
#      cannot have the full Verity syntax.
#
#   4) The variable's name is of the form FieldNN_Type, whose value is not RAW
#      (just like case 3), but the corresponding FieldNN_Text variable is undefined.
#      Where is the search string, you ask?  In hidden -a form variables.  See below.
#
#   5) The variable's name is of the form FieldNN_Type, whose value is not RAW
#      (just like 3 & 4), but the corresponding FieldNN_Text variable is defined,
#      but empty/null.  We delete these FieldNN_Type/FieldNN_Text pair of variables.
#
# Realize that the full search criteria can be in multiple pieces.  The Boolean
# screen for example, can pass many different FieldNN_Type/FieldNN_Text variable
# pairs to us.  We must look at each piece and filter what we can.
#
# -------------------------------------------------------------------------------
my %filters;
sub inputFilter {
  # This "Branch Tree" consolidates the previous bunch of nested if/elseif/elseif ...
  # statements by maintaining a list of zone keywords and their corresponding
  # filtering routine.  Testing is case-insensitive, so any of ki, Ki, kI, KI, will
  # match.  Note how multiple keywords can be defined for the same routine.
  # (class and mainclass, and the nationalclass full zone names, are not
  # included here since there has to be some sane way to avoid the class
  # filters, and the mistakes they make)
  %filters = ("KI"         => \&filter_KI,

              "IC"         => \&filter_IC,
              "MC"         => \&filter_IC,
              "INDEXCLASS" => \&filter_IC,

              "NC"         => \&filter_NC,
              "CNC"        => \&filter_NC,

              "UP"         => \&filter_UP,

              "PN"         => \&filter_PN,
              "USREFS"     => \&filter_PN);


  $fulltext_field = 0;

  # Loop through all variable's pairs of name/value.
  my ($input_name, $value);
  while ( ($input_name, $value) = each(%SARRAY) ) {

    if ( $input_name =~ / ^\s*GENERAL\s*$ /ix ) {
      # Temporary code to recognize (and remove) &d at the end of a refine'd user query,
      # to set $debug to 1, and GET instead of POST
      if ( $value =~ s/&d(\)*)\s*$/$1/ ) { $debug = 1; }

      # Farm off the handling of input strings containing the full Verity syntax, replacing
      # our original search string, $SARRAY{$input_name} with the filtered equivalent.
      $SARRAY{$input_name} = Parse_and_Filter_Search_String($value);

    } elsif ( $input_name =~ /^(Field\d+)_Type$/i ) {

      # For a FieldNN_Type variable name, the search string is the value of the corresponding
      # FieldNN_Text variable, whose name we now determine, being careful to preserve case.
      my $type_input_name=$input_name;       # Squirrel away original variable name.
      $input_name="${1}_Text";            # Note we are changing our while-loop variable, so


      # Warning!  Beware of the -a backdoor through patsearch, into patquery.  In both the
      #           Advanced and Boolean screens, in the From/To sets of Year/Month/Day pull-downs,
      #           Tom sets up FieldNN_Type variables, without their corresponding FieldNN_Text
      # partners.  "Where are the values/search strings?" you ask?  Hidden away in a variable
      # named -a (yes, with the dash).  For example, specifying only a "From" year of 2002 will
      # generate these html variable name/value pairs,
      #      Name           Value
      #      ===========    =================================
      #      Field46_Type   RAW
      #      Field46_OP     ) AND
      #      -a             &Field46_Text=AD%3e=2002-01-01
      # with Field46_Text being undefined, so we fail this test below (in Perl, undefined
      # variables equal "").
      #
      if ($SARRAY{$input_name} eq "") {          # Is FieldNN_Text string undefined or empty?
        if ( defined($SARRAY{$input_name}) ) {   # If it's really empty and not just
          delete $SARRAY{$type_input_name};      # undefined, then delete the pair.
          delete $SARRAY{$input_name};
        }
      } else {
        # We want to remove search strings that are really empty, i.e. they look like any of
        #       ()      <and>()      <or>()
        if ( $SARRAY{$input_name} =~ /^\s*(<\s*(and|or)\s*>\s*)?\(\s*\)\s*$/i ) {
          delete $SARRAY{$type_input_name};       # Pretend FieldNN_Type & FieldNN_Text
          delete $SARRAY{$input_name};            # pair, never existed.
        }

        # Ok, we have a corresponding FieldNN_Text variable and it's not empty.

        if ($value =~ /^\s*RAW\s*$/i) {
          # Farm off the handling of input strings containing the full Verity syntax.
          $SARRAY{$input_name} = Parse_and_Filter_Search_String($SARRAY{$input_name});

        } else {      #  We've got a FieldNN_Type variable name whose value is not RAW, so its
                      #  value must be the zone or Vfield to search.  Use our filters branch
                      #  tree to call the appropriate filter for this zone, if one exists.
          if (defined($filters{uc "$value"})) {   #  Allow mixed case zones.

            #  All filter routines take the search string as input and return it, possibly modified.
            $SARRAY{$input_name} = &{$filters{uc "$value"}}($SARRAY{$input_name});
          }

          #  If we're searching in any of the CLAIMS, DESCRIPTION, or BACKGROUND zones,
          #  then insure we're doing it in the Full-Text collections.
          #  Insure we properly handle the "(TITLE,ABSTRACT,CLAIMS)" case you'll get from
          #  the Boolean screen, when you select "Title, Abstract or Claims".
          if ($value =~ /\b(CLAIMS|DESCRIPTION|BACKGROUND)\b/i) {
            $fulltext_field = 1;      # Upgrade the collection being searched to full text.
          }
        }
      }


    # This variable's name is not GENERAL nor one of our FieldNN_Type guys.  What else do we handle?
    } elsif ( $input_name =~ / -c /x ) {
      # Determine absence or presence of collections; -1 indicates absence
      my @colls = split(/[\ ,]+/, $value);
      foreach my $cname (@colls) {
        $coll_index{$cname} = 1;
      }
    }   # else it's not a variable name we handle here.  Just ignore it.

  } # End of our "while" loop, going through all variable names.


  # Now that we have parsed all of the input, as much as we are going to,
  # see if we need any collection adjustments.

  # Ensure that there is at most one US (Granted) collection searched, and at most
  # one US (Applications), and at most one EPx or PCT
  # collection searched, and, that we are using the fulltext version if the user is
  # searching claims (or claimsLL), or description (or descriptionLL) or background.
  if ( $coll_index{"patent"} >= 0 ) {  # we automatically upgrade patent to patentft
    $coll_index{"patentft"} = 1;
    $coll_index{"patent"} = -1;
  }
  my $have_us = coll_test_and_upgrade("bibonly", "patentft");
  my $have_usapps = coll_test_and_upgrade("usapps", "usappsft");
  my $have_epa = coll_test_and_upgrade("epa", "epaft");
  my $have_epb = coll_test_and_upgrade("epb", "epbft");
  my $have_deapps = coll_test_and_upgrade("deapps", "deappsft");
  my $have_de = coll_test_and_upgrade("de", "deft");
  my $have_pct = coll_test_and_upgrade("pct", "pctft");

  # We also modify the specification of the inpadoc collection,
  # depending on what other collections are searched.  If no other
  # collection is being searched, we add all of inpadup (the collections
  # which contain patents that we have elsewhere in our database);
  # otherwise, we add only the inpadup collections which don't overlap.
  if ( $coll_index{"inpadoc"} >= 0 && $coll_index{"inpadup"} == -1 ) {
    my $ncolls = 0;
    foreach my $coll (keys %coll_index) {
      $ncolls++ if ( $coll_index{$coll} >= 0 );
    }
    if ( $ncolls == 1 ) {  # just inpadoc
      $coll_index{"inpadup"} = 1;
    } else {
      if ( $coll_index{"japan"} == -1 ) {
        $coll_index{"inpadup2"} = 1;
        $coll_index{"inpadup3"} = 1;
        $coll_index{"inpadup4"} = 1;
        $coll_index{"inpadup5"} = 1;
      }
      $coll_index{"inpadup6"} = 1,$coll_index{"inpadup7"} = 1 if ( $have_us == 0 );
      $coll_index{"inpadup10"} = 1 if ( $have_usapps == 0 );
    }
  }

  # reform the collection input variable, with the upgrades and inpadups,
  # in a cannonical order, so that we will always get the same search results
  # no matter what order the various search pages specify collections (although
  # as of 6/12/02, they all used the same order, which is our cannonical order)
  my $colls = "";
  foreach my $name (sort(keys %coll_index)) {
    if ( $coll_index{$name} >= 0 ) {
      $colls .= " " . $name;
    }
  }
  $SARRAY{"-c"} = substr($colls, 1);
} # End of inputFilter subroutine


# The functions below are used by the input filter


# --------------------------------------------------------------------------------------
#  Function to parse the passed search string which can contain the full Verity syntax.
#  Our goals are to identify the pieces of the search string that require filtering,
#  call the appropriate filter subroutine, and pass back the filtered string.
#  We also detect full-text zones and upgrade to the full-text collections if need be.
#
#  This routine is called when the html-form-variable's name is GENERAL, or one of the
#  FieldNN_type names whose value is RAW.
#
#  Like the filter routines, we are passed the search string and we return the search
#  string, possibly modified.  For example, given
#     ((   bananas     <IN  >   claims)   and (084/DIG.022 <  IN> NC  ))
#  we want to pick out the 084/DIG.022, let filter_NC mangle it to 084DIG022, and
#  return the prettier (( bananas <IN> claims ) and ( 084DIG022 <IN> NC))
#
#  ==================================================================================
#  =============       Important Warning to Future Filter Writers       =============
#  ==================================================================================
#
#  Note that we do not attempt to parse all legal Verity syntax.  That has proven to
#  be too complicated and besides, we don't have to.  Our purpose is to call the filter
#  subroutines only when necessary, which convert or normalize naive/beginner users'
#  input, into our canonical form that one would not expect the beginner to necessarily
#  know.  We can always claim a part of the search term is "too complicated", thus
#  identifying an experienced user, and not handle it.
#
#  Our job is made easier due to
#    1) The filters only handle Verity zones, not Vfields, so we only need look for
#       the <IN> keyword.  (Previous versions of patsearch also filtered date Vfields
#       and were looking for Vfield operators, e.g. PD >= 2004-04-22.)
#    2) We only filter search strings targeted towards exactly one zone.  Boolean screen
#       "All-Fields" searches, or GENERAL searches from the Advanced or Results screens,
#       that don't specify a zone at all (eg, 084/DIG.022), will not get filtered.
#       But if a zone is specified (eg, 084/DIG.022 <in> NC), it will get filtered.
#    3) This also allows us to skip the handling of this otherwise perfectly valid
#       Verity syntax:  "ABC <in> (IC,CLAIMS)" by saying it's "too complicated".
#       We'll only filter the search string if exactly one zone is specified.
#       (We do however parse those zones and do the full-text upgrades if appropriate)
#    4) The search terms that we DO filter, are in a known format with only certain
#       characters allowed.  This means that don't need to worry about some keyword
#       being inside quotes.  For example, "084/DIG.022" <in> NC (with the quotes)
#       won't get filtered.  Should it get filtered?  Arguably yes, but I don't want
#       to code the parsing of junk like "084 and (022)" <in> NC, or worse,
#       "really <in> sneaky" <in> NC.  Remember, filtering is to help beginners.
#       If we see a quote or any unusual character, they're not a beginner and their
#       search string doesn't get filtered.
#
#  Yet even with the above simplifications, this routine can still get things wrong
#  with really pathological cases, e.g.   "(000)<in> NC" <in> CLAIMS
#                                      This 000 will be passed to filter_NC (oops!)
#  We also don't detect and may filter invalid Verity syntax, e.g.
#     (AND 000) <in> NC                Ah, well.  Tough.  Verity will complain.
# --------------------------------------------------------------------------------------
sub Parse_and_Filter_Search_String {
  my ($search_string) = @_;

  my $filtered_search_string="";
  my ($next_unconsumed);
  my $next_unconsumed=0;            # Our cursor as we consume the search string.
  my $end_of_search_string=length($search_string);       # For end-of-string checking.

  # Loop through our passed search string, picking out any and all <in>'s.
  # Note the use of Perl's /g modifier, which continues scanning our search string
  # where we last left off.  Also see note regarding pos() function at the end of
  # this loop.  In this loop, we'll build up our $filtered_search_string variable,
  # which will get returned to our caller.
  while ($search_string =~ / \s* < \s* (in) \s* > \s* /ixg) {

    # We found an <in>.  Capture before and after pieces.
    my $IN = $1;                             # Preserve case of IN keyword.
    my $before_piece=substr($`,$next_unconsumed,(length($`)+$next_unconsumed));
    my $after_piece=$';
    my $after_piece_length=length($after_piece);
    my $zone_start_position = pos($search_string);
    my ($after_parenL, $paren_level, $zone_name, $after_parenR, $filtered_search_term, $before_this_search_term);

    # Parse out the zone name(s).  Handle any of
    #      NC  ( NC )   (CLAIMS)   (NC,IC) NC and more stuff   NC,IC   ((NC))
    # Set $zone_name and $zone_end_position variables.

    my $zone_cursor = 0;
    my $atom=substr($after_piece,$zone_cursor,1);

    if ($atom eq '(') {             # If the zone starts with a parenthesis,
      $after_parenL="(";            # remember it, then scan right to the
                                    # matching ")" or the end of the string,
      $paren_level=1;               # properly handling nested parenthesis.
      while ($paren_level && $zone_cursor<$after_piece_length) {
        $zone_cursor++;             # Advance right one character.

        $atom=substr($after_piece,$zone_cursor,1);
           if ($atom eq "(") {$paren_level++}
        elsif ($atom eq ")") {$paren_level--}
      }

      if ($zone_cursor<$after_piece_length) {   # Normal case where we found our matching ")".
        $after_parenR=")";                      # Remember ")" so we can restore it later.
        $zone_name = substr($after_piece,1,$zone_cursor-1);
      } else {
        $after_parenR="";                       # No matching ")" found.  It's ok, we'll do
        $zone_cursor--;                         # the best we can, setting the zone_name to
        $zone_name = substr($after_piece,1);    # the complete after_piece.
      }
      $zone_name =~ s/^\s+//;     # Remove multiple leading white-space
      $zone_name =~ s/\s+/ /g;    # Compress multiple imbeddded white-space
      $zone_name =~ s/ , /,/g;    # Change "aa , bb" to "aa,bb"
      $zone_name =~ s/\s+$//;     # Remove multiple trailing white-space

    } else {                      # This zone name does not start with an "(" (normal case).
      $after_parenL="";           # Remember lack of parenthesis so our filtered search
      $after_parenR="";           # string follows suit.

      # Here we find the end of our zone relying on the fact that all zone names only
      # contain alphanumeric characters.
      if ($after_piece =~ /^(\w+)/) {
        $zone_cursor=length($&)-1;   # Set position of last character of zone name.
        $zone_name=$1;
      } else {                     # No zone specified.  Bizarre case of <in>, or <in>
        $zone_name="";             # at the end of the search string, or some such.
        $zone_cursor=-1;           # Fudge position of last good character of zone name.
      }
    }



    # Ok, we've parsed out the zone name.  See if we've got a filter for it.
    # If so, only then do we look at the before_piece.  Note that an exact match
    # is required here.  000<in>NC and 000<in>(NC) will match ok and get filtered,
    # but 000<in>"NC" and 000<in>("NC") and 000<in>(IC,NC) although perfectly
    # valid Verity syntax,  won't match and will not get filtered.
    #
    if (! defined($filters{uc "$zone_name"})) {     # If there's no filter for this zone,
      $before_this_search_term=$before_piece;       # then set things up so we return
      $filtered_search_term="";                     # the original search term.

    } else {      # Else we have a filter for this zone.  We can't postpone this any longer.
                  # It's time to start looking at the search string before our <in>.
      my ($this_search_term, $search_term_parenL, $search_term_parenR);
      my $before_cursor = length($before_piece)-1;
      if ($before_cursor==-1) {            # No search term?  How bizarre.
        $before_this_search_term = "";
        $this_search_term = "";
      } else {                             # Normal case where we have a search term.
        my $search_term_end;
        $atom=substr($before_piece,$before_cursor,1);

        # Find the beginning of our search term.
        #
        if ($atom eq ")") {            # If our search string term with a right parenthesis,
                                       # then blindly go left to the matching "(" or to the
                                       # start of the string.
          $search_term_parenR=")";
          $search_term_end = $before_cursor-1;
          $paren_level=1;
          while ($paren_level && $before_cursor) {
            $before_cursor--;                    # Back up another character.
            if ($before_cursor==-1) {last}       # Ran out of before_string.

            $atom=substr($before_piece,$before_cursor,1);
               if ($atom eq ")") {$paren_level++}
            elsif ($atom eq "(") {$paren_level--}
          }

          if ($atom="(" && ! $paren_level) {  # Did we end normally, by finding the matching "("?
            $search_term_parenL="(";          # Remember the left parenthesis for later restoration.
            $before_this_search_term = substr($before_piece,0,$before_cursor);
            $before_cursor++;                 # Go back to first character after matching "(".
            $this_search_term = substr($before_piece,$before_cursor,$search_term_end-$before_cursor+1);

          } else {                            # Ran out of before_string before finding the matching "("
            $search_term_parenL="";           # That's ok.  Remember lack of left parenthesis and
            $before_this_search_term = "";    # we'll call the whole before_string, our search term.
            $this_search_term = substr($before_piece,$before_cursor,$search_term_end-$before_cursor+1);
          }

          $this_search_term =~ s/^\s+/ /;     # Pretty up our search term, removing excess whitespace.
          $this_search_term =~ s/\s+$/ /;
          $this_search_term =~ s/  +/ /g;

        } else {           # Am in non-parenthesis mode.  Scan leftward 'till beginning-of-string
                           # accepting any word character (letter, digit, _), [/-.], space, or
                           # bareword and|or|not.
          $search_term_end = $before_cursor;
          while ($before_cursor>=0) {
            if ((($before_cursor > 3) && (substr($before_piece,$before_cursor-4,5)=~/\Wand\W/i)) ||
                (($before_cursor== 3) && (substr($before_piece,$before_cursor-3,4)=~/not\W/i  )) ||
                (($before_cursor > 3) && (substr($before_piece,$before_cursor-4,5)=~/\Wnot\W/i)) ||
                (($before_cursor > 2) && (substr($before_piece,$before_cursor-3,4)=~/\Wor\W/i ))) {

              $before_cursor++;      # We found a keyword.  Terminate this search term.
              last;
            } elsif ($atom !~ /[\w\/\. ,*?;]/) {   # Check for valid search term characters.
              $before_cursor++;      # Terminate scan at first invalid character.
              last;
            }
                                     # Else this character is ok inside a search term.
            $before_cursor--;        # Continue scanning left-ward.
            $atom=substr($before_piece,$before_cursor,1);
          }
          if ($before_cursor==-1) {              # Did we run out of before_piece before finding
            $before_this_search_term = "";       # some other reason to terminate our search term?
            $this_search_term = $before_piece;   # Yep.

          } else {                               # Nope.  Carve out search term.
            $before_this_search_term = substr($before_piece,0,$before_cursor);
            $this_search_term = substr($before_piece,$before_cursor);
          }
        }    # End of Before non-parenthesis mode.
      }      # End of normal case where we have a search term.

      $this_search_term =~ s/^\s+//;     # Remove multiple leading white-space
      $this_search_term =~ s/\s+/ /g;    # Compress multiple imbeddded white-space
      $this_search_term =~ s/\s+$//;     # Remove multiple trailing white-space
      if ($this_search_term) {           # If there's anything of our search term left,
                                         # then filter it.
        $filtered_search_term="$search_term_parenL" . &{$filters{uc "$zone_name"}}($this_search_term) . "$search_term_parenR";

      } else {                           # else it's an empty, bogus search term.
        $filtered_search_term="$search_term_parenL$search_term_parenR";       # Maintain search term parenthesis.
      }
    }

    $filtered_search_term =~ s/^\s+/ /;     # Compress multiple leading white-space
    $filtered_search_term =~ s/\s\s/ /g;    # Compress multiple imbeddded white-space
    $filtered_search_term =~ s/\s+$/ /;     # Compress multiple trailing white-space
    $filtered_search_string.=" $before_this_search_term $filtered_search_term <$IN> $after_parenL$zone_name$after_parenR";

    if ($zone_name =~ /\b(CLAIMS|DESCRIPTION|BACKGROUND)\b/i) {
      $fulltext_field = 1;      # Upgrade the collection being searched to full text.
    }

    # Advance Perl's position inside our search string, to the next character beyond our
    # zone name(s).  The pos() function works in tandem with Perl's /g pattern matching.
    $next_unconsumed = $zone_start_position + $zone_cursor + 1;
    pos($search_string)=$next_unconsumed;

  }  # End of our while loop, looking for <in>'s.


  # When there are no more <in>'s (or there were none at all), append the rest of
  # our search_string, that is, the part we haven't consumed yet.
  if ($next_unconsumed < $end_of_search_string) {
    $filtered_search_string.=substr($search_string,$next_unconsumed);
  }

  $filtered_search_string =~ s/^\s+//;     # Remove multiple leading white-space
  $filtered_search_string =~ s/\s+/ /g;    # Compress multiple imbedded white-space
  $filtered_search_string =~ s/\s+$//;     # Remove multiple trailing white-space

  return $filtered_search_string;
}



# Conversion of * in the KIND field.  We filter specifically, any letter followed by *,
# accepting multiple kind code search arguments separated by commas.  For example,
# We filter   c*           or   A1,B2,C*,D4
#      into   (c,c?)     into   A1,B2,(C,C?),D4

sub filter_KI {
  my ($in_var_string) = @_;
  my $output="";

  # If there's any kind of funny character at all in this search string, then don't
  # modify it at all.  Just pass everything on untouched.
  if ($in_var_string !~ /^[\w *?,]*$/) {
    $output = $in_var_string;

  } else {                                   # Else iterate across all comma-separated search
    foreach (split /,/, $in_var_string) {    # terms, building up our filtered output.
      my $term;
      # Filter this term if it's letter*, else don't muck with it.
      if ( /^\s*([A-Za-z])\*\s*$/) {
        $term = "($1,$1?)";
      } else {
        $term = $_;
      }

      #  Rebuild the search string with the commas we're parsing on, in our foreach/split loop.
      if ($output eq "") {                 #  First term?  I.E. First time through?
        $output = $term;                   #  If so, it doesn't get a comma.
      } else {                             #  Else separate this term from earlier ones with a
        $output .= ",$term";               #  comma.
      }
    }       # End of foreach split ...
  }

  return $output;
}



# Filter input of IPC Class Search Term
# Name: IC, MC, INDEXCLASS
# (class and mainclass are not included here since there has to be some sane
# way to avoid this filter, and the mistakes it makes)
#
# The format of IPC class numbers as rendered to the user and thus, in our input, is in
# three parts, with the first part mandatory and the other two optional (but if the second
# part exists, then so does the third).  The parts are separated by a space and slash and
# leading zeros in the second part are removed, eg G02F 1/31.
#
# In DB/2, we normalize the second part (if it exists), zero-padding it on the left to
# three characters.  We also remove the slash, leaving us with G02F 00131, for example.
# Verity indexes this as two separate words.  When we search, we give search arguments to
# Verity like G02F 00131.  Verity treats this as two words which must follow each other,
# thus returns what we want.
#
# But before searching, Verity does it checking to see if this search might return too many
# results and this is done on a word boundary.  Thus if the user entered "G02F 1/*", we
# filter this to "G02F 001*" and this will fail because of the 001* term (there are too
# many patents indexed with words starting with 001).  We've got to do something about that.
#
# Our solution is based upon the length of valid IPC classes.  After padding the second
# part to three characters, there are five possible lengths of valid IPC classes.
#   Length of  4 (e.g. G02F         )   ipc_ttl table has    630 different  4-character IPC's.
#   Length of 10 (e.g. G02F 00200   )   ipc_ttl table has 61,147 different 10-character IPC's.
#   Length of 11 (e.g. G02F 001383  )   ipc_ttl table has  6,127 different 11-character IPC's.
#   Length of 12 (e.g. G02F 0011333 )   ipc_ttl table has    405 different 12-character IPC's.
#   Length of 13 (e.g. G02F 00113363)   ipc_ttl table has      2 different 13-character IPC's.
# If we filter anything, we will never pass along *'s to Verity in the first two parts.
# Instead, we will always pad the first two parts with ?'s, to these fixed lengths.
#
# For example (these examples are not exhaustive or comprehensive),
#
#     G*          will get filtered to G???
#     G0*         will get filtered to G0??
#     G02*        will get filtered to G02?
#
#     G02F        will get filtered to just G02F, which will also pick up all the 10-13
#  or G02F*       character IPC classes, e.g. G02F 001/383 since Verity has indexed
#  or G02F *      these as two words.
#
#     G02F *1     will get filtered to (G02F ??1??<or>G02F ??1???<or>G02F ??1????)
#     G02F *12    will get filtered to (G02F ?12??<or>G02F ?12???<or>G02F ?12????)
#
#     G02F 1      you might think G02F 1* would get filtered to the impossibly long
#  or G02F 1*         (G02F 1????<or>G02F 1?????<or>G02F 1??????<or>
#                     (G02F 01???<or>G02F 01????<or>G02F 01?????<or>
#                     (G02F 001??<or>G02F 001???<or>G02F 001????)
#                 but due to the 1?* terms, this query is too complex for Verity, so just like
#                 we did in the National Class filter (filter_NC below), we'll interpret this as
#                 G02F 1/* and filter both to
#                     (G02F 001??<or>G02F 001???<or>G02F 001????)
#                 If the user doesn't like it, tough.  He can put in his own multi-term search or
#                 easier, to put some question marks or extra parenthesis in his search term,
#                 which we then, won't filter at all.
#
#     G02F 12     again, you might think G02F 12* would get filtered to some impossibly long thing,
#  or G02F 12*    but to keep things consistent with the G02F 1* case above, we simply filter this to
#                     (G02F 012??<or>G02F 012???<or>G02F 012????)
#
#     G02F 1*2    will get filtered to
#                     (G02F 1?2??<or>G02F 1?2???<or>G02F 1?2????<or>
#                      G02F 012??<or>G02F 012???<or>G02F 012????)
#
#     G02F 123/x  will never match since the third part is always 2 or more characters long,
#                 so we guess he meant 0x and filter to G02F 1230x.
#     G02F 123/*  will get filtered to (G02F 123??<or>G02F 123???<or>G02F 123????)
#
# We also try to handle more complex input, for example, G02* 1*2/*  will get filtered to
#                     (G02? 1?2??<or>G02? 1?2???<or>G02? 1?2????<or>
#                      G02? 012??<or>G02? 012???<or>G02? 012????)
# We may wind up with *'s in the third part, for example,
#     G02F 3/*x   will get filtered to G02F 003*x.
#
# This code used to include terms with nnn?????, but, since there are way too
# many occurrences of 8-digit numbers being indexed (for patent numbers) for
# such a search to work; and, because there are only two classes in the whole
# space of IPC's which have an 8-digit group/subgroup cht removed them.
# (For the curious, the two classes are: G02F 00113357 and G02F 00113363.)

sub filter_IC {
  my ($in_var_string) = @_;
  my ($output, $part1, $part2, $part3, $length1, $length2, $length3, $part2b, $length2b, $term);

  $output = $in_var_string;       #  Default output to input in case some of these tests fail.

  # If there's any Verity keyword (and, or, not) or any kind of funny character in
  # this search string, then don't modify it at all.
  if ( ($in_var_string !~ /^[A-Z\d\/ \*,]*$/i) ||
       ($in_var_string =~ /[ <]and[ >]/i ) ||
       ($in_var_string =~ /[ <]or[ >]/i ) ||
       ($in_var_string =~ /[ <]not[ >]/i ) ) {
    $output = $in_var_string;            # Pass everything on untouched.
  } else {

    $output="";                         #  Reset output to null 'cause we're gonna
    # split our input (the search argument) into separate, comma-delimited terms,
    # and iterate across all search terms, rebuilding our filtered output.
    foreach (split /,/, $in_var_string) {

      # Parse out the three parts of the IPC Class search argument,
      # 0-4 characters, delimited by an optional space, with possible asterisks (*),
      # 0-3 characters, delimited by an optional slash (/) with possible asterisks (*),
      # and the rest.
      # If this term doesn't follow this syntax, then don't muck with it.
      if ( /^\s* ([\*a-zA-Z\d]{0,4}) \s* \ ?     # First part
             \s* ([\*a-zA-Z\d]{0,3}) \s* \/?     # Second part
             \s* ([\*a-zA-Z\d]*    ) \s* $/x ) { # Third part
        $part1=$1;
        $part2=$2;
        $part3=$3;

        $length1 = length($part1);
        $length2 = length($part2);
        $length3 = length($part3);

        IC_CASE1: {
          #  If part1 is null or "*", e.g. " 123/45" or "* 123/45", then we can
          #  just drop it and let Verity search on simply part2 & part3,
          #  unless a single * is the whole term.
          if ($length1 == 0 || $part1 eq "*" ) {     # " 123/45" or "* 123/45"
            $part1 = "" if ($length2>0);             # Just search on the rest.
            last IC_CASE1;
          }
          #  The philosophy of whether or not to append an asterisk to any of the
          #  parts or not, is to do so if he has not asked for a specific class.
          #  A one-, two-, or three-character first part can never be a specific
          #  class, so we wild card that here, but four-character first parts
          #  that contain no wild-card characters, are specific.  Remember, due
          #  to the check for "funny" characters above, we don't see ?'s here.
          #  [cht does not agree with this philosophy; she thinks we should be
          #  adding wildcard ?'s only if the user already had an * in his search term]
          #  Only *s wild-card characters are possible.
          if (length($part1) < 4 && index($part1,"*")<0) {
            $part1 = substr($part1 . "????",0,4);    # Pad to length 4.
            last IC_CASE1;
          }
          #  If he's used *'s in his first term, e.g. C* or C*D or *D, we're
          #  going to be nice and expand them to C??? or C??D or ???D for him.
          #  But it's too much to ask us to do anything with *0*.  That 0 could
          #  in any position,  It's not reasonable for us to filter that into
          #  (0??? <or> ?0?? <or> ??0? <or> ???0).  Likewise for *0**.  So only
          #  handle here, exactly one * in something that's 4 characters or less.
          #  Perl Note:  $part1=~tr/*// counts how many *'s there are in $part1.
          if ( $part1=~tr/*// == 1 && length($part1) <= 4 ) {
            substr($part1, index($part1,"*"), 1) = "?" x (5-length($part1));
            last IC_CASE1;
          }
        }          #  End of IC_CASE1 block.

        #  The problem with wild-carding the second part is, we also zero-pad it.
        #  Thus if the guy asks for G02F *1/04, we need to make that G02F ??1/04.
        #  That one is easy, as is the 2-character case, G02F *12/04 to G02F ?1204.
        #  But asterisks on the right side are more difficult. You might guess
        #  that G02F 1* should catch G02F 001*, G02F 01?*, and G02F 1??*,  but
        #  as mentioned above, Verity fails the 1????? search as too complex, so we
        #  interpret G02F 1* as G02F 1/*, yielding
        #      (G02F 001??<or>G02F 001???<or>G02F 001????)
        $length1 = length($part1);

        $part2b = "";

        IC_CASE2: {
          if ( ($length2 == 0 || $part2 eq "*") && ($length3 == 0 || $part3 eq "*") ) {
            $part2="";
            last IC_CASE2;
          }
          if ( $length2 == 0 || $part2 eq "*") {   # /something or */something ==> ???
            $part2 = "???";
            last IC_CASE2;
          }
          if ( $length2 == 1 ) {                   # C ==> 00C
            $part2 = "00$part2";
            last IC_CASE2;
          }
          if ( $part2 =~ /^\*(.)$/ ) {             # *C ==> ??C
            $part2 = "??$1";
            last IC_CASE2;
          }
          if ( $part2 =~ /^(.)\*$/ ) {             # C* ==> 00C (intentionally not C?? or 0C?)
            $part2  = "00$1";
            last IC_CASE2;
          }
          if ( $length2 == 2 ) {                   # CC ==> 0CC
            $part2 = "0$part2";
            last IC_CASE2;
          }
          if ( $part2 =~ /^\*(..)$/ ) {            # *CC ==> ?CC
            $part2 = "?$1";
            last IC_CASE2;
          }
          if ( $part2 =~ /^(.)\*(.)$/ ) {          # C*C ==> C?C or 0CC, since * could be null.
            $part2  = "$1?$2";
            $part2b = "0$1$2";
            last IC_CASE2;
          }
          if ( $part2 =~ /^(..)\*$/ ) {            # CC* ==> 0CC (intentionally not CC? to keep
            $part2  = "0$1$2";                     #         consistent with the C* case above.
            last IC_CASE2;
          }
        }          #  End of IC_CASE2 block.

        # As a nice guy, we'll convert C09D 123/4 to C09D 123/04, else it'll never match.
        if ( length($part3) == 1 && $part3 ne "*" ) { $part3 = "0$part3" }

        $length1 = length($part1);        # Recompute current lengths.
        $length2 = length($part2);
        $length2b = length($part2b);
        # If length of $part3 is less than 2, it must be null or "*" (used below).
        $length3 = length($part3);

        # If there are any holes in my logic here, at least default to something reasonable.
        $term = $part1 . ("$part2$part3" ? " $part2$part3" : "");

        IC_CASE3: {
          #  For the C* or C0* or C09* or C09D or C09* / or C09D /* or C09D */* cases
          #  (i.e. a null part2 & part3), all we need do return is $part1.
          if ( $length3 < 2 && ($length2 == 0 || $part2 eq "???") ) {
            $term = $part1;               # If just * or " /", term would be blank.  Oh, well.
            last IC_CASE3;
          }
          #  Any $part1, $part2 not C*C, and null or * part3.  e.g. C09D 123 or C09D 123/*.
          if ( $length3 < 2 && $length2b == 0 ) {
            $term = "($part1 $part2??<or>$part1 $part2???<or>$part1 $part2????)";
            last IC_CASE3;
          }
          #  E.G. C09D C*C or C09D C*C/*
          if ( $length3 < 2 && $length2b > 0) {
            $term = "($part1 $part2??<or>$part1 $part2???<or>$part1 $part2????";
            $term .= "<or>$part1 $part2b??<or>$part1 $part2b???<or>$part1 $part2b????)";
            last IC_CASE3;
          }
          #  E.G. C09D CCC/xx or C09D CC*/xx or C09D CCC/xxx or others
          if ( $length3 > 1 && $part3=~tr/*?// == 0 && $length2b == 0) {
            $term = "$part1 $part2$part3";
            last IC_CASE3;
          }
          #  E.G. C09D C*C/xx or C09D C*C/xxx
          if ( $length3 > 1 && $part3=~tr/*?// == 0 ) {
            $term = "$part1 $part2$part3<or>$part1 $part2b$part3";
            last IC_CASE3;
          }
          #  All others C09D C*C cases, e.g. C09D C*C/12*3
          if ( $length2b > 0 ) {
            $term = "$part1 $part2$part3<or>$part1 $part2b$part3";
            last IC_CASE3;
          }
        }          #  End of IC_CASE3 block.
      } else {           # Else this term didn't match our "don't muck with it" match.
        $term = $_;
      }

      #  Rebuild the search string with the commas we're parsing on, in our foreach/split loop.
      if ($output eq "") {                 #  First term?  I.E. First time through?
        $output = $term;                   #  If so, it doesn't get a comma
      } else {                             #  Else separate this term from earlier ones with a
        $output = $output . "," . $term;   #  comma.  Note that we remove trailing spaces after
      }                                    #  the comma.  EG "A01,    B02" => "A01,B02"
    }       # End of foreach split ...

    # For the National Patent Offices, uncomment this line (4 of 4).
    # $output =~ s/ //g;
  }
  return $output;
} # filter_IC


# Filter input of US National Class
# Name: filter_NC
# Example Input: 084/174; 084/423.R, 084/DIG.022, D5,                084DIG23, AB*
#        Output: 084174,  084423R,   084DIG022,   (0D5???*,D05???*), 084DIG23, (AB????*,0AB???*)

# Note: This filter should not be used for national GB classes, the UKPO
# version of patsearch will only use this filter if only the US
# collection is being searched -sjb

sub filter_NC {
  my ($in_var_string) = @_;
  my ($output, $ls1, $ts1, $ls2, $ts2, $slash, $dot, $length, $first2chars,
      $part1, $part2, $part3, $part1b, $part2b, $term);

  $output = $in_var_string;       #  Default output to input in case some of these tests fail.

  # If there's any Verity keyword (and, or, not) or any kind of funny character in this
  # search string, don't modify is at all.  The idea is, if this guy knows what he's
  # doing by specifying a Verity special symbol (and ? <or>) in his search, we don't
  # want to get in his way (Carol's suggestion), or he's given us some junk, we'll
  # rely on Verity to fail on this search.
  if ( $in_var_string !~ /^[a-zA-Z\d\/\.,; \*]*$/ ||
       ($in_var_string =~ / and /i ) ||
       ($in_var_string =~ / or /i ) ||
       ($in_var_string =~ / not /i ) ) {
    $output = $in_var_string;            # Pass everything on untouched.
  } else {
    $in_var_string =~ tr?\*\*//\.\.??s;  #  Also eliminate repeated special characters, eg **

    # We want to accept multiple national class search arguments, which in the Verity
    # search language, are separated by commas or spaces (e.g. 084/423,432/436).
    # An improvement suggested by CHT is, because the detail page shows national
    # class separated by semicolons, somebody might "swipe" (cut & paste) that
    # semicolon-separated list (e.g. 084/423;084/432) and use it.  Thus, here we
    $in_var_string =~ s/;/,/g;          #  translate all semicolons into commas.

    $output="";                         #  Reset output to null 'cause we're gonna
    # split our input (the search argument) into separate, comma-delimited terms,
    # and iterate across all search terms, rebuilding our filtered output.
    foreach (split /,/, $in_var_string) {

      # Parse out the three parts of the National Class search argument,
      # 0-3 characters, delimited by an optional slash (/) with possible asterisks (*),
      # 0-3 characters, delimited by an optional comma (.) with possible asterisks (*),
      # and the rest.
      # If this term doesn't follow this syntax, then don't muck with it.
      if ( /^(\*?) ([a-zA-Z\d]{0,3}) (\*?) (\/?)    # First part
             (\*?) ([a-zA-Z\d]{0,3}) (\*?) (\.?)    # Second part
             ([\*a-zA-Z\d]*) $/x ) {                # Third part
        $ls1=($1 eq "*");         # True if there was a leading star on the first part.
        $part1=$2;
        $ts1=($3 eq "*");         # True if there was a trailing star on the first part.

        $slash=($4 eq "/");       # True if we found a slash.

        $ls2=($5 eq "*");         # True if there was a leading star on the second part.
        $part2=$6;
        $ts2=($7 eq "*");         # True if there was a trailing star on the second part.

        $dot=($8 eq ".");         # True if we found a period.

        $part3=$9;

        $length = length($part1);
        $first2chars = substr($part1,0,2);
        $part1b = "";

        #  Interpret part 1.  In the comments for these cases below,
        #      l = Any letter [A-Z]
        #      d = Any digit [0-9]
        #      c = Any character [A-Z0-9]
        #      D = The letter D or d
        #      0 = The digit zero
        #     () = Optional part
        NC_CASE1: {
          #  If nothing was specified for part1, make it ???.
          if ( $length == 0 ) {                    #  / or . or * or */ or *. ==> ???
            $part1 = "???";
            last NC_CASE1;
          }
          if ( $length == 1 && $ls1 && !$ts1) {    # *C/ ==> ??C
            $part1 = "??$part1";
            last NC_CASE1;
          }
          #  C* is a special case.  One could try to interpret this as a search for
          #  C?????* or 0C????* or 00C???*, but the C?????* guarantees that the
          #  search will fail since there are many words starting with any single
          #  character you choose.  So we're going to interpret this as the most
          #  restrictive, yet still plausible and guaranteed to at least work as
          #  far as Verity is concerned, 00C???*.  Again, if the user doesn't like
          #  the way we interpreted their search, they can use a different syntax.
          #
          #  So C* or C*/ is handled the same as C or C/, ignoring the trailing *.
          #  This may be counter-intuitive, but heck, searching for every National
          #  Class starting with a given single character, doesn't make sense.
          #  Or worse, *C*.
          #
          #  If the intent was that 3*/ would find 030-039/* and/or 300-399/*,
          #  you would need to specify 03?/ or 3??/.
          if ( $length == 1 ) {                    # C or C* or *C* ==> 00C
            $part1 = "00$part1";
            last NC_CASE1;
          }
          #  [Dd][0-9] (e.g. D5) is a very special case because these national classes
          #  are in the DB/2 database and Verity index in two different ways, 0D5 or D05.
          #  The simpliest case, D5, must be converted to 2 terms, D05 or 0D5.  Likewise,
          #  0D has to be converted to 0D? or D0?.  But to really complicate things,
          #  D5*/ might be expected to include D50-D59/ as well as D5, so that would
          #  have to be converted to 0D5???* or D05???* or D5????*.  Aaaaargh!  No, we
          #  only handle the simpliest two cases now.
          if ( $length == 2 && $first2chars=~"0([Dd])" && !$ls1 && !$ts1 ) {       # 0D => 0D? or D0?
            $part1 = "0$1?";
            $part1b = "${1}0?";
            last NC_CASE1;
          }
          if ( $length == 2 && $first2chars=~"([Dd])([0-9])" && !$ls1 && !$ts1 ) { # D5 => 0D5 or D05
            $part1 = "0$1$2";
            $part1b = "${1}0$2";
            last NC_CASE1;
          }
          if ( $length == 2 && $first2chars=~"([Dd])([0-9])" && $ls1 && !$ts1 ) {  # *D5 => ?D5 or D05
            /..(.)/;
            $part1 = "?$1$2";
            $part1b = "${1}0$2";
            last NC_CASE1;
          }
          if ( $length == 2 && $ls1 && !$ts1 ) {   # *CC ==> ?CC
            $part1 = "?$part1";
            last NC_CASE1;
          }
          if ( $length == 2 && !$ls1 && $ts1 ) {   # CC* ==> CC? or 0CC
            $part1b = "0$part1";
            $part1 = "$part1?";
            last NC_CASE1;
          }
          if ( $length == 2 ) {                    # CC or *CC* ==> 0CC
            $part1 = "0$part1";
            last NC_CASE1;
          }
          if ( $length == 3 && $first2chars=~"0([Dd])" && !$ls1 && !$ts1 ) {  # 0D5 => 0D5 or D05
            $part1b = "${1}0" . substr($part1,2,1);
            last NC_CASE1;
          }
          if ( $length == 3 && $first2chars=~"([Dd])0" && !$ls1 && !$ts1 ) {  # D05 => D05 or 0D5
            $part1b = "0$1" . substr($part1,2,1);
            last NC_CASE1;
          }
        }          #  End of NC_CASE1 block.

        $length = length($part2);
        $part2b = "";
        NC_CASE2: {
          #  If nothing was specified for part2, make it ???.
          if ( $length == 0 ) {                    #  /. or . or * or */ or *. ==> ???
            $part2 = "???";
            last NC_CASE2;
          }
          if ( $length == 1 && $ls2 && !$ts2) {    # *C ==> ??C
            $part2 = "??$part2";
            last NC_CASE2;
          }

          # A note on the C* case:  We expand C* to 00C* only, intentionally NOT expanding
          # it to include C??* and 0C?* for two reasons:  First, we don't expand C* like
          # that for our part1 above, so to be consistent, we don't for part2 as well.
          # Second, this is how we expand part2 in filter_IC so although the IC reason
          # does not apply here, to be consistent, we do the same expansion here.
          if ( $length == 1 ) {                    # C or C* or *C* ==> 00C
            $part2 = "00$part2";
            last NC_CASE2;
          }
          if ( $length == 2 && $ls2 && !$ts2 ) {   # *CC ==> ?CC
            $part2 = "?$part2";
            last NC_CASE2;
          }
          if ( $length == 2 && !$ls2 && $ts2 ) {   # CC* ==> CC? or 0CC
            $part2b = "0$part2";
            $part2 = "$part2?";
            last NC_CASE2;
          }
          if ( $length == 2 ) {                    # CC or *CC* ==> 0CC
            $part2 = "0$part2";
            last NC_CASE2;
          }
        }          #  End of NC_CASE2 block.

        #  The philosophy of whether or not to append an asterisk if part3 wasn't specified,
        #  is to do so if he has not asked for a specific class, which is easily identified
        #  by checking for wild card characters (?) in any of the first two parts.
        #  Thus, 123, which is interpreted as 123/*, gets an asterisk (123???*), but
        #  12/34 is a specific class, so doesn't (012/034).
        #  A later fix modified this statement to pick up the 1234* and 123456* cases,
        #  where our part2 was "004" and "456" respectively (note no ?'s), so we were
        #  dropping the trailing * (oops).  So now we include the check for $ts2.
        if ($part3 eq "" && (index($part1.$part1b.$part2.$part2b,"?")>=0 || $ts2) ) { $part3="*" }

        if ($part1b eq "" && $part2b eq "") {
          $term = sprintf '%03s%03s%s', $part1, $part2, $part3;
        } elsif ($part1b ne "" && $part2b eq "") {
          $term = sprintf '(%03s%03s%s,%03s%03s%s)', $part1,  $part2, $part3,
                                                     $part1b, $part2, $part3;
        } elsif ($part1b eq "" && $part2b ne "") {
          $term = sprintf '(%03s%03s%s,%03s%03s%s)', $part1, $part2,  $part3,
                                                     $part1, $part2b, $part3;
        } else {
          $term = sprintf '(%03s%03s%s,%03s%03s%s,%03s%03s%s,%03s%03s%s)', $part1,  $part2,  $part3,
                                                                           $part1b, $part2,  $part3,
                                                                           $part1,  $part2b, $part3,
                                                                           $part1b, $part2b, $part3;
        }
      } else {           # Else this term didn't match our "don't muck with it" match.
        $term = $_;
      }

      #  Rebuild the search string with the commas we're parsing on, in our foreach/split loop.
      #  Recombine all but the first term, with commas.  Note that we remove trailing spaces
      #  (if any) after the comma, EG "A/1, B/2" becomes "00A001,00B002".
      $output .= ($output ne "" ? "," : "").$term;
    }       # End of foreach split ...
  }       # End of else don't pass everything on untouched
  return $output;
}


# Filter "Unadorned" patent numbers (UP), which is (mostly) the full patent
# number without the country code, kind, or leading zeros (eg 5551212).
#
# This simple rule gets tweaked a bit when you talk about non-utility US
# patents (eg USRE028481__) or Italian patents, which have a 2-character
# city code (eg ITMI031377A0).  The upnumber zone has the imbedded zeros
# indexed (eg RE028481 and MI031377).
#
# Another tweak is for US Applications, Japanese patents, and 2004 and beyond
# WO patents, which get two forms indexed (eg, 21001149 and 20010001149) in
# the upnumber zone.
#
# One often finds publication numbers with slashes in them.  We try to allow
# these as input, filtering to what they should be.  The formats we handle
# are either 2- or 4-digit years, a slash, and either 6- or 7-digit numbers.
#
#     We Filter This => Into This
#     ==============    =================================
#     US2001/1149       (20010001149<or>1001149<or>101149
#     US5551212A1       5551212
#     USPP3987          PP003987
#     PP3987            PP003987
#     ITMI26A0          MI000026
#     ITMI26            MI000026     (Italian patent with City Code.     )
#     MI123456          MI123456     (Same thing, but some 2-letter, but )
#     US123456          123456       (prefixes are taken as country codes)
#     DE1234987         1234987      (Because 7-digits, not Italian city.)
#     2001/1149         (20010001149<or>1001149<or>101149)
#     04/123456         (20040123456<or>4123456)
#     04/1234567        20041234567
#
# One last note on this filter.  Like all the other filters, we do handle
# multiple terms, eg (US5551212A1,USPP3987,US2001/1149)<in>UP, but unlike all
# the other filters, we also accept spaces as term delimiters.  For example,
#         (uspp3987 d1234 itmi26 mi26 de000026 04/1234567)<in>UP
# becomes (pp003987,d0001234,mi000026,mi000026,26,20041234567)<in>UP
# Note how the spaces in our input, becomes commas!!  It's only this UP filter
# that can get away with replacing spaces with commas, because the UPNUMBER
# zone is always single words, unlike PN or IC where you might have C09D 123.
# It never makes sense to search for one UP followed by another.

sub filter_UP {
  my($in_var_string) = @_;

  # If there's any kind of "funny" character in this search string, don't modify it at all.
  return $in_var_string if (($in_var_string !~ /^[a-zA-Z\d\/_\?\*,\ ]*$/) ||
                     ($in_var_string =~ / and /i ) ||
                     ($in_var_string =~ / or /i ) ||
                     ($in_var_string =~ / not /i ) );

  my $output = "";
  my @pns = split(/[\ |,]/, $in_var_string);
  foreach my $pns (@pns) {
    if ($pns ne "") {
      my ($term_year, $term_num, $term_type, $term1, $term2, $term3);
      my $term = $pns;
      if ($pns =~ /\*/) {

      } elsif ($pns =~ /[A-Z]{0,2}((?:[0-9\?]{2})?[0-9\?]{2})\/0*([\d\?]{1,7})[A-Z_\?]*[0-9]*/i) {
        # Slash form with yyyy/ or yy/, and either with or without the CC and KI.
        # Drop the leading CC, the middle slash, & trailing kind, and pad the
        # middle digits to 5, 6, or 7 characters.
        #
           if (length($1)==2 && $1>60) {$term_year="19$1"}
        elsif (length($1)==2         ) {$term_year="20$1"}
        else                           {$term_year="$1"}
        $term_num=$2;

              if ($term_num<= 99999) {   # 1-5 Digits (yy/d yy/ddddd yyyy/d yyyy/ddddd).
          # Could be US App or 5-digit WO or 6-digit WO.  Filter to
          #   "(yyyy00nnnnn<or>yy0nnnnn<or>yynnnnn)" with leading zeros removed.
          $term1="$term_year" . "0" x (7 - length($term_num)) . "$term_num";
          $term2=substr($term_year,2) . "0" x (6 - length($term_num)) . $term_num;
          $term2=~s/^0*(.)/$1/;        # Strip all leading zeros.
          $term3=substr($term_year,2) . "0" x (5 - length($term_num)) . $term_num;
          $term3=~s/^0*(.)/$1/;        # Strip all leading zeros.

          $term = "($term1<or>$term2<or>$term3)";

        } elsif ($term_num<=999999) {    # 6 Digits (yy/dddddd or yyyy/dddddd).
          # Could be US App or 6-digit WO.  Filter to "(yyyy0dddddd<or>yydddddd)".
          $term1 = "${term_year}0$term_num";
          $term2 = substr($term_year,2) . $term_num;
          $term2=~s/^0*(.)/$1/;        # Strip all leading zeros.

          $term = "($term1<or>$term2)";

        } else {                            # 7 Digits (yy/ddddddd or yyyy/ddddddd).
          $term = "$term_year$term_num";    # Must be US App.  Filter to yyyyddddddd.
        }

      } elsif ($pns =~ /([I\?][T\?])([A-Z]{1,2})0*([\d\?]{1,11})([A-Z_\?]*[0-9]*)/ix) {
        # Some Italian pno12 and pno10 forms need an 8-char UP, for example,
        # ITMI26A0 or ITMI26 becomes MI000026, but don't touch IT89000210.
        # That gets handled below.
        $term = $3;
        $term = $2 . "0" x (8 - length($2) - length($term)) . $term;

      } elsif ($pns =~ /^([A-Z?]{2})([\d\?]{1,6})$/i) {
        # Catch good Italian UPs, eg LI000002, which is a perfectly good UP for
        # ITLI000002U1, but allow US, DE, EP, JP, and WO cases slip through 'cause
        # I know these aren't Italian city codes (ie ain't no ITUS*, ITDE* ITEP*, etc).
        my $city_code=$1;
        $term_num=$2;
        if ($city_code=~/(US|DE|EP|JP|WO)/i) { # Does city code look like a country code?
          $term = $term_num;                   # If so, filter to nnn with no leading zeros.
          $term=~s/^0*(.)/$1/;
        } else {                               # Filter apparent city codes to CC00nnnn.
          $term = $city_code . "0" x (6 - length($term_num)) . $term_num;
        }

      } elsif ($pns =~ /([A-Z\?]{0,2})([A-Z\?]{0,2})0*([\d\?]{1,11})([A-Z_\?]*[0-9]*)/i) {
        # Remove unwanted/unnecessary, leading or imbedded zeros.  Again, we allow & drop
        # leading CC and trailing kinds, so any of US00001244__, US00001244, US1244__,
        # US1244, 00001244__, 00001244, 1244__ all get filtered here to just 1244.
        # Also, our IT89000210 example from above gets filtered here to 89000210.
        #
        # We also special case the more common, US non-utility types (RE, PP, & D).  Any
        # of USPP000003987__, PP0003987__,  PP0000003987 all get filtered into PP003987.
        # (Thank goodness we don't have any Reunion patents.  Never heard of Reunion?
        # It's a French-owned island off of Africa, whose country code is RE.)
        $term_num = $3;
        if (($2 eq ""?$1:$2) =~ /^(RE|PP|D)$/i) {     # Is this a US patent type?
          $term = $1 . "0" x (8 - length($1) - length($term_num)) . $term_num;
        } else {                                      # Probably is a country code, then.
          $term = $term_num;                          # Drop country code & leading zeros.
          $term=~s/^0*(.)/$1/;
        }
      }
      $output .= ($output ne "" ? "," : "").$term;
    }
  }
  return $output;
}


# Normalize patent numbers.
#
#     We Filter This   => Into This
#     ================    ==================================================
#     US2003/0186395A1    (US20030186395A1<or>US003186395A1)
#     ??2003/100000A1     (??20030100000A1<or>??003100000A1)
#     wo2004/17056A1      (wo20040017056A1<or>wo00417056A1<or>wo04017056A1)
#     WO03/123456A2       WO03123456A2
#     WO03/12345A         (WO00312345A*<or>wo03012345A*)
#     wo03/000001234      (wo00301234*<or>wo03001234*)
#
# A note on searching for US Granted patents <in> PN.  The double-underscore
# kind, __, is considered by Verity to be punctuation and is not indexed, and
# when specified in a search term, is dropped.  So don't get confused when
# searching for US05551212<in>pn finds something, but wo03012345<in>pn, does not.
# Normally, you always need to provide a kind (eg wo03012345A1<in>pn).
#
sub filter_PN {
  my($in_var_string)    = @_;

  # If there's any kind of "funny" character in this search string, don't modify it at all.
  return $in_var_string if (($in_var_string !~ /^[a-zA-Z\d\/_\?\*,\ ]*$/) ||
                            ($in_var_string =~ / and /i ) ||
                            ($in_var_string =~ / or /i ) ||
                            ($in_var_string =~ / not /i ) );

  my $output = "";
  my @pns = split(/,+/, $in_var_string);
  foreach my $pns (@pns) {
    if ($pns ne "") {  # (so we ignore a trailing comma after the last number)
      my ($term_year, $term_num, $term_type, $term_CC);

      my $term = $pns;
      if ($pns =~ /\*/) {     # If there's an * in this search term, skip it.

      # US references, US Application images, or 2004 WO images show the publication
      # number like CC YYYY/nnnnn KK.  If that's what we got,  we'll filter it to
      # the US Application format of CCYYYY00nnnnnKK
      #    <or> the old WO format of CC0YYnnnnnKK (unless nnnnn>5 digits)
      #    <or> the new WO format of CCYY0nnnnnKK (unless nnnnn>6 digits)
      } elsif ($pns =~ /([A-Z\?]{2})([0-9\?]{4})\/([\d\?]{1,11})([A-Z_\?]*[0-9]*)/i) {
        my ($term_yy);
        $term_CC=$1;              # EG, WO
        $term_year=$2;            # and yyyy
        $term_num=$3+0;           # and 1234  (The +0 strips leading zeros)
        $term_type=$4;            # and A1
        $term_yy=substr($term_year,2);
        $term_type.="*" if (length($term_type)<2);     # If A, now A*.  If null, now *.

        if (length($term_num)<6) {        # Numeric portion is 1-5 digits long.
          $term = "$term_CC$term_year" . "0" x (7 - length($term_num)) . "$term_num$term_type" .
                  "<or>${term_CC}0$term_yy" . "0" x (5 - length($term_num)) . "$term_num$term_type" .
                  "<or>$term_CC$term_yy" . "0" x (6 - length($term_num)) . "$term_num$term_type";

        } elsif (length($term_num)<7) {   # Numeric portion is 6 digits long.
          $term = "$term_CC$term_year" . "0" x (7 - length($term_num)) . "$term_num$term_type" .
                  "<or>${term_CC}0$term_yy" . "0" x (5 - length($term_num)) . "$term_num$term_type";
        }
        # Else Numeric portion is 7+ digits long.  Don't know what this is, so don't filter.

      # On the other hand, sometimes WO images show only two digits in the year.
      # But since those 2 yy digits could be in two different places, we need
      # to filter from WOyy/1234A1 to (WO0yy01234A1<or>WOyy001234A1).
      # (Is it inconsistent that we don't allow US Apps to have 2-digit years?  Tough.)
      } elsif ($pns =~ /([A-Z\?]{2})([0-9\?]{2})\/([\d\?]{1,11})([A-Z_\?]*[0-9]*)/i) {
        $term_CC=$1;              # EG, WO
        $term_year=$2;            # and yy (and i don't care if it's <2000 or not)
        $term_num=$3+0;           # and 1234  (The +0 strips leading zeros)
        $term_type=$4;            # and A1
        $term_type.="*" if (length($term_type)<2);     # If A, now A*.  If null, now *.

        if ($term_num>99999) {        # Already 6 digits.  Don't have to pad.
          if ($term_num<=999999) {    # But not greater than 6 digits.
            $term = "$term_CC$term_year$term_num$term_type";
          }

          # Else the Numeric portion is too long.  Don't know what this is, so don't filter.

        } else {                      # 5-digits or less.  Need to pad into both forms.
          my ($term1, $term2);
          $term1 = "${term_CC}0$term_year" . "0" x (5 - length($term_num)) . "$term_num$term_type";
          $term2 = "$term_CC$term_year" . "0" x (6 - length($term_num)) . "$term_num$term_type";
          $term = "($term1<or>$term2)";
        }

      # This filters USD123        or USD123__       or USPP123_       or WO123A
      #         into USD0000123*   or USD0000123__   or USPP000123_*   or WO00000123A*
      } elsif ($pns =~ /([A-Z\?]{2})([A-Z\?]{0,2})([\d\?]{1,11})([A-Z_\?]*[0-9]*)/ix) {
        $term = $1 . $2 . "0" x (8 - length($2) - length($3)) . $3. $4. (length($4)==2?"":"*");
      }
      $output .= ($output ne "" ? "," : "").$term;
    }
  }
  return $output;
}


# -----------------------------------------------------------------------------------
# Function to ensure that only one version of a collection pair is present, in the
# set being searched, and that it's the fulltext version if we have a fulltext
# zone mentioned.  It takes a pair of collections names, e.g. "epa","eapft" as
# input, and returns a 1 if either of that pair should be searched.
# -----------------------------------------------------------------------------------
sub coll_test_and_upgrade {
  my ($plain, $ft) = @_;
  my $ft_index = $coll_index{$ft};
  my $plain_index = $coll_index{$plain};
  my $have_it = 0;
  if ( $plain_index >= 0 ) {  # plain version
    $have_it = 1;
    if ( $ft_index >= 0 ) {  # fulltext version too
      $coll_index{$plain} = -1;  # remove plain one
    } else {  # only plain, upgrade if needed
      if ($fulltext_field) {
        $coll_index{$plain} = -1;
        $coll_index{$ft} = 1;
      }
    }
  } elsif ( $ft_index >= 0 ) {  # only fulltext version
    $have_it = 1;
  }
  return $have_it;
} # End of coll_test_and_upgrade


# "redir" handling of output placed in a db2 hitlist (taken from dofilter)
# (There used to be inactive SSI code in here.  cht removed it 6/30/00.
#  If anyone wants to see it, ask cht for an archive copy.)
sub redirOutputFilter
{
  # (The following httppost command was done above, for all modes.)
  #  system "$httppost -g \"$url_to_call?\" $qsfilename $response_html >$response_http;" ;
  my $PQ_REDIR_URL = "";
  open(IN, $response_html) ;
  while(<IN>) {
    $PQ_REDIR_URL .= $_;
  }
  close(IN);

  # Done with all temp files
  unlink ($qsfilename, $response_html, $response_http) unless ($fcgi_mode || $debug);

  # Eat HTTP Header: lines - we'll create our own
  $PQ_REDIR_URL =~ s/HTTP Header: .*\n//g;

  # Force flush after every write
  select(STDOUT); $| = 1;

  # Tease-out the Net.data URL from the HTML redirect
  $PQ_REDIR_URL =~ s/.*URL=(.*)\".*/$1/g;
  chomp $PQ_REDIR_URL; # Eat any newlines

  if ($PQ_REDIR_URL eq "") {
    my $get_stdout=get("http://localhost/messages/500error.html");
    die "Call to get() for 500error.html failed.\n" if (!defined($get_stdout));
    $get_stdout=~s/^HTTP Header:.*\n//g;
    print STDOUT "Content-type: text/html\n\n";
    print STDOUT $get_stdout;
  } else {
    # Pass language if passed to us originally
    # $PQ_REDIR_URL .= "$langarg";   breaks net commerce
    print STDOUT "Final redir url is: $PQ_REDIR_URL\n" if ($debug);

    # cluster.d2w needs cookie info to make time tracking call
    $PQ_REDIR_URL .= "&HTTP_COOKIE=" . url_encode($cookie);
    # Get a Net.Data-generated hitlist (or a cluster ...), eating any HTTP headers.
    # (We depend on this url being shorter than 2048 -- there is no query in it, just
    #  a pool table and database and timestamp.)
    my $get_stdout=get("$PQ_REDIR_URL");
    if (defined($get_stdout)) {
      $get_stdout=~s/^HTTP Header:.*\n//g;
      print STDOUT "Content-type: text/html\n\n";
      print STDOUT $get_stdout;
    } else {
      # Not supposed to happen!!
      warn "$patsearch: call to get() for $PQ_REDIR_URL failed.\n";
      OutputUnauthorized();  # May not be right, but, better than blank!
    }
  }
} # redirOutputFilter


#------- Produce a site header ------
# Input:  Text for the title tag
# Output: none
#
sub OutputHeader
{
  my($in_var, $type) = @_;
  my $html = $template{'header'};

  my $head = "<HTML>\n<HEAD>\n<TITLE>$in_var</TITLE>\n";
  if ($type eq "error") {
    $head .= qq!<LINK REL="STYLESHEET" TYPE="text/css" HREF="/style/IPNstyle.css">\n!;
  }
  else {
    $head .=<<EOF
<STYLE TYPE="text/css">
<!--
.formstyle {font-family:Verdana, Arial, Helvetica, sans-serif; font-size: 70%; color:#000000}
a.globalnav:link { font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; color: #000000; text-decoration: none}
a.globalnav:visited { font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; color: #000000; text-decoration: none}
img.framed {border-width: thin; border-style: dashed; border-color: #CCCCCC; margin: 7px 2px 2px 2px;}
.rowhls TD, rowhls TR {font-family:Verdana, Arial, Helvetica, sans-serif; font-size: 80%; color:#000000; background-color: #DEFFFF;}
.rowhl TD {font-family:Verdana, Arial, Helvetica, sans-serif; font-size: 80%; color:#000000}
-->
</STYLE>
EOF
;
  }

  # If Hoovers set -l=hoovers, cookie the user for NC revenue tracking
  if ($lval eq "hoovers") {
    $head .= qq!<SCRIPT LANGUAGE="Javascript">\n!;
    $head .= "<!--\n";
    $head .= "document.cookie='REFERRAL=Hoovers; path=/; domain=.delphion.com';\n";
    $head .= "//-->\n";
    $head .= "</SCRIPT>\n";
  }

  print STDOUT "$head";
  # Since server side include processing does not work in our world, we
  # need to emulate the following:
  # $head .= qq!<!--#include virtual="$header_file"-->!;
  # This is made outrageously complicated by the fact that there are server
  # side variables which are set in this header, from environment variables
  # as well as directly, which are then either used later in the
  # header/trailer/ad world, or, which we need the values of (like colors).
  # Anyway, we get our colors from the request environment, or failing that, from the
  # header file, or failing that, we use our defaults.
  # Note that the whole BGCOLOR phrase is in the environment, or the header
  # variables (and it is conceivable that someone could slip in other
  # phrases someday, so, we are going to have to follow along with
  # this "architecture").
  # (We grabbed the header default colors when we initially read the header file.)
  # So, we massage the header file template here, processing, substituting for the
  # netdata variable $(nchostu) the current real value.
  $body_color = $ENV{'BODY_COLOR'}; $body_color = $header_body_color unless $body_color;
  $left_color = $ENV{'LEFT_COLOR'}; $left_color = $header_left_color unless $left_color;
  $showsort_color = $ENV{'SHOWSORT_COLOR'}; $showsort_color = $header_showsort_color unless $showsort_color;
  $html =~ s/\$\(nchostu\)/$nchost/g;
  print STDOUT $html;

  $head  = qq!\n<TABLE CELLPADDING="0" CELLSPACING="0" WIDTH="100%" BORDER="0">!;
  $head .= "<TR><TD $body_color>\n";
  print STDOUT "$head";
  $info{'bodyColor'}=$body_color;
} # OutputHeader


#------- Produce a site trailer ------
# Input:  none
# Output: none
#
sub OutputTrailer
{
  print STDOUT $template{'trailer'};
} # OutputTrailer


#------- Produce an unauthorized page ------
# Input:  none
# Output: none
#
sub OutputUnauthorized
{
  my $ou_message = "You do not seem to be authorized for this operation";
  my ($in_arg) = @_;
  if ($in_arg) {
    $ou_message = $in_arg;
  }
  select(STDOUT); $| = 1;
  print STDOUT "Content-type: text/html\n\n";
  OutputHeader("Not Authorized","error");
  print STDOUT $debugfromenv if ($debug);
  my $tail = "<br /><br />";
  $tail .= qq!<TABLE CELLPADDING="0" CELLSPACING="0" BORDER="0" WIDTH="766">\n!;
  $tail .= qq! <TR><TD WIDTH="20%">&nbsp;</TD><TD>\n!;
  $tail .= "<CENTER><STRONG>";
  $tail .= $ou_message;
  $tail .= "</STRONG></CENTER>\n";
  $tail .= "<br />To continue, please choose one of the IP Search items ";
  $tail .= "or use your browser's Back button.\n";
  $tail .= "<P>\n";
  $tail .= $txt_contact_support;
  $tail .= "<br /><br />\n";
  $tail .= qq! </TD><TD WIDTH="20%">&nbsp;</TD></TR>\n!;
  $tail .= "</TABLE>\n";
  $tail .= "</TD></TR></TABLE>\n";  # end the table started by OutputHeader()
  print STDOUT $tail;
  OutputTrailer();
} # OutputUnauthorized

#------- Produce a 401 return page ------
# Input:  none
# Output: none
#
sub OutputXML401
{
  select(STDOUT); $| = 1;
  print STDOUT "Content-type: text/xml\n\n";
  print STDOUT "<searchresults version=\"1.0\"><error>401</error></searchresults>\n"
} # OutputXML401


#------- Put commas into a number ------
# Input:  a string with the number
# Output: a string with the commified number
#
sub commify
{
  my $out = reverse $_[0];
  $out =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $out;
} # commify


#------- Turn a canonical ICL into a readable one ------
# Input:  the db2 form of an icl, usually A99A 99999
# Output: the readable form, e.g. A99A 999/99
#
sub FormatICL
{
  my($out) = @_;
  my ($p1, $p2, $p3);
  if ($out =~ /(.... )(...)(.*)/) {
    $p1 = $1; $p2 = $2; $p3 = $3;
    $p2 =~ /0?0?(.*)/;
    $out = "$p1$1/$p3";
  }
  return $out;
} # FormatICL

#------- Environment needed to connect to Delphion db2 ------
sub setupDB2 {
  if (!defined($ENV{DB2INSTANCE})) {
    # DB2INSTANCE should always be defined, but use Southbury value, just in case
    $ENV{DB2INSTANCE}="caeadmin";
  }
  $ENV{DB2DIR}="/home/inst1/sqllib";
  $ENV{INSTHOME}="/home/inst1";
  $ENV{PATH}.=":/home/inst1/sqllib/bin:/home/inst1/sqllib/adm:/home/inst1/sqllib/misc";
  $ENV{LD_LIBRARY_PATH}.=":/home/inst1/sqllib/lib";
}

#------- Subroutine to connect to a Delphion db and prepare our stmts ------
sub connectDB2  {
  $db2h = DBI->connect("dbi:DB2:$PQDATABASE", $PQUSERID, $PQPW, 'DB2');
  if ($db2h) {
    my $db2stmt = qq{ select image_pages, drawing from inst1.imag where patn=? and image_pages is not null for fetch only};
    $db2sth = $db2h->prepare($db2stmt);
    warn "Could not prepare the imag select\n", $db2h->errstr if (!$db2sth);

    my $statstmt = qq{ select attr_value, attr_name from inst1.ipndb_attr for fetch only };
    $statsth = $db2h->prepare($statstmt);
    warn "Could not prepare the dbstatus select\n", $db2h->errstr if (!$statsth);

    my $db2dsrc = "select patn, datasrc from inst1.main where patn in ";
    my $db2imag = "select patn, image_pages, drawing, cdlabel from inst1.imag where image_pages is not null and patn in ";
    my $db2age = "select (days(current date) - days(max(isd))) from inst1.main where patn=? for fetch only";
    my $db2dwtitle = "select f.patn, f.pan, m.title from inst1.dw_family f, inst1.dw_main m where f.pan = m.pan and f.patn in ";
    my $db2invt = "select patn, datasrc, nam, num from inst1.invt where (patn, datasrc) in ";
    my $idx = 0;
    my ($liststr, $list2str);
    while ($idx < QueryInListCt) {$liststr .= "?,"; $idx++;}
    chop($liststr);
    $idx = 0;
    while ($idx < QueryInListCt) {$list2str .= "((CAST (? AS CHAR(12))), (CAST (? AS CHAR(3)))),"; $idx++;}
    chop($list2str);
    $db2dsrc .= "(" . $liststr . ") order by patn, datasrc for fetch only";
    $db2imag .= "(" . $liststr . ") order by patn for fetch only";
    $db2dwtitle .= "(" . $liststr . ") order by f.patn for fetch only";
    $db2invt .= "(values" . $list2str . ") order by patn, datasrc, num for fetch only";
    $db2dsrch = $db2h->prepare($db2dsrc);
    warn "Could not prepare the datasrc select\n", $db2h->errstr if (!$db2dsrch);
    $db2imagh = $db2h->prepare($db2imag);
    warn "Could not prepare the image_pages select\n", $db2h->errstr if (!$db2imagh);
    $db2ageh = $db2h->prepare($db2age);
    warn "Could not prepare the age select\n", $db2h->errstr if (!$db2ageh);
    $db2dwtitleh =  $db2h->prepare($db2dwtitle);
    warn "Could not prepare the age select\n", $db2h->errstr if (!$db2dwtitleh);
    $db2invth =  $db2h->prepare($db2invt);
    warn "Could not prepare the inventor select\n", $db2h->errstr if (!$db2invth);
  } else {
    warn "Patsearch could not db2 connect to dbi:DB2:$PQDATABASE, $PQUSERID, $PQPW, 'DB2'\n", $DBI::errstr;
  }
} # connectDB2

sub getDatasrc(\%)
{
   my $phash = $_[0];
   my ($rowct, $parmct) = (0,0);
   my $phash_size = scalar keys %$phash;

   foreach my $patn (keys %$phash) {
      $rowct++;
      $parmct++;
      unless($db2dsrch->bind_param($parmct, $patn)) {warn "bind_param failure for data source query, patn=$patn"; return;}
      if ($parmct == QueryInListCt || $rowct == $phash_size) {
         for (my $i = 0, my $itct = QueryInListCt - $parmct; $i < $itct; $i++) {
            unless($db2dsrch->bind_param($parmct + $i + 1, "XXX")) {warn "bind_param failure for data source query, patn=XXX"; return;}
         }
         $parmct = 0;
         unless($db2dsrch->execute()) {warn "execute failure for data source query " . $db2h->errstr; return;}
         my ($fetch_patn, $fetch_datasrc, $curr_patn, $curr_datasrc);
         unless($db2dsrch->bind_columns(\$fetch_patn, \$fetch_datasrc)) {warn "bind_columns failed for getDatasrc"; return;}
         while($db2dsrch->fetch()) {
           trim($fetch_patn, $fetch_datasrc);
           if ($curr_patn ne $fetch_patn) {
              if ($curr_patn) {
                 $$phash{$curr_patn}[PnhashDatasrc] = $curr_datasrc;
              }
              $curr_patn = $fetch_patn;
              $curr_datasrc = $fetch_datasrc;
           }
           elsif ($fetch_datasrc ne "IFD") {
              $curr_datasrc =  $fetch_datasrc;
           }
         }
         if ($fetch_patn) {
            $$phash{$curr_patn}[PnhashDatasrc] = $curr_datasrc;
         }
      }
   }
} # getDatasrc

sub getImagePages(\%)
{
   my $phash = $_[0];
   my ($rowct, $parmct) = (0,0);
   my $phash_size = scalar keys %$phash;

   foreach my $patn (keys %$phash) {
      $rowct++;
      $parmct++;
      $$phash{$patn}[PnhashQueryTps] = 1;
      unless($db2imagh->bind_param($parmct, $patn)) {warn "bind_param failure for image page query, patn=$patn"; return;}
      if ($parmct == QueryInListCt || $rowct == $phash_size) {
         for (my $i = 0, my $itct = QueryInListCt - $parmct; $i < $itct; $i++) {
            unless($db2imagh->bind_param($parmct + $i + 1, "XXX")) {warn "bind_param failure for image page query, patn=XXX"; return;}
         }
         $parmct = 0;
         unless($db2imagh->execute()) {warn "execute failure for image page query " . $db2h->errstr; return;}
         my ($fetch_patn, $fetch_image_pages, $fetch_drawing, $curr_patn, $cdlabel);
         unless($db2imagh->bind_columns(\$fetch_patn, \$fetch_image_pages, \$fetch_drawing, \$cdlabel)) {warn "bind_columns failed for getImagePages"; return;}
         while($db2imagh->fetch()) {
           trim($fetch_patn);
           trim($cdlabel);
           if ($curr_patn ne $fetch_patn) {
              if ($cdlabel) {
                # This treats drawing=0 like drawing=NULL
                if ($fetch_image_pages) {$$phash{$fetch_patn}[PnhashImagePages] = $fetch_image_pages;}
                if ($fetch_drawing) {$$phash{$fetch_patn}[PnhashDrawing] = $fetch_drawing;}
                $$phash{$fetch_patn}[PnhashQueryTps] = 0;

                if ($cdlabel eq 'TPS') {
                  $$phash{$fetch_patn}[PnhashIsOnTps] = 1;
                }
              }
              $curr_patn = $fetch_patn;
           }
         }
      }
   }
} # getImagePages

sub getInventor(\%)
{
   # Must call getDatasrc before this
   my $phash = $_[0];
   my ($rowct, $parmct) = (0,0);
   my $phash_size = scalar keys %$phash;
   my $locQueryInListCt = QueryInListCt;

   foreach my $patn (keys %$phash) {
      $rowct++;
      $parmct++;
      unless($db2invth->bind_param(2 * $parmct - 1, $patn)) {warn "bind_param failure for inventor query, patn=$patn"; return;}
      unless($db2invth->bind_param(2 * $parmct, $$phash{$patn}[PnhashDatasrc])) {warn "bind_param failure for inventor query, patn=
$patn"; return;}
      if ($parmct == $locQueryInListCt || $rowct == $phash_size) {
         for (my $i = 0, my $itct = $locQueryInListCt - $parmct; $i < $itct; $i++) {
            unless($db2invth->bind_param(($parmct + $i + 1) * 2 - 1, "XXXXXXXXXXXX")) {warn "bind_param failure for inventor query,
 patn=XXX"; return;}
            unless($db2invth->bind_param(($parmct + $i + 1) * 2, "XXX")) {warn "bind_param failure for inventor query, patn=XXX"; r
eturn;}
         }
         $parmct = 0;
         unless($db2invth->execute()) {warn "execute failure for inventor query " . $db2h->errstr; return;}
         my ($fetch_patn, $fetch_datasrc, $fetch_nam, $fetch_num, $curr_patn, $curr_datasrc);
         unless($db2invth->bind_columns(\$fetch_patn, \$fetch_datasrc, \$fetch_nam, \$fetch_num)) {warn "bind_columns failed for ge
tInventor"; return;}
         while($db2invth->fetch()) {
             trim($fetch_patn);
             if ($$phash{$fetch_patn}[PnhashInventor]) {$$phash{$fetch_patn}[PnhashInventor] .= "; $fetch_nam";}
             else {$$phash{$fetch_patn}[PnhashInventor] = $fetch_nam;}
         }
      }
   }
}
sub getDerwentTitle(\%)
{
   my $phash = $_[0];
   my ($rowct, $parmct) = (0,0);
   my $phash_size = scalar keys %$phash;

   $parmct = 0;
   foreach my $patn (keys %$phash) {
      $rowct++;
      $parmct++;
      unless($db2dwtitleh->bind_param($parmct, $patn)) {warn "bind_param failure for derwent title query, patn=$patn"; return;}
      if ($parmct == QueryInListCt || $rowct == $phash_size) {
         for (my $i = 0, my $itct = QueryInListCt - $parmct; $i < $itct; $i++) {
            unless($db2dwtitleh->bind_param($parmct + $i + 1, "XXX")) {warn "bind_param failure for derwent title query, patn=XXX"; return;}
         }
         $parmct = 0;
         unless($db2dwtitleh->execute()) {warn "execute failure for derwent title query " . $db2h->errstr; return;}
         my ($fetch_patn, $pan, $title);
         unless($db2dwtitleh->bind_columns(\$fetch_patn, \$pan, \$title)) {warn "bind_columns failed for derwent title"; return;}
         while ($db2dwtitleh->fetch()) {
           trim($fetch_patn);
           trim($pan);
           $$phash{$fetch_patn}[PnhashDwPan] = $pan;
           # Derwent had old (pre 1998) markup in titles using @ = get rid of these
           $title =~ s/[=]/ /g;
           $title =~ s/[@]//g;
           $$phash{$fetch_patn}[PnhashDwTitle] = $title;
           undef $pan;
           undef $title;
         }
      }
   }
}

sub getAge($)
{
  my ($pn) = @_;
  my $defaultdays = 100;  # default is to pretend the patent is oldish
  my ($days, $ok);

  if ($db2h && $db2ageh) {
    unless ($db2ageh->bind_param(1, $pn, $DBI::SQL_CHAR)) {
      warn "$patsearch($$): bind_param failure for age query\n", $db2h->errstr;
      return $defaultdays;
    }
    $ok = $db2ageh->execute();
    if ($ok) {
      $db2ageh->bind_col(1, \$days);
      $db2ageh->fetch();
    } else {
      warn "$patsearch($$): execute failure for age query on $pn\n", $db2h->errstr;
    }
    $db2ageh->finish();
  }
  return defined($days) ? $days : $defaultdays;
} # getAge

#------- Subroutine used by g1OutputFilter to read the first three lines returned by
#------- patquery, and set these global variables based on them
#        (This section should be moved to inside of g1OutputFilter.)
my ($query, $hits, $other, @qstats, $merged, $retrieved, $processed, $collections, @colls,
    $startrow, $rows, $sortcol, $sortasc, @fields, $rc, $errormsg,
    @dbinfo, $table_name, $db_name, $time_stamp);

my $txt_patmsg1 = "$patsearch did not receive enough data from the patquery tunnel";

sub Parse3HeaderLines
{
  open(IN, "$response_html");
  chop($query = <IN>);
  chop($hits = <IN>);
  chop($other = <IN>);
  close(IN);

  if ($other eq "") {  # Things are not right
    print STDERR "$txt_patmsg1\n";
    return 1;
  }

  @qstats = split(/\t/,$hits);
  $merged = "$qstats[0]";
  $retrieved = "$qstats[1]";
  $processed = "$qstats[2]";
  $startrow = "$qstats[3]";
  $rows = "$qstats[4]";
  $sortcol = "$qstats[5]";
  $sortasc = "$qstats[6]";
  my $fieldstr = $qstats[7];
  $fieldstr =~ s/\ +$//;  # strip trailing blanks
  @fields = split(/\ +/, $fieldstr);
  @dbinfo = split(/\t/, $other);
  $table_name = "$dbinfo[0]";
  $db_name = "$dbinfo[1]";
  $time_stamp = "$dbinfo[2]";
  $collections = "$dbinfo[3]";
  $collections =~ s/\ +$//;  # strip trailing blanks
  @colls = split(/ /, $collections);
  $rc = "$dbinfo[4]";
  $errormsg = "$dbinfo[5]";
  return 0;
} # Parse3HeaderLines


# Output-filter between Verity (Patquery) and HTML
# (History at the bottom of the file)
# -----------------------------------------------
#
# expects the name of the file containing what patquery sent back in
# $response_html, and the query posted to patquery in $SINPUT

sub g1OutputFilter
{
  use strict 'vars';
  # Declare (some of) our variables up top here, including our multi-language ones
  my ($blankTDSpan,$dataSpan,$nonblankTDSpan,$orderBox);
  my ($query_html,$endrow,$collstr,$sortname,$sortoname);
  my ($curcol,$desc_img,$asc_img,$anch_head);
  my $maxdocs = 500;  # furthest a user can scroll; get from environment variable??
  my $wisdomain_maxdocs = 20000;  # Max number to request on wisdomain button
  my $cluster_maxdocs = 20000;  # Max number to request on cluster button
  my $snapshot_maxdocs = 20000;  # Max number to request on snapshot button
  my %selected = ();
  select(STDOUT); $| = 1;  # Force flush after every write
  print STDOUT "Content-type: text/html\n\n";

  if (-z $response_html) {
    # no output file returned, try one more time if not localhost
    if ($default_verity_server !~ "localhost") {
      print STDERR "patsearch httppost retried\n";
      sleep 1;  # give a dead patquery time to restart
      system "$httppost $httppost_mode \"$url_to_call?\" $qsfilename $response_html >$response_http;" ;
    }
    if (-z $response_html) {  # give up
      chop(my $ts = `date +%T`);
      print STDERR "$ts: patsearch httppost returned no data\n";
      print STDOUT "No response from search server; please try later";
      print STDOUT "<BR>SINPUT: |$SINPUT|" if ($debug);
      return;
    }
  }

  if ($debug > 1) {
    print STDOUT "\n<BR>SINPUT: |$SINPUT|";
    print STDOUT "\n<BR>SARRAY: |", %SARRAY, "|\n";
  }

  my $have_images = "EP US WO CH GB FI";
  my ($image_pages, $drawing);

  # Set "what features the user sees" controlling variables
  my ($refine_query, $save_search, $dofastbuy, $dopinkdots, $orderbox_at_bottom,
      $show_sort_arrows, $show_field_choice, $scrolling_controls,
      $printer_friendly_button);
  if (!$pf) {  # normal
    $refine_query = 1;
    $save_search = 1;
    $dofastbuy = 1;
    $dopinkdots = 1;
    $orderbox_at_bottom = 1;
    $show_sort_arrows = 1;
    $show_field_choice = 1;
    $scrolling_controls = 1;
    $printer_friendly_button = 1;
  } else {  # printer friendly
    $refine_query = 0;
    $save_search = 0;
    $dopinkdots = 1;
    $orderbox_at_bottom = 0;
    $show_sort_arrows = 0;
    $show_field_choice = 0;
    $scrolling_controls = 0;
    $printer_friendly_button = 0;
  }

  my $date_format = "us";  # "ymd" is only other choice now, and we get ymd
  my $GETPOST = ($debug)?"GET":"POST";

  if ($nchost =~ /:/) {
    # we already have a complete url for the netcommerce host
  } else {
    if ($server =~ "penguin") {  # is this still necessary? (yes 6/30/00)
      $nchost = "bear" if (!defined($nchost));
      $nchost = "https://$nchost.delphion.com";
    } else {
      $nchost = "www2" if (!defined($nchost));
      $nchost = "https://$nchost.delphion.com";
    }
  }
  my $details_url = "/details?pn=";
  my $details_url_derwent = "/derwent/p/dwdetails?pan=";
  my $details_url_ipcom = "http://$server:8080/db2xml/servlet/DB2XMLServlet?mode=ipcomdetails&pubid=";
  my $order_cmd = "$nchost/cgi-bin/ncommerce3/IPNAddItems";
  # my $order_cmd https://bear.delphion.com/cgi-bin/ncommerce3/ExecMacro/IPN/IPNlistprod.d2w/report";

  my $pink_url =  "/lb";
  my $pinkdbm = "/dfs/.rw/ipnlistings/lblistings";

  # patquery's -g 1 cgi mode returns:
  # line1: the query
  # line2: merged retrieved processed startrow rows sortcol sortasc field-name-list  (tab separated)
  # line3: db2tablename dbname timestamp collections rc errormsgs (all tab separated)
  # line4-: tab separated fields (score, patn, date, title, by default)

  # default sortcols are: score=1 patn=2 date=3 title=4
  # sortasc is 1 (TRUE) for ascending, 0 for descending

  # We now parse these first 3 header lines into global variables, checking for disasters
  # in communicating to the search server, or, a sick search server
  if ( Parse3HeaderLines() != 0 ||
       ($processed == 0 &&
        !($rc == -40 || $rc == 11 || $rc == 111)) ) {  # Our search server is probably sick
    my $still_bad = 0;

    if ($rc == -2 ) {  # Check for unknown collection
      foreach my $coll (@colls) {
        $coll = basename($coll);
        $still_bad = 2 if (!defined($colldesc{$coll}));
      }
    }

    if ($still_bad == 0 && $rc != 1) {
      # wait a little while, and retry this same query
      sleep 2;
      system "$httppost $httppost_mode \"$url_to_call?\" $qsfilename $response_html >$response_http;" ;
      if (-z $response_html) {  # this is totally hopeless, give up
        $still_bad = 1;
      } else { # process the new resulting header lines
        if ( Parse3HeaderLines() != 0 || $processed == 0) {
          $still_bad = 1;
        }
      }
    }

    if ($still_bad) {
      my $hdr = ($still_bad == 1) ? "Search server unavailable" : "Bad Collection";
      OutputHeader($hdr,"error");  # ("error" says use site the style sheet)
      print STDOUT $debugfromenv if ($debug);
      # This is so dumb that we can't put out plain text, but must make a nested table!
      my $tail = "<BR><BR>";
      $tail .= qq!<TABLE CELLPADDING="0" CELLSPACING="0" BORDER="0" WIDTH="766">\n!;
      $tail .= qq! <TR><TD WIDTH="20%">&nbsp;</TD><TD>\n!;
      $tail .= ($still_bad == 1) ? $txt_sick_server : $txt_bad_collection;
      $tail .= "<P>\n";
      $tail .= $txt_contact_support;
      $tail .= "<BR><BR>\n";
      $tail .= qq! </TD><TD WIDTH="20%">&nbsp;</TD></TR>\n!;
      $tail .= "</TABLE>\n";
      $tail .= "</TD></TR></TABLE>\n";  # end the table started by OutputHeader()
      print STDOUT $tail;
      OutputTrailer();
      $fcgi_requests += 100;  # lose 100 lives, something which should have worked didn't
      return;
    }
  }
  $query_html = minimal_htmlencode($query);

  $endrow = $startrow - 1 + $rows;
  if ($maxdocs > $retrieved) {
    $maxdocs = $retrieved;
  }
  $save_search = 0 if ($rc != 0);
  $appName="currentResults" if ($retrieved == 0);  # Stay on this tab if 0 results

  #------- Set some variables needed to create the hitlist table -------
  my $derwent = ($collections =~ /der(went|demo)/ix) ? 1 : 0;
  my $ipcom = ($collections =~ /ipcom/) ? 1 : 0;
  # Derwent and IPCOM details use different link URLs
  $details_url = $details_url_derwent if ($derwent);
  $details_url = $details_url_ipcom if ($ipcom);

  $collstr = "";
  foreach my $coll (@colls) {
    $coll = basename($coll);
    if (defined($colldesc{$coll})) {
      $collstr .= $colldesc{$coll}.", ";
    } else {
      $collstr .= "Unknown, " if ( index( $coll, "inpa" ) == -1 );
    }
  }
  $collstr = substr($collstr, 0, length($collstr)-2);  # remove last ,

  $sortname = ($sortcol-1 <= $#fields) ? $fields[$sortcol-1] : "SCORE";
  $sortoname = ($sortasc) ? "-$sortname" : $sortname;

  # Some columns are treated specially -- we need to know which they are
  # so, set up a hash (indicating which columns the user will see).
  undef %col_pos;
  $curcol = 0;
  foreach my $col (@fields) {
    $curcol++;
    $col_pos{$col} = $curcol;
  }
  #------- Now, set up to read the rest of the lines, with the hitlist data ------
  # open(IN, "tail +4 $response_html | sed -f $IPNROOT/cgi-bin/text_filter.sed |");
  open(IN, "$response_html");
  my $lct = 0;
  my %pnhash;

  while ($lct < HeaderLineCt && <IN>) {$lct++;}
  my $hitlist_start = tell IN;
  # load patent numbers into hash
  while (<IN>) {
      chop;
      s/\t\t$/\t \t/;  # in case the last element is empty
      split(/\t/);
      $pnhash{$_[$col_pos{"VDKVGWKEY"} - 1]} = (); # Array, eventually has items with indexes defined by constants Pnhash??
  }

  seek(IN, $hitlist_start, 0);

  # getUserLists() takes .003 sec - old POST using LWP::UserAgent took 1.5sec
  #  Also fetches and sets %preferences
  my $wf_list = getUserLists($shopperid);

  $blankTDSpan = 1; # 2;  # colspan of initial blank cols for blue sections above/below hitlist
  $dataSpan = keys(%col_pos);  # chosen fields (plus vdkvgwkey)
  $nonblankTDSpan = $dataSpan+2-$blankTDSpan;

  $orderBox=$template{'orderBox'};
  $info{'blankTDSpan'}=$blankTDSpan;
  $info{'nonblankTDSpan'}=$nonblankTDSpan;

  $info{'fhSelected'}="";
  $info{'pdfSelected'}="";
  $info{'tifSelected'}="";
  $info{'moreSelected'}="";
  if($preferences{"orderform.product"}) {
    if($preferences{"orderform.product"} eq "3400") {
      $info{'fhSelected'}="SELECTED";
    }
    if($preferences{"orderform.product"} eq "2422") {
      $info{'pdfSelected'}="SELECTED";
    }
    if($preferences{"orderform.product"} eq "7944") {
      $info{'tifSelected'}="SELECTED";
    }
    if($preferences{"orderform.product"} eq "0") {
      $info{'moreSelected'}="SELECTED";
    }
  } else {
    $info{'fhSelected'}="SELECTED x";
  }

  $orderBox=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;

  # We cannot use an HREF for sort arrows, because a) it causes the
  # user's query to get logged (and we say we don't log those), and
  # b) it let's user's see our arg lists and try to manufacture their
  # own "get"s, or bookmarks, or, worse, html page links to our site.
  if ($show_sort_arrows) {
    # these are the sort arrows
    my $img_tail = qq! BORDER="0">!;
    $desc_img .= qq!<IMG SRC="/art/pv_arrow_down_a.gif" WIDTH="25" HEIGHT="15"! . $img_tail;
    $asc_img  .= qq!<IMG SRC="/art/pv_arrow_up_a.gif" WIDTH="25" HEIGHT="15"! . $img_tail;
  }
  if ($show_sort_arrows && $retrieved > 1) {
    # initialize sort variables when we have no db2 hitlist
    $anch_head  = qq!   <INPUT TYPE="HIDDEN" NAME="GENERAL" VALUE="$query_html">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="app" VALUE="$appName">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-l" VALUE="sort">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-m" VALUE="$pagesize">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-g" VALUE="1">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-c" VALUE="$collections">\n!;
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-i" VALUE="@fields">\n!;
    # also pass on various optional arguments
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="k2" VALUE="$k2">\n! if ($k2);
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="vs" VALUE="$vs">\n! if ($vs);
    $anch_head .= qq!   <INPUT TYPE="HIDDEN" NAME="language" VALUE="$language">\n! if ($language);
  }

  my $query_urlenc=$query;
  $query_urlenc=~s/([ -~])/$urlenc{$1}/g;

  $info{query}=$query_html;
  $info{querylength}=length($query);
  $info{collections}=$collections;
  $info{fields}="@fields";
  $info{sort}=$sortoname;
  $info{startrow}=$startrow;
  $info{pagesize}=$pagesize;
  $info{K2}=($k2) ? $k2 : "";
  $info{VS}=($vs) ? $vs : "";
  $info{language}=($language) ? $language : "";
  $info{patsearchMethod}=$GETPOST;
  $info{patsearchAction}=$patsearch;
  $info{ncHost}=$nchost;

  # This bunch should be removed when no templates use them anymore +++
  $info{'refineMethod'}=$GETPOST;
  $info{'refineAction'}=$patsearch;

  $info{"saveMethod"}="POST";
  $info{"saveAction"}="$nchost/cgi-bin/ncommerce3/ExecMacro/IPN/IPNqrysave.d2w/input";
  $info{"saveURL"}="$nchost/cgi-bin/ncommerce3/ExecMacro/IPN/IPNqrysave.d2w/input?query=$query_html&-c=$collections&-i=@fields&-o=$sortoname&mode=add&form=patsearch";


  #------- Produce header (up thru start of "main" table) ------
  if ($pf) {
    my $html = $template{'printerfriendly'};
    my $ts;
    chop($ts = `date -u`);
    $info{ts} = $ts;

    $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
    print STDOUT "<HTML>\n",$html;
  } else {
    OutputHeader("$query");
    # (Note that the header processing sets the background colors we are to use.)
    # (It also begins the outermost table (and that table is closed after we put
    # out the appropriate tab.)
  }

  #------- Application-Specific tabs and display bit ------

  # Set the default tab variables for all of our apps (each will modify his own)
  my @allapps=("CR","PX","DX","SN","CL","PL","FH" );
  foreach my $app (@allapps) {
    $info{"${app}bg"}="#CCCCCC";
    $info{"${app}curve"}="gray";
    $info{"${app}a"}=($retrieved>0)?"a":"INACTIVEa";
    $info{"${app}fntclr"}=($retrieved>0)?"black":"#eeeeee";
  }
  $info{'patsearchTabsIncludeSearchform'}="";
  $info{'patsearchTabsEndIncludeSearchform'}="";
  $info{'patsearchTabsIncludeFirstcolspan'}="";
  $info{'patsearchTabsEndIncludeFirstcolspan'}="";
  $info{'tabContents'}="";

  print STDOUT $debugfromenv if ($debug);

  if ("$appName"eq"dataExtract" && !$pf) {
      my $useourtabs = 0;
      my $html = "";
      $info{"app"}="dataExtract";
      $info{"DXbg"}="#B5CFF8";
      $info{"DXcurve"}="blue";
      $info{"DXa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="8";
      $info{"XXcolsAfter"}="12";

      # Map selected fields, in order, to fieldnames expected by DE
      my $temp_fields = join(' ',@fields);
      my $sel="patent_number,";
      if($temp_fields =~ m/IMG/)  { }
      if($temp_fields =~ m/TITLE/){ $sel .= "main_patenttitle,"; }
      if($temp_fields =~ m/DWT/)  { }
      if($temp_fields =~ m/AB/)   { $sel .= "abstract,"; }
      if($temp_fields =~ m/ASSG/) { $sel .= "assignee_name,"; }
      if($temp_fields =~ m/PD/)   { $sel .= "main_issuedate,"; }
      if($temp_fields =~ m/AD/)   { $sel .= "main_applicationdate,"; }
      if($temp_fields =~ m/DP/)   { $sel .= "priority_date,"; }
      if($temp_fields =~ m/CLAS/) { $sel .= "intlclass_code,"; }

      if($preferences{"dataextract.selitem"}) {
        $sel = $preferences{"dataextract.selitem"};
      }
      # POST version
      my $ua = LWP::UserAgent->new;
      my $res = $ua->request(POST "http://localhost/fcgi-bin/dataExtract.fpl",
                             [ 'searchstr' => $query_html,   # don't need urlenc now
                               'userlevel' => $userLevel,
                               'pagesize' => $pagesize,
                               'k2' => $k2,
                               'vs' => $vs,
                               'language' => $language,
                               'collections' => $collections,
                               'fields' => join(' ',@fields),
                               'sort' => $sortoname,
                               'startrow' => $startrow,
                               'saveMethod' => $info{'saveMethod'},
                               'saveAction' => $info{'saveAction'},
                               'saveURL' => $info{'saveURL'},
                               'patsearchMethod' => $info{'patsearchMethod'},
                               'patsearchAction' => $info{'patsearchAction'},
                               'tunnel' => $url_to_call,
                               'showtab' => "on",
                               'annotation' => $annotation,
                               'sel' => $sel,
                               'nitems' => $retrieved,
                               'format' => $preferences{"dataextract.format"},
                               'zipit' => $preferences{"dataextract.zipit"},
                               'debug' => ($debug)?"low":""
                              ]);
      my $get_stdout="";
      if ($res->is_success) {
          $get_stdout = $res->content;
      }
      else {
          $get_stdout = "Error ".$res->code.", ".$res->message;
      }
      if ($useourtabs) {
        $html=$template{'tabs'};
        $info{'tabContents'}=$get_stdout;
        $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
        print STDOUT $html;
      } else {
        print STDOUT $get_stdout;
      }
  }
  elsif ("$appName"eq"pdfExpress" && !$pf) {
      $info{"app"}="pdfExpress";
      $info{"PXbg"}="#B5CFF8";
      $info{"PXcurve"}="blue";
      $info{"PXa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="4";
      $info{"XXcolsAfter"}="16";

      # POST version
      my $ua = LWP::UserAgent->new;
      my $res = $ua->request(POST "http://localhost/fcgi-bin/pdfExpress.fpl",
                             [ 'searchstr' => $query_html,
                               'userlevel' => $userLevel,
                               'pagesize' => $pagesize,
                               'k2' => $k2,
                               'vs' => $vs,
                               'language' => $language,
                               'collections' => $collections,
                               'fields' => join(' ',@fields),
                               'sort' => $sortoname,
                               'startrow' => $startrow,
                               'saveMethod' => $info{'saveMethod'},
                               'saveAction' => $info{'saveAction'},
                               'saveURL' => $info{'saveURL'},
                               'patsearchMethod' => $info{'patsearchMethod'},
                               'patsearchAction' => $info{'patsearchAction'},
                               'tunnel' => $url_to_call,
                               'showtab' => "on",
                               'debug' => ($debug)?"low":"",
                               'annotation' => $annotation,
                               'nitems' => $retrieved
                               ]);
      my $get_stdout="";
      if ($res->is_success) {
          $get_stdout = $res->content;
      }
      else {
          $get_stdout = "Error ".$res->code.", ".$res->message;
      }
      print STDOUT $get_stdout;
  }
  elsif ("$appName"eq"snapshot" && !$pf) {
      my $html=$template{'tabs'};

      $info{"app"}="snapshot";
      $info{"SNbg"}="#B5CFF8";
      $info{"SNcurve"}="blue";
      $info{"SNa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="12";
      $info{"XXcolsAfter"}="8";

      my $urlqs = "-c=" . urlencode($collections) . "&GENERAL=" . $query_urlenc;
      my $rs_title="<B>Result Set for Query:</B>$query_html&nbsp;&nbsp;&nbsp;&nbsp;"
        .qq!<A HREF="javascript: saveSearch()"><FONT $geneva SIZE="1">!
        ."Save&nbsp;Search/Create&nbsp;Alert</FONT></A>";
      $info{"snapshotURL"}="$url_to_call?$urlqs&-m=0&-g=5&-l=snapshot";
      $info{"snapshotURLMax"}="$url_to_call?$urlqs&-m=0&-g=9&-l=snapshot";

      if ($netdatasnap) {
        # Retrieve tab contents from Net.Data
        my $ua = LWP::UserAgent->new;

        my $res = "";
        if ($retrieved>500) {
          $res = $ua->request(POST "http://localhost/cgi-bin/db2www.cmd/v4/snapshot_form.d2w/ss_form",
             [ 'rs_title' => $rs_title,   # no urlencode!
               'nitems' => $retrieved,  # WARNING: Snapshot can't tell if 500 or all items
               'url' => $info{"snapshotURL"},
               'urlmax' => $info{"snapshotURLMax"},
               'dcols' => $preferences{"snapshot.dcols"},
               'csort' => $preferences{"snapshot.csort"},
               'cb' => $preferences{"snapshot.cb"}
               ]);
        } else {
          $res = $ua->request(POST "http://localhost/cgi-bin/db2www.cmd/v4/snapshot_form.d2w/ss_form",
             [ 'rs_title' => $rs_title,   # no urlencode!
               'nitems' => $retrieved,
               'url' => $info{"snapshotURL"},
               'dcols' => $preferences{"snapshot.dcols"},
               'csort' => $preferences{"snapshot.csort"},
               'cb' => $preferences{"snapshot.cb"}
               ]);
        }
        my $get_stdout="";
        if ($res->is_success) {
            $get_stdout = $res->content;
        }
        else {
            $get_stdout = "Error ".$res->code.", ".$res->message;
        }

        # Insert this into the template for the tab
        $info{"tabContents"}=$get_stdout;
      } else {
        # Use a patsearch flavor template
        $info{"snapshotMethod"}="GET";
        $info{"snapshotAction"}="/snapshot/clist";
        $info{"snapshotRs_title"}=minimal_htmlencode($rs_title);

        # Now we figure out which alternate sections of the template we want
        my $docs=($retrieved>$snapshot_maxdocs)?$snapshot_maxdocs:$retrieved;
        if ($docs<=$maxdocs) {
          $info{"snapshotN2"}="$docs";
          $info{"snapshotN"}="$docs";
          $info{"snapshotPrettyN"}=commify($docs);
          $info{"snapshotIncludeFullset"}="<!--";
          $info{"snapshotEndIncludeFullset"}="-->";
          $info{"snapshotIncludedEntire"}="";
          $info{"snapshotAltIncludedEntire"}="";  # (no --> can be in these 3)
          $info{"snapshotEndIncludedEntire"}="";
        } else {
          $info{"snapshotN"}="$maxdocs";
          $info{"snapshotPrettyN"}="First $maxdocs";
          $info{"snapshotN2"}="$docs";
          $info{"snapshotPrettyN2"}=commify("$docs");
          $info{"snapshotIncludeFullset"}="";
          $info{"snapshotEndIncludeFullset"}="";
          if ($retrieved>$snapshot_maxdocs) {
            $info{"snapshotIncludedEntire"}="<!--";
            $info{"snapshotAltIncludedEntire"}="-->";
            $info{"snapshotEndIncludedEntire"}="";
          } else {
            $info{"snapshotIncludedEntire"}="";
            $info{"snapshotAltIncludedEntire"}="<!--";
            $info{"snapshotEndIncludedEntire"}="-->";
          }
        }

        $info{"tabContents"}=$template{'snapshot'};
        $info{"tabContents"}=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      }

      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
  }
  elsif ("$appName"eq"clustering" && !$pf) {
      my $html=$template{'tabs'};
      $info{"tabContents"}=$template{'clustering'};

      $info{"app"}="clustering";
      $info{"CLbg"}="#B5CFF8";
      $info{"CLcurve"}="blue";
      $info{"CLa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="16";
      $info{"XXcolsAfter"}="4";

      $info{"clusterMethod"}="GET";
      $info{"clusterAction"}="/cgi-bin/clustersearch";
      $info{"clusterMaxdocs"}="$cluster_maxdocs";
      $info{"nitems"}="$retrieved";

      # Now we figure out which alternate sections of the template we want
      my $docs=($retrieved>$cluster_maxdocs)?$cluster_maxdocs:$retrieved;
      if ($docs<=$maxdocs) {
        $info{"clusterN"}="$docs";
        $info{"clusterFirstLineType"}="hidden";
        $info{"clusterIncludeFullset"}="<!--";
        $info{"clusterEndIncludeFullset"}="-->";
        $info{"clusterIncludedEntire"}="";
        $info{"clusterAltIncludedEntire"}="";  # (no --> can be in these 3)
        $info{"clusterEndIncludedEntire"}="";
      } else {
        $info{"clusterN"}="First $maxdocs";
        $info{"clusterFirstLineType"}="radio";
        $info{"clusterN2"}=commify("$docs");
        $info{"clusterIncludeFullset"}="";
        $info{"clusterEndIncludeFullset"}="";
        if ($retrieved>$cluster_maxdocs) {
          $info{"clusterIncludedEntire"}="<!--";
          $info{"clusterAltIncludedEntire"}="-->";
          $info{"clusterEndIncludedEntire"}="";
        } else {
          $info{"clusterIncludedEntire"}="";
          $info{"clusterAltIncludedEntire"}="<!--";
          $info{"clusterEndIncludedEntire"}="-->";
        }
      }
      my $nclusters = 50;
      $nclusters = $preferences{"cluster.clusters"};
      $info{"clusterN5selected"}="";
      $info{"clusterN10selected"}="";
      $info{"clusterN20selected"}="";
      $info{"clusterN30selected"}="";
      $info{"clusterN50selected"}="";

      if($nclusters==5){  $info{"clusterN5selected" }="SELECTED";}
      if($nclusters==10){ $info{"clusterN10selected"}="SELECTED";}
      if($nclusters==20){ $info{"clusterN20selected"}="SELECTED";}
      if($nclusters==30){ $info{"clusterN30selected"}="SELECTED";}
      if($nclusters==50){ $info{"clusterN50selected"}="SELECTED";}

      $info{"tabContents"}=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
  }
  elsif ("$appName"eq"patentLab" && !$pf) {
      my $doer=($patsearch=~/fcgi-bin/)?"fcgi-bin/patentLab.fpl":"cgi-bin/patentLab.pl";
      my $html=$template{'tabs'};

      $info{"app"}="patentLab";
      $info{"PLbg"}="#B5CFF8";
      $info{"PLcurve"}="blue";
      $info{"PLa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="20";
      $info{"XXcolsAfter"}="0";

      # Retrieve tab contents from patentLab.fpl
      my $ua = LWP::UserAgent->new;
      my $urlqs = "-c=" . urlencode($collections) . "&GENERAL=" . $query_urlenc;

      my $res = $ua->request(POST "http://localhost/$doer",
         [ 'nitems' => $retrieved,
           'rs_title' => "",
           'url' => "$url_to_call?$urlqs&-m=0&-g=5&-l=wisdomain",
           'annotation' => $annotation,
           'features' => $features
           ]);
      my $get_stdout="";
      if ($res->is_success) {
          $get_stdout = $res->content;
      }
      else {
          $get_stdout = "Error ".$res->code.", ".$res->message;
      }

      $get_stdout=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      $info{"tabContents"}=$get_stdout;

      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
  }
  elsif ("$appName"eq"fhist" && !$pf) {
      my $html=$template{'tabs'};

      $info{"app"}="fhist";
      $info{"FHbg"}="#B5CFF8";
      $info{"FHcurve"}="blue";
      $info{"FHa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
      $info{"XXcolsBefore"}="20";
      $info{"XXcolsAfter"}="0";

      my $urlqs = "-c=" . urlencode($collections) . "&GENERAL=" . $query_urlenc;
      my $rs_title="<B>Result Set for Query:</B>$query_html&nbsp;&nbsp;&nbsp;&nbsp;"
        .qq!<A HREF="javascript: saveSearch()"><FONT $geneva SIZE="1">!
        ."Save&nbsp;Search/Create&nbsp;Alert</FONT></A>";
      $info{"snapshotURL"}="$url_to_call?$urlqs&-m=0&-g=5&-l=snapshot";
      $info{"snapshotURLMax"}="$url_to_call?$urlqs&-m=0&-g=9&-l=snapshot";

      # Retrieve tab contents from Net.Data
      my $ua = LWP::UserAgent->new;

      my $res = "";
      $res = $ua->request(POST "http://localhost/cgi-bin/db2www.cmd/v4/fh_form.d2w/fhist_form",
             [ 'rs_title' => $rs_title,   # no urlencode!
               'nitems' => $retrieved,
               'url' => $info{"snapshotURL"},
               'dcols' => $preferences{"snapshot.dcols"},
               'csort' => $preferences{"snapshot.csort"},
               'cb' => $preferences{"snapshot.cb"}
               ]);
      my $get_stdout="";
      if ($res->is_success) {
        $get_stdout = $res->content;
      }
      else {
        $get_stdout = "Error ".$res->code.", ".$res->message;
      }

      # Insert this into the template for the tab
      $info{"tabContents"}=$get_stdout;

      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
  }
  elsif (!$pf) {   # default to current results set
    print STDERR "patsearch called with invalid app $appName\n" if ("$appName"ne"currentResults");
    my $html=$template{'tabs'};
    $info{"tabContents"}=$template{'currentResults'};
    $info{"CRbg"}="#B5CFF8";
    $info{"CRcurve"}="blue";
    $info{"CRa"}="INACTIVEa";  # (anything which can look like an anchor tag, but isn't)
    $info{"XXcolsBefore"}="0";
    $info{"XXcolsAfter"}="20";
    $info{"CRfntclr"}="black";  # (even if $retrieved==0 we want this tab black)

    # We want to use our common tabs template, but, no searchform (and, we are
    # the first column, and a colspan=0 doesn't work).
    $info{'patsearchTabsIncludeSearchform'}="<!--";
    $info{'patsearchTabsEndIncludeSearchform'}="-->";
    $info{'patsearchTabsIncludeFirstcolspan'}="<!--";
    $info{'patsearchTabsEndIncludeFirstcolspan'}="-->";

    # Create the Collection Selection options, marking as selected the proper set.
    # When we get here, we have already done the search, on whatever set of
    # collections the user was allowed to choose, from any of our search pages.
    # (Right now, there is no way for a user to search, say epa and epbft together,
    # and, I depend on that below, in the sense that if any collection is fulltext,
    # we are going to offer the entire "fulltext" set, and not some mixture (where
    # we have both, anyway).
    # State: $collections is the space-separated list we got back from patquery, and
    # our %coll_index gets rebuilt here, based on the actual set we got back.

    # reload the coll_index hash with the collections actually searched
    undef %coll_index;
    my @colls = split(/[\ ,]+/, $collections);
    my $completefulltext=0;
    foreach my $cname (@colls) {
      $coll_index{$cname} = 1;
      my $oppname = $opposite_coll{$cname};
      if (defined($oppname)
          &&(!$subset_coll{$cname})&&(!$subset_coll{$oppname})) {  # complete subset
        $completefulltext++;
      }
    }

    my $selects="";
    my $fulltext=($collections=~/ft/)?1:0;
    my $need_footnote = 0;
    $info{'refineFullTextIncludeSubset'}="";
    $info{'refineFullTextEndIncludeSubset'}="";
    # (Remember if you change this code that you can't have nested comments in html)

    if ($userLevel =~ /premier|unlimited/ && !$coll_index{'lblistings'}) {
      $info{"refineIncludeCSelect"}="";
      $info{"refineEndIncludeCSelect"}="";
      $info{"refineAltCSelect"}="<!--";
      $info{"refineEndAltCSelect"}="-->";
      $info{"refineImproperColls"}="";
      # This is always true for now, till Marketing changes its mind
      if (($completefulltext == scalar(@colls)) || 1) {
        # remove our subset "warning" only if all selected colls have a complete
        # fulltext collection
        $info{'refineFullTextIncludeSubset'}="<!--";
        $info{'refineFullTextEndIncludeSubset'}="-->";
      }

      # Set up the collections SELECT section, and prepare the $info variables to show
      # the correct radio buttons for swapping between fulltext and front pages.
      if ($fulltext) {
        $info{'refineFrontPagesChecked'}="";
        $info{'refineFullTextChecked'}="checked";
        foreach my $coll (@selectable_ftcolls) {
          # We used to have a simple select here, now marketing wants checkboxes :-(
          # Then they got changed, by marketing, back to the simple select, so, leave
          # one sample of the checkbox code here, commented out.
          # (I suppose the template could have contained Javascript to render the
          # set of collections, either way, if we set two Javascript array variables
          # to the collections and their descriptions, and, another array variable
          # with the selected set.)
          $selects .= qq!<OPTION VALUE="$coll"!;
          #$selects .= qq!<INPUT TYPE="CHECKBOX" NAME="-c" ID="c_$coll" VALUE="$coll"!;
          if (defined($coll_index{$coll}) && $coll_index{$coll}>=0) {
            $selects .= " selected";
            #$selects .= " CHECKED";
          }
          $selects .= ">$colldesc{$coll}\n";
          #$selects .= qq!><LABEL FOR="c_$coll">$colldesc{$coll}</LABEL><BR>\n!;
        }
        # Now, see if we have to add (ugh) japan or inpadoc to this list
        foreach my $coll (@non_ftcolls) {
          if (defined($coll_index{$coll}) && $coll_index{$coll}>=0) {
            $selects .= qq!<OPTION VALUE="$coll" selected>$colldesc{$coll}\n!;
            $need_footnote = 1;
            $info{"refineImproperColls"}.="$colldesc{$coll}, ";
          }
        }
        $info{"refineImproperColls"}=~s/, $// if ($need_footnote);
      } else {  # not fulltext
        $info{'refineFrontPagesChecked'}="checked";
        $info{'refineFullTextChecked'}="";
        foreach my $coll (@selectable_colls) {
          $selects .= qq!<OPTION VALUE="$coll"!;
          if (defined($coll_index{$coll}) && $coll_index{$coll}>=0) {
            $selects .= " selected";
          }
          $selects .= ">$colldesc{$coll}\n";
        }
        # (Make the non-Full Text cheaply wider)
        $selects .= qq!<OPTION VALUE="">_____________________________!;
      }
      chop($info{"refineCollectionSelections"}=$selects);

      if ($need_footnote) {
        $info{"refineIncludeFootnote"}="";
        $info{"refineEndIncludeFootnote"}="";
      } else {
        $info{"refineIncludeFootnote"}="<!--";
        $info{"refineEndIncludeFootnote"}="-->";
      }
    } else {
      # the user is stuck, with either bibonly or lblistings
      $info{"refineIncludeCSelect"}="<!--";
      $info{"refineEndIncludeCSelect"}="-->";
      $info{"refineAltCSelect"}="";
      $info{"refineEndAltCSelect"}="";
      $info{"refineIncludeFootnote"}="";
      $info{"refineEndIncludeFootnote"}="";
    }

    $info{"refine0yearsSelected"}="selected";
    $info{"refine1yearsSelected"}="";
    $info{"refine2yearsSelected"}="";
    $info{"refine3yearsSelected"}="";
    $info{"refine5yearsSelected"}="";
    $info{"refine10yearsSelected"}="";

    $info{"refineYesRelevancyChecked"}="checked";
    $info{"refineNoRelevancyChecked"}="";

    # If we see exactly the sort of genstart or genend clause we would have added if
    # the yesno/date controls had been used on a current results tab, remove the clause
    # from the refine query and set our yesno/date controls appropriately.
    # (Since we might be coming from another tab, we can't simply test for $genstart/end,
    # but must just look at the query.)
    if (($query =~ /^\((<yesno>)?\((.*)\)( AND PD>(\d{4})$mmdd)?\)$/)
        && ($1 || $3)) {
      my $newquery=$2;
      if ($1) {
        $info{"refineNoRelevancyChecked"}="checked";
        $info{"refineYesRelevancyChecked"}="";
      }
      if ($3) {
        my $delta=$yyyy-$4;
        my $whichyears = sprintf("refine%dyearsSelected",$delta);
        if ($delta==1||$delta==2||$delta==3||$delta==5||$delta==10) {
          $info{$whichyears}="selected";
          $info{"refine0yearsSelected"}="";
        } else {  # not ours
          $newquery = "($newquery)$3";
        }
      }
      $info{"querylength"}=length($newquery);
      $info{"refineQuery"}=minimal_htmlencode($newquery);  # (note: not urlencode)
    } else {
      $info{"refineQuery"}=$query_html;
    }

    $info{"tabContents"}=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
    $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
    print STDOUT $html;
  } # end currentResults app

  # end the table started by OutputHeader(), because all of the subsequent tables don't
  # want to have their width constrained by what has happened so far.  (In particular,
  # the results pages become printable by removing that constraint, and only the header
  # falls off the right side of the paper.)
  print STDOUT "</TD></TR></TABLE><!-- end header table -->\n\n" unless ($pf);  # (pf didn't use the header)

  #------- Set variables for the hitlist feedback (collections searched, # of matches ...) -------
  $info{"hitlistCollections"}=$collstr;
  $info{"hitlistMatches"}=commify($retrieved);
  $info{"hitlistSearched"}=commify($processed);
  $info{"hitlistStartrow"}=$startrow;
  $info{"hitlistEndrow"}=$endrow;
  $info{"hitlistIncludeLimited"}=($retrieved>500)?"":"<!--";
  $info{"hitlistEndIncludeLimited"}=($retrieved>500)?"":"-->";

  #------- Set the additional variables for the navigation form -------
  # (the FORM uses almost all of the "refine" variables too)
  my ($fpActive,$fpAltActive,$fpEndActive,
      $lpActive,$lpAltActive, $lpEndActive) = ("","","","","","");

  #------- Set legendInclude/legendEndInclude to show pdf price lengend
  $info{'legendInclude'}="<!--";
  $info{'legendEndInclude'}="-->";

  $info{'appname'}=$appName;
  if ($retrieved > 0) {
    my ($pinkdot_head,$pinkdot_mid,$pinkdot_tail,$yet2dot_mid);
    my ($fast_buy_cell_head,$fast_buy_cell_head2, $fast_buy_cell_mid,$fast_buy_cell_tail);
    my ($fast_buy_cell_midalt,$fast_buy_cell_midaltTPS);
    my ($fast_buy_delphgif,$fast_buy_tpsgif,$fast_buy_1x1gif);
    my ($didpinkdot,$didy2dot,$didfastbuy);
    my ($cbox_head,$cbox_tail);
    my ($patn_head,$patn_href,$patn_mid,$patn_tail);
    my ($titl_head,$titl_tail,$scor_head,$scor_tail,$xxxx_head,$xxxx_tail,$form_head);
    my ($r,$score);

    foreach my $p (@pn) {
      $selected{$p} = 1;
    }

    if (($retrieved <= $pagesize && $startrow == 1) || !($scrolling_controls) ) {
      $info{"hitlistIncludeScroll"}="<!--";
      $info{"hitlistEndIncludeScroll"}="-->";
      $info{"hitlistPrev"}=1;
      $info{"hitlistNext"}=1;
      $info{"hitlistLast"}=1;
    } else {
      my ($prevpage,$nextpage,$lastpage);
      $info{"hitlistIncludeScroll"}="";
      $info{"hitlistEndIncludeScroll"}="";
      ($fpAltActive,$fpEndActive)=("<!-- "," -->");
      ($lpAltActive, $lpEndActive)=("<!-- "," -->");

      $prevpage = $startrow - $pagesize;
      if ($prevpage < 1) {
        $prevpage = 1;
        if ($startrow <= 1) {
          ($fpActive, $fpAltActive,$fpEndActive)=("<!-- "," -->","");
        }
      }
      {
        use integer;
        $lastpage = (($maxdocs-1) / $pagesize) * $pagesize + 1;
      }
      $nextpage = $startrow + $pagesize;
      if ($nextpage > $maxdocs) {
        $nextpage = $lastpage;
        ($lpActive,$lpAltActive, $lpEndActive)=("<!-- "," -->","");
      }
      $info{"hitlistPrev"}=$prevpage;
      $info{"hitlistNext"}=$nextpage;
      $info{"hitlistLast"}=$lastpage;
    }
    $info{firstpageActive}   = $fpActive;
    $info{firstpageAltActive} = $fpAltActive;
    $info{firstpageEndActive} = $fpEndActive;
    $info{lastpageActive}     = $lpActive;
    $info{lastpageAltActive}  = $lpAltActive;
    $info{lastpageEndActive}  = $lpEndActive;

    my $html=($pf)?$template{'printerfriendlyTop'}:$template{'topNav'};
    $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
    print STDOUT $html;

    print STDOUT "\n<!-- Begin hitlist table/form -->\n";
    if ($pf) {
      print STDOUT qq!<TABLE border="0" width="100%"><TR><TD>\n!;
      print STDOUT qq!<TABLE CELLPADDING="2" CELLSPACING="0" WIDTH="100%" BORDER="0">\n!;
    } else {
      print STDOUT qq!<TABLE cellpadding="1" cellspacing="0" border="0"><TR><TD BGCOLOR="#999999">\n!;
      print STDOUT qq!<TABLE border="0" cellspacing="1" cellpadding="2">\n!;
    }

    # Display the order box and work file list
    unless ($pf) {
      my $html = $template{'workFile'};

      $info{"orderBox"} = $orderBox;
      $info{"blankTDSpan"} = $blankTDSpan;
      $info{"nonblankTDSpan"} = $nonblankTDSpan;
      $info{"wl_file_list"} = $wf_list;
      $info{"jssafeQuery"}=$query;
      $info{"jssafeQuery"} =~ s/'/\\'/g; # Escape single quote
      $info{"jssafeQuery"} =~ s/<\/SCRIPT>/<\\\/SCRIPT>/gi; # Escape </SCRIPT>

      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
    }

    #------- Produce each row of the hitlist -------
    #------- Do a little more initialization first...
    my @row_head_alt = (qq!<TR class="text" ALIGN="LEFT" $default_row2_color VALIGN="TOP">!,
                        qq!<TR class="text" ALIGN="LEFT" $default_row1_color VALIGN="TOP">!);

    my %PINK;
    if ($dopinkdots) {
      if (dbmopen(%PINK, $pinkdbm, 0440)) {
        $pinkdot_head  = qq!  <A HREF="$pink_url!;
          #?pn=patn
        $pinkdot_mid = qq!"><IMG SRC="/art/pink.gif"!;
        $yet2dot_mid = qq!" onClick="window.open(this.href,'YET2',yet2window);return false;"><IMG SRC="/art/y2dot.png"!;
        $pinkdot_tail = qq! WIDTH="20" HEIGHT="20" ALIGN="TOP" ALT="licensing button"!;
        $pinkdot_tail .= qq! BORDER="0"></A>\n!;
      } else {
        print STDERR "patsearch could not open pink dot db\n" if ($debug);
        $dopinkdots = 0;
      }
    }

    $score = "";

    # Set up html for fast buy
    $fast_buy_tpsgif = qq!"/art/fbt.gif" WIDTH="16" HEIGHT="18"!;
    $fast_buy_delphgif = qq!"/art/fb.gif" WIDTH="16" HEIGHT="18"!;
    $fast_buy_1x1gif = qq!"/art/1x1.gif" WIDTH="1" HEIGHT="1"!;
    $fast_buy_cell_head = qq!\n<TD ALIGN="CENTER"><A HREF="javascript:pdfWindow(!;
                           #'patn','patent_format'
    $fast_buy_cell_head2  = qq!)">\n <IMG SRC=!;
                           # one of the fast_buy_Xgif's
    $fast_buy_cell_mid = qq! BORDER="0" ALT="!;
    $fast_buy_cell_midalt = ($userLevel =~ /unlimited/) ? "Get PDF" : "Buy PDF";
    $fast_buy_cell_midaltTPS = "Buy PDF";
                           # - NNNpp  (optional)
    $fast_buy_cell_tail = qq!"></A></TD>\n!;


    # Set up html for various situations
    # (The html here does not do any indenting for readability in
    # viewing the source, because there are lots of smallish identically
    # html'd rows.)

    $cbox_head  = qq!<TD WIDTH="2%" ALIGN="CENTER">!;
    $cbox_head .= qq!<INPUT TYPE="CHECKBOX" NAME="pn" onClick="if(this.checked){sel_count_int++;}else{sel_count_int--;};checkSelItems(this)" VALUE=!;
      # "patn" optional-CHECKED
    $cbox_tail  = qq!></TD>\n!;

    $patn_head  = qq!<TD ALIGN="RIGHT" NOWRAP>!;
    $patn_href = qq!<A HREF="$details_url!;
      #patn
    $patn_mid   = qq!$langarg">!;
      #patn we show the user, i.e. without trailing _'s
    $patn_tail  = "</TD>\n";
    $didpinkdot = 0;
    $didy2dot = 0;

    $titl_head  = "<TD>";
    $titl_tail  = "</TD>\n";

    $scor_head  = qq!<TD><FONT SIZE="-1" COLOR="#106060">!;
    $scor_tail  = "</FONT></TD>\n";

    $xxxx_head  = "<TD>";
    $xxxx_tail  = "</TD>\n";

    if (!$fcgi_mode && $use_db2) {  # (delayed for the cgi-case -- it might not use this output filter)
      setupDB2();
      connectDB2();
    }
    if ($db2dsrch) {
       getDatasrc(%pnhash);
       getImagePages(%pnhash);
       if ($col_pos{"DWT"}) {getDerwentTitle(%pnhash);}
       if ($col_pos{"INVT"}) {getInventor(%pnhash);}
    }

    $r = "";
    $didfastbuy = 0;
    $lct = 0;
    my @ordered_col = @fields;
    sortFields(@ordered_col, @col_order);
    while(<IN>) {  # for each row of hit data, generate the html for the hitlist
      chop;
      s/\t\t$/\t \t/;  # in case the last element is empty
      # my $linein = \$_;
      text_filter_sed($_);
      my @cols = split(/\t/);
      my ($pn,$pndisp,$pn2);
      my $dot;

      $lct++;
      $r .= ($pf) ? $row_head_alt[0] : $row_head_alt[$lct % 2];
      $r .= "\n<!-- row: @cols -->\n" if ($debug);
      $image_pages = 0;
      my ($queryTps, $isOnTps);

      if ($col_pos{"VDKVGWKEY"}) {  # (we always have a keycol)
        $pn = $cols[$col_pos{"VDKVGWKEY"}-1];
        $pndisp = $pn;
        $pn2 = substr($pn,0,2);
        getPndisp($pndisp, $pn2);

        # Produce the initial pinkdot/fast buy/orderbox html for each entry
        if ($dopinkdots && ($dot = $PINK{$pn})) {
          if ($dot == 'Y') {  # yet2com lb
            $didy2dot = 1;
          } else {
            $didpinkdot = 1;
          }
        }
        if (1) { # just limits scope of variables
          my $have_image = 0;
          my $ok = 0;
          if (1 || index("$have_images","$pn2") >= 0) {
            $have_image = 1;
            if ($db2sth) {  # See if we really have an image
              $queryTps = $pnhash{$pn}[PnhashQueryTps];
              $isOnTps = $pnhash{$pn}[PnhashIsOnTps];
              $image_pages = $pnhash{$pn}[PnhashImagePages];
              $drawing = $pnhash{$pn}[PnhashDrawing];
              if ($isOnTps || $queryTps || $image_pages) {
                 $have_image = 1;
              } else {
                 # either we have no image_pages for this patn, or we don't sell them
                 $have_image = 0;
              }
            } elsif ($use_db2) {
              $fcgi_requests += 100;  # lose 100 lives if we should have a db but don't
            }
          }
          if (!$pf) {
             # fast buy column
             if ($have_image) {
               # There is an ugly kludge for JP in this section.  In general we
               # have a 1-page thumbnail, and IMAG says image_pages=1, BUT, we
               # don't really have any JP images for sale, so we send the user
               # off to TPS.
               my $patn_format = ($isOnTps || $queryTps || ($pn2 eq "JP")) ? "P_TPS" : "P";
               $r .=  "$fast_buy_cell_head'$pn','$patn_format'$fast_buy_cell_head2";

               # Until tpsi.fpl does can handle multiple patents numbers, so we
               # don't have to call it 500 times for ordinary inpadoc queries,
               # we are not going to use <IMG SRC="/fcgi-bin/tpsi.fpl?pn=$pn"
               # (but we are leaving all of the logic to set $queryTps in case we need it someday)
               my $is_core = ($pn =~ /^(US|EP|WO)/) ? 1 : 0;
               my $cn2kind = substr($pn, 0, 2) . substr($pn, 10, 2);
               my $no_image = ($cn2kind =~ /^(AUA0|AUA4|DEC0|GBA0)/) ? 1 : 0;
               if ($no_image) {
                 $r .= $fast_buy_1x1gif;  # No PDF for known no-image country/kind cases
               } elsif ($isOnTps || ($pn2 eq "JP")) {
                 if ($is_core) {
                   $r .= $fast_buy_delphgif;
                 } else {
                   $r .= $fast_buy_tpsgif;
                 }
               } elsif ($queryTps) {  # (i.e. no entry in imag)
                 if ($is_core) {
                   $r .= (getAge($pn)<14) ? $fast_buy_1x1gif : $fast_buy_delphgif;
                 } else {
                   $r .= $fast_buy_tpsgif;
                 }
               } else {
                 $r .= $fast_buy_delphgif;
               }
               $r .= $fast_buy_cell_mid;
               $r .= (($patn_format eq "P") || $is_core) ? $fast_buy_cell_midalt : $fast_buy_cell_midaltTPS;
               $r .= " - ${image_pages}pp" if ($image_pages && ($pn2 ne "JP"));
               $r .= $fast_buy_cell_tail;
               $didfastbuy = 1;
             } else {
               $r .= $empty_col;
             }
             # check box column (as of Sep 2001 we always have this)
             $r .= qq!$cbox_head"$pn"!;
             $r .= " CHECKED" if ($selected{$pn});
             $r .= $cbox_tail;
           } else {  # printer friendly
           # $r .= $empty_col;
           # $r .= $empty_col;
           }
         }
      } else {
        $r .= $empty_col;
        $r .= $empty_col;
      }

      # Now we create html for each column of data
      $curcol = 0;
      my $curidx = 0;
      while ($curidx <= $#cols) {
        $curcol = $col_pos{$ordered_col[$curidx]};
        my $col = $cols[$curcol - 1];
        $curidx++;
        # First reformat the data, if needed
        if ($curcol == $col_pos{"SCORE"}) {
          # Build the proper score string
          $score = $scor_head;
          if( substr($col,0,1) == '1' ) {
            $score .= "100";
          } else {
            $score .= substr($col,2,2);
          }
          $score .= "%$scor_tail";
          next;  # this version always does score last
        } elsif ($curcol == $col_pos{"PD"} or $curcol == $col_pos{"AD"}
                 or $curcol == $col_pos{"DP"}) {
          if ($col =~ m/([0-9]+)\/([0-9]+)\/([0-9]+)/) {
            # there is a date, and it needs to be reformatted
            # (as of 10/?? we are using ISO, dash separated dates for us dates)
            $col = "$1-$2-$3";
          }
          $col = "&nbsp;$col&nbsp;";  # (date ususally needs a bit more white space)
        } elsif ($curcol == $col_pos{"CLAS"}) {
          # reformat db2 form to "readable" form
          $col = FormatICL($col);
          $col =~ s/Missing/\-/;  # replace Missing with a -
        } elsif ($curcol == $col_pos{"ASSG"}) {
          # replace MissingAssignee with a -
          $col =~ s/MissingAssignee/\-/;
        } elsif ($curcol == $col_pos{"INVT"}) {
           $col = $pnhash{$pn}[PnhashInventor];
        } elsif ($curcol == $col_pos{"PATN"}) {  # (derwent)
          # remove underscores
          $col =~ s/_//g;
          $col =~ s/US2(.)/US200${1}0/g;
          $col =~ s/JP2(.)/JP200$1/g;
        } elsif ($curcol == $col_pos{"IMG"}) {
            next;
        }

        # Wrap the data in the appropriate head/tail html
        if ($curcol == $col_pos{"AB"} || $curcol == $col_pos{"TITLE"} || $curcol == $col_pos{"DWT"}) {
          if ($curcol == $col_pos{"TITLE"} ||
             (!$col_pos{"TITLE"} && $curcol == $col_pos{"DWT"}) ||
             (!$col_pos{"TITLE"} && !$col_pos{"DWT"} && $curcol == $col_pos{"AB"})) {
            my ($boldTagS, $boldTagE, $needHr, $hr, $needNl);
            if ($col_pos{"AB"}) {
              $boldTagS = "<b>";
              $boldTagE = "</b>";
            }
            $r .= $titl_head;
            $hr = qq!<HR SIZE="1" COLOR="#DDDDDD" WIDTH="95%" ALIGN="CENTER" />!;
            if ($col_pos{"DWT"} && $pnhash{$pn}[PnhashDwTitle]) {
              $r .= "$boldTagS$pnhash{$pn}[PnhashDwTitle]$boldTagE ";
              $r .= qq!<FONT SIZE="-2">[<A HREF="/derwent/p/dwdetails?pn=$pn">Derwent Record</A>]</FONT>!;
              $needHr = 1;
            }
            if ($col_pos{"TITLE"}) {
              if ($needHr) {
                $r .= $hr;
                $needHr = 0;
              }
              $r .= $boldTagS . $col . $boldTagE;
              $needNl = 1;
            }
            if ($col_pos{"AB"}) {
              my $tmpAbstract = getAbstract($pn, $pnhash{$pn}[PnhashDatasrc]);
              if ($tmpAbstract) {
                if ($needHr) {
                   $r .= $hr;
                   $needHr = 0;
                }
                if ($pn =~ /^US/ && $needNl) {$r .= "<Br/>";}
                $r .= $tmpAbstract;
              }
            }
            $r .= $titl_tail;
          }
        } elsif ($curcol == $col_pos{"VDKVGWKEY"}) {
          $pndisp .= $A_etag . $nbsp;
          if ($col_pos{"IMG"} && !$queryTps && ($image_pages || index($pn, "JP") > -1)) {
            $pndisp .= renderThumbnail($pn, $image_pages, $drawing, (index($pn, "JP") == -1));
          }
          $r .= $patn_head;
          # Produce the initial pinkdot/fast buy/orderbox html for each entry
          if ($dopinkdots && ($dot = $PINK{$pn})) {
            if ($dot == 'Y') {  # yet2com lb
               $r .= "$pinkdot_head?pn=$pn$yet2dot_mid$pinkdot_tail";
               $didy2dot = 1;
            } else {
               $r .= "$pinkdot_head?pn=$pn$pinkdot_mid$pinkdot_tail";
               $didpinkdot = 1;
            }
            $r .= " - ";
          }
          $r .= "$patn_href$pn$patn_mid$pndisp$patn_tail";
        } else {
          if ($curcol == $col_pos{"PD"} or $curcol == $col_pos{"AD"} or $curcol == $col_pos{"DP"}) {
            $r .= substr($xxxx_head,0,-1)." NOWRAP>$col$xxxx_tail";
          } else {
            $r .= "$xxxx_head$col$xxxx_tail";
          }
        }
      } # foreach column

      # Tack on our score
      $r .= "$score";
      $r .= "</TR>\n";
    } # while(<IN>)
    close(IN);
    if ($dopinkdots) {dbmclose(%PINK);}

    #------- Start the actual rows of the hitlist -------
    my $needendform = 0;
    $form_head  = "\n<!-- hitlist table rows -->\n";
    if (!$pf) {
      $form_head .= qq!<SCRIPT LANGUAGE="Javascript">\n!;
      $form_head .= "<!--\n";
      $form_head .= "function pdfWindow(pn, type) {\n";
      $form_head .= qq!  var pdfurl = '$nchost/cgi-bin/ncommerce3/IPNFastBuy?merchant_rn=8595&format=';\n!;
     #Marketing can't make up its mind what this new window should look like.
     #So, for now leave this next pair of lines here so you can see how to create a new
     #window of a specific size, in case they ask for one, again. +++
     #$form_head .= qq!  var pdffeatures =  'width=500,height=350,resizable=yes,scrollbars=yes,status=yes';\n!;
     #$form_head .= "  window.open(pdfurl + type + '&patent_number=' + pn, 'pdf', pdffeatures);\n";
      $form_head .= "  window.open(pdfurl + type + '&patent_number=' + pn);\n";
      $form_head .= "}\n//-->\n";
      $form_head .= "</SCRIPT>\n";
      if ($didy2dot) {
        $form_head .= qq!<SCRIPT LANGUAGE="Javascript">\n!;
        $form_head .= "<!--\n";
        $form_head .= qq!  var yet2window="'menubar=yes,toolbar=yes,location=yes,directories=yes,status=yes,scrollbars=yes,resizable=yes,copyhistory=no,top=100,left=80,width=800,height=450'";!;
        $form_head .= "//-->\n";
        $form_head .= "</SCRIPT>\n";
      }
    }
    $form_head .= qq! <TR ALIGN="LEFT" BGCOLOR="#FFFFFF" class="formstyle">\n!;

    #------- Produce the column headers -------
    # (This column header html has got to get into templates too, somehow. +++
    #  when the "choose" got templated, the alternate wordings, e.g. Issued vs
    #  Issued Date, got frozen.  So, that alternate wording code is gone from here too.)
    $hd_txt{"VDKVGWKEY"} = "Accession#" if ($derwent);
    $form_head .= " <!-- sortcol: $sortcol asc: $sortasc $sortname -->\n" if ($debug);
    $form_head .= " <!-- fields: @fields -->\n" if ($debug);
    $form_head .= " <!-- column headers -->\n";
    $curcol = 0;
    my $table_header_bgcolor = ($pf) ? "" : qq!BGCOLOR="#B5CFF8"!;

    # fast buy column header
    if (!$pf) {
       $form_head .= qq!<TD WIDTH="1%" BGCOLOR="#CCCCCC" ALIGN="CENTER"><font size="-2">\n!;
       if ($didfastbuy) {
         my $txt = ($userLevel =~ /unlimited/) ? $txt_ia_fast_buy_short : $txt_ia_fast_buy;
         $form_head .= "&nbsp;$txt&nbsp;";
       } else {
         $form_head .= qq!<IMG SRC="/nav/spacer.gif" WIDTH="20" HEIGHT="20">!; # unless ($pf);
       }
       $form_head .= "</font></TD>\n";
    }
    # check box column header
    if (!$pf) {
      $form_head .=<<EOF
<SCRIPT LANGUAGE="Javascript"><!--
// turns table row green when checkbox checked
var sel_count_int=0;
function hlRow(cb_in){
 var r;
 if(cb_in.parentNode && ((r=cb_in.parentNode.parentNode))){
  if(cb_in.parentNode.name=='listform'){
   r=cb_in.parentNode.parentNode.parentNode;
  }
  if(cb_in.checked){
   r.className='rowhls';
  } else {
   r.className='rowhl';
  }
 }
}
function SCU(){ // SelectedCountUpdate
 if(sel_count_int < 0) {
  sel_count_int = 0;  // Fixes NS 7.1 problem with page reload
 }
 if (document.getElementById) {
  if(document.getElementById('sel_count')) {
   document.getElementById('sel_count').innerHTML=sel_count_int;
  }
 }
}
function  SelectHideAll(object){
 var checked=false;
 var form_in = document.listform;
 if(object.checked){
  checked=true;
 }
 sel_count_int = 0;
 for (var i =0; i<form_in.elements.length; i++){
  if(form_in.elements[i].type=="checkbox"){
   form_in.elements[i].checked=checked;
   if(checked){
    sel_count_int++;
   }
   hlRow(form_in.elements[i]);
  }
 }
 SCU();
 document.workfile.add[0].checked = true; // same as CB() in NetData hitlist
 if(document.items && document.items.add) {
   document.items.add[0].checked=true;
 }
}
function checkSelItems(object) {
 hlRow(object);
 SCU();
 if (object.checked) {
  if (!document.workfile.add[0].checked) {document.workfile.add[0].checked = true;}
  if (document.items && document.items.add){document.items.add[0].checked = true;}
 }
}
//-->
</SCRIPT>
EOF
;
      $form_head .= qq!<TD ALIGN="CENTER" BGCOLOR="#B5CFF8" WIDTH="1%"><form style="margin: 0 0 0 0;">!;
      $form_head .= qq!<INPUT TYPE="CHECKBOX" NAME="selectall" VALUE="" onClick="SelectHideAll(this); return true;" !;
      $form_head .= qq!TITLE="Select all items on this page"/></form></TD>!;
    } else {
      # $form_head .= $empty_col;
    }
my $direction_tag;

    foreach my $col (@ordered_col) {
      $curcol = $col_pos{$col};
      # this version always does score last
      next if ($curcol == $col_pos{"IMG"} ||
              ($curcol == $col_pos{"DWT"} && $col_pos{"TITLE"}) ||
              ($curcol == $col_pos{"AB"} && ($col_pos{"DWT"} || $col_pos{"TITLE"})));
      my $isTitleHead = $curcol == $col_pos{"DWT"} || $curcol ==  $col_pos{"TITLE"} ||
                        $curcol == $col_pos{"AB"};
      if ($curcol == $col_pos{"VDKVGWKEY"}) {
        $form_head .= qq!<TD NOWRAP align="right" BGCOLOR="#CCCCCC">!;
      } else {
        $form_head .= qq!<TD NOWRAP BGCOLOR="#CCCCCC">!;
      }
      if ($show_sort_arrows && $retrieved > 1 && !($isTitleHead && !$col_pos{"TITLE"})) {
        my $dir_img;
        $form_head .= "</FORM>" if ($needendform);
        $form_head .= qq!<FORM METHOD=$GETPOST ACTION="$patsearch" NAME="$col\_frm">\n$anch_head!;
        $needendform = 1;
        # add the sort information needed to sort by this column
        $form_head .= qq!   <INPUT TYPE="HIDDEN" NAME="-o" VALUE="!;
        if ($curcol == $sortcol) {  # (ascending is indicated by a minus sign)
          $form_head .= ($sortasc) ? "$curcol" : "-$curcol";
        } else {  # proper default direction
          $form_head .= ($hd_sort{$fields[$curcol-1]}) ? "-$curcol" : "$curcol";
        }
        $form_head .= qq!">\n!;
        my ($curr_shw, $curr_sht);
        if ($curcol == $sortcol) {
          $dir_img = ($sortasc) ? $asc_img : $desc_img;
          $direction_tag = ($sortasc) ? $descending_direction : $ascending_direction;
          $curr_sht = $sort_href_title;
          $curr_shw = $sort_href_windowstatus;
          $curr_sht =~ s/DIRECTION/$direction_tag/;
          $curr_shw =~ s/DIRECTION/$direction_tag/;
        } else {
          $dir_img = ""; # ($hd_sort{$fields[$curcol-1]}) ? $asc_img : $desc_img;
          $direction_tag = ($hd_sort{$fields[$curcol-1]}) ? $ascending_direction : $descending_direction;
          $curr_sht = $sort_href_title;
          $curr_shw = $sort_href_windowstatus;
          $curr_sht =~ s/DIRECTION/$direction_tag/;
          $curr_shw =~ s/DIRECTION/$direction_tag/;
        }
        # $form_head .= "<table hspace=\"0\" cellpadding=\"0\" cellspacing=\"0\" border=\"0\"><tr class=\"formstyle\"><td nowrap><B>";
        if ($curcol == $col_pos{"TITLE"}) {
           if ($col_pos{"DWT"}) {
               $form_head .= qq!$hd_txt{"DWT"}<br/>!;
           }
        }
        if ($dir_img) {$form_head .= qq!<table><tr class="formstyle"><td nowrap>!;}
        $form_head .= "<b>";
        $form_head .= qq!<label for="s$col">!;
        $form_head .= qq!<a href="javascript:document.$col\_frm.submit();" title="$curr_sht" onMouseOver="window.status='$curr_shw'; return true;" onMouseOut="window.status='';">$hd_txt{$col}!;
        $form_head .= "</label></a></b>";
        # $form_head .= "</a></b></td><td>$dir_img</td>\n";  # triangle
        if ($dir_img) {$form_head .= "</td><td>$dir_img</td>";}
        # $form_head .= "</a></b>$dir_img\n";
        if ($curcol == $col_pos{"TITLE"}) {
          # $form_head .= "<td valign=\"baseline\"><font size=\"-2\">&nbsp;$txt_sort_help</font></td>";
          if ($dir_img) {$form_head .= qq!<td>!;}
          $form_head .= qq!<font size="-2">&nbsp;$txt_sort_help</font>!;
          if ($dir_img) {$form_head .= "</td>";}
        }
        if ($dir_img) {$form_head .= "</tr></table>";}
        if ($curcol == $col_pos{"TITLE"}) {
           if ($col_pos{"AB"}) {
               $form_head .= qq!<br/>$hd_txt{"AB"}!;
           }
        }
      } else {  # no sort arrows, or, only one hit
        $form_head .= "<U>" if (($curcol == $sortcol) && ($retrieved > 1));
        if ($curcol == $col_pos{"DWT"}) {
            if (!$col_pos{"TITLE"}) {
               $form_head .= $hd_txt{$col};
               if ($col_pos{"AB"}) {$form_head .= qq!<br/>$hd_txt{"AB"}!};
            }
        }
        elsif ($curcol == $col_pos{"AB"}) {
            if (!$col_pos{"TITLE"} && !$col_pos{"DWT"}) {
               $form_head .= $hd_txt{$col};
            }
        }
        else {$form_head .= $hd_txt{$col};}
        $form_head .= "</U>" if (($curcol == $sortcol) && ($retrieved > 1));
      }
      $form_head .= "</TD>\n";  # no leading blanks here, for netscape vagaries
    } # foreach $col in the column header

    $form_head .= "  </FORM>\n" if ($needendform);

    $form_head .= "</TR>\n\n<!-- hitlist rows -->\n";
    $form_head .= qq!  <FORM METHOD="POST" ACTION="$order_cmd" NAME="listform">\n! unless ($pf);
    print STDOUT "$form_head";

    # This is the html for all of the actual hitlist rows (minus the last </TD> and </TR>)
    print STDOUT substr($r,0,-12);

    #------- Close the table/form for the table of query results -------
    my $tail ="\n";
    if (!$pf) {  # finish up the hitlist form and do an orderbox form
      # tuck the hiddens for the hitlist check boxes order form in here
      # (SQL Hitlist version has the same hidden stuff we have here)
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="mode" VALUE="add" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="wc" VALUE="m.patn = h.patn" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="merchant_rn" VALUE="8595" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="order" VALUE="" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="product_rn" VALUE="3400" 366698 />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="url" VALUE="/cgi-bin/ncommerce3/InterestItemDisplay">\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="cmd" VALUE="WLManager" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="wlref" VALUE="" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="descr" VALUE="" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="-i" VALUE="@fields" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="-m" VALUE="$pagesize" />\n!;
      $tail .= qq! <INPUT TYPE="HIDDEN" NAME="-o" VALUE="$info{sort}" />\n!;
      $tail .= "</TD>\n</TR>\n";

      if ($orderbox_at_bottom) {
        $tail .= qq!</FORM>\n<FORM NAME="orderchecked" onSubmit="document.listform.action='!;
        $tail .= $order_cmd;
        $tail .= qq!'; document.listform.product_rn.value=this.product_rn.options[this.product_rn.selectedIndex].value;!;
        $tail .= qq! document.listform.submit(); return false;">!;
        $tail .= $orderBox;
      }
      $tail .= "</FORM>\n";
    } else {
      $tail .= "</TD>\n</TR>\n";
    }

    if ($didpinkdot || $didy2dot) {
      my $pdcolspan = $blankTDSpan + $nonblankTDSpan;  # total number of columns
      $tail .= qq!<TR BGCOLOR="#FFFFFF"><TD COLSPAN="$pdcolspan">\n!;
      $tail .= qq!<FONT SIZE="-1">!;
      if ($didpinkdot) {
        $tail .= "&nbsp;<B>Click ";
        $tail .= qq!<IMG SRC="/art/pink.gif" WIDTH="20" HEIGHT="20" ALIGN="TOP" ALT="licensing button" BORDER="0">\n!;
        $tail .= "for Delphion IP listing information</B>\n";
      }
      $tail .= "&nbsp;&nbsp|&nbsp&nbsp" if ($didpinkdot && $didy2dot);
      if ($didy2dot) {
        $tail .= "&nbsp;<B>Click ";
        $tail .= qq!<IMG SRC="/art/y2dot.png" WIDTH="20" HEIGHT="20" ALIGN="TOP" ALT="licensing button" BORDER="0">\n!;
        $tail .= "for licensing information on yet2.com</B>\n";
      }
      $tail .= "</FONT></TD></TR>";
    }
    print STDOUT $tail;

    print STDOUT "\n<!-- end of hitlist table/form -->\n";
    print STDOUT "</TABLE></TD>\n</TR>\n</TABLE>\n";

    #------- Produce bottom navigation table -------
    if(($retrieved > $pagesize || $startrow > 1) && !$pf) {
      my $html=$template{'bottomNav'};
      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
    }
    elsif (!$pf) {print STDOUT "<br/><br/>";}

    #------- Produce the choose fields/printer friendly table, if appropriate -------
    if ($show_field_choice || $printer_friendly_button) {
      # (When this section was "template"d, we didn't do a derwent template as well.
      #  But, we did leave the code capable of filling one.)
      my $html=$template{'choose'};
      my @choices;

      if ($derwent) {
        # @choices = qw(PATN PD CLAS ASSC INVT TITLE SCORE);
        @choices = qw(PATN PD CLAS ASSC INVT TITLE IMG AB SCORE);
      } else {
        # @choices = qw(PD AD DP CLAS ASSG TITLE SCORE);
        @choices = qw(VDKVGWKEY PD AD DP CLAS ASSG TITLE IMG AB SCORE DWT INVT);
      }

      foreach my $col (@choices) {
        $info{"choose${col}checked"}=($col_pos{$col})?"checked":"";
        if ($sortname eq $col) {
          # (The template gets really ugly if we can't include this smidge of html)
          $info{"ul$col"}="<U>";
          $info{"eul$col"}="</U>";
          $info{"selected$col"} = "SELECTED";
        } else {
          $info{"ul$col"}="";
          $info{"eul$col"}="";
          $info{"selected$col"} = "";
        }
      }
      $info{'chooseAllChoices'}="@choices";

      # We resort to brute force to set the proper items selector selected since
      # all of my Javascript attempts failed to work on all browsers.
      # So, this code has to change if "Items per page" ever changes.
      foreach my $items (10, 20, 50, 100, 200, 500) {
        $info{"select${items}"}=($items==$pagesize)?"selected":"";
      }

      if ($printer_friendly_button) {
        $info{'chooseIncludePF'}="";
        $info{'chooseEndIncludePF'}="";
      } else {
        $info{'chooseIncludePF'}="<!--";
        $info{'chooseEndIncludePF'}="-->";
      }

      if ($show_field_choice) {
        $info{'chooseInclude'}="";
        $info{'chooseEndInclude'}="";
      } else {
        $info{'chooseInclude'}="<!--";
        $info{'chooseEndInclude'}="-->";
      }
      $info{'chooseColor'}=$showsort_color;


      if (($userLevel =~ /unlimited/) && !$pf ) {
         $info{'legendInclude'}="";
         $info{'legendEndInclude'}="";
      }

      my ($thumbnailAccessCtrl, $abstractAccessCtrl, $dwTitleAccessCtrl);
      if ($userLevel !~ /premier|unlimited/) {
         $thumbnailAccessCtrl = qq!<td align="center"><a href="/access_control/go.html.en/fields" id="FLD_ID"><img src="/art/checkbox_grayed.gif" border="0"/></a></td>!;
         $abstractAccessCtrl = $thumbnailAccessCtrl;
         $dwTitleAccessCtrl = $thumbnailAccessCtrl;
         $thumbnailAccessCtrl =~ s/FLD_ID/chIMG/;
         $abstractAccessCtrl =~ s/FLD_ID/chAB/;
         $dwTitleAccessCtrl =~ s/FLD_ID/chDWT/;
      }
      else {
         $thumbnailAccessCtrl = qq|<td><INPUT TYPE="CHECKBOX" NAME="-i2" VALUE="IMG" ID="chIMG" <!--chooseIMGchecked-->></td>|;
         $abstractAccessCtrl = qq|<td><INPUT TYPE="CHECKBOX" NAME="-i6" VALUE="AB" ID="chAB" <!--chooseABchecked-->></td>|;
         $dwTitleAccessCtrl = qq|<td><INPUT TYPE="CHECKBOX" NAME="-i11" VALUE="DWT" ID="chDWT" <!--chooseDWTchecked-->></td>|;
      }
      $thumbnailAccessCtrl .= qq|<td><FONT FACE="Geneva,Arial,Helvetica" SIZE="-1"><!--ulIMG--><label for="chIMG">Thumbnail</label><!--eulIMG-->&nbsp;</FONT></td>|;
      $abstractAccessCtrl .= qq|<td><FONT FACE="Geneva,Arial,Helvetica" SIZE="-1"><!--ulAB--><label for="chAB">Abstract</label><!--eulAB-->&nbsp;</FONT></td>|;
      $dwTitleAccessCtrl .= qq|<td NOWRAP><FONT FACE="Geneva,Arial,Helvetica" SIZE="-1"><!--ulDWT--><label for="chDWT">Derwent Title</label><!--eulDWT-->&nbsp;</FONT></td>|;
      $html =~ s/<!--thumbnailAccessCtrl-->/$thumbnailAccessCtrl/g;
      $html =~ s/<!--abstractAccessCtrl-->/$abstractAccessCtrl/g;
      $html =~ s/<!--dwTitleAccessCtrl-->/$dwTitleAccessCtrl/g;
      $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
      print STDOUT $html;
    } # field choice table
  } else {  # 0 hits
    my $html = $template{'0results'};

    $info{'caseNoItems'}="<!--";
    $info{'caseEndNoItems'}="-->";
    $info{'caseSyntaxError'}="<!--";
    $info{'caseEndSyntaxError'}="-->";
    $info{'caseTooComplex'}="<!--";
    $info{'caseEndTooComplex'}="-->";
    $info{'caseTranslationHint'}="<!--";
    $info{'caseEndTranslationHint'}="-->";
    $info{'errorCode'}="0";
    $info{'errorDetails'}="";
    $info{'errorDetails2'}="";
    $info{'errorDetails3'}="";
    $info{'errorDetails4'}="";
    my $errorDetails="";

    if ($rc == -40) {
      $info{'caseSyntaxError'}="";
      $info{'caseEndSyntaxError'}="";
      $info{'errorDetails'}="No further details available";

      # Get some more information from the tunnel server
      my $chk_url_to_call = "";
      if ($delphionCookie{"Tunnel"}) {
        $chk_url_to_call = $delphionCookie{"Tunnel"};
      } elsif ($url_to_call =~ /^(.*)(\/fcgi-bin\/)/) {
        $chk_url_to_call = "$1/fcgi-bin/chkquery";
      }
      if ($chk_url_to_call) {
        my $ua = LWP::UserAgent->new;
        my $res = $ua->request(POST $chk_url_to_call,
           [ 'query' => $query,   # no urlencode!
             'chktype' => "-40",
             'debug' => $debug
           ]);
        if ($res->is_success) {
          my $get_stdout = $res->content;
          # we expect 5 lines:
          # rc: -40
          # Syntax error in query string near character dd
          # the two lines of ruler information
          # and the query
          # with the brs tunnel we may get the 6th line - translation hint
          if ($get_stdout =~ /rc: -40\nSyntax error in query string near character (\d+)\n/m) {
            my $dd = $1 - 1;
            my @a = split(/\n/, $get_stdout);
            $errorDetails = $1;  # used to be $a[1], but Marketing didn't like the Verity msg
            # $a[2] and $a[3] are ruler lines
            $info{'errorDetails2'} = minimal_htmlencode(substr($a[4],0,$dd));
            $info{'errorDetails3'} = minimal_htmlencode(substr($a[4],$dd));
            if ($delphionCookie{"Tunnel"} && $a[5]) {
              # BRS tunnel will can give translation suggestion if the query uses the old syntax
              $info{'caseTranslationHint'}="";
              $info{'caseEndTranslationHint'}="";
              $info{'errorDetails4'} = minimal_htmlencode($a[5]);
            }
            $info{'errorCode'} = 6;
          } else {
            $errorDetails = $get_stdout;
            $info{'errorCode'} = 7;
          }
        }
        else {
          $errorDetails = "Error ".$res->code.", ".$res->message;
          $info{'errorCode'} = 7;
        }
      }
    } elsif ($rc == 11 || $rc == 111) {
      $info{'caseTooComplex'} = "";
      $info{'caseEndTooComplex'} = "";
      if (($rc == 11) &&
          ($errormsg =~ /(Too many words match )(\<Wildcard\> )(.*?) in Partition/)) {
        $errorDetails = "$3";
        $info{'errorCode'} = 5;
      } elsif ($rc == 111 && $errormsg =~ /^(\d+)( .*)/) {
        $info{'errorCode'} = $1;
      } else {
        $errorDetails = $errormsg;  # (only can be seen if you view source)
      }
    } else {
      $info{'caseNoItems'} = "";
      $info{'caseEndNoItems'} = "";
    }
    if ($errorDetails){
      # Not sure why this HTMLencodes, since text is only within JS array.
      $info{'errorDetails'} = minimal_htmlencode($errorDetails);
      # Replace newlines in value, else JS array breaks
      $info{'errorDetails'} =~ s/\n/ /g;
    }
    $html=~s/\<\!\-\-(\w+)\-\-\>/$info{$1}/g;
    print STDOUT $html;
  }
  if ($processed && ($lval =~ /$TrackableApp/ || $appName eq 'currentResults' && $lval eq 'refine')) {trackQuery($retrieved, $processed);}

  #------- Produce site-wide trailer -------
  if ($pf) {  # printer friendly
    print STDOUT "</TD></TR></TABLE>\n",
      qq|<CENTER><FONT CLASS="nav">&copy; 1997-2004 Thomson Delphion</FONT></CENTER>\n|,
      "</BODY>\n</HTML>\n";
  } else {  # normal
    OutputTrailer();
  }

  #------- If this is a saved search, update the associated timestamp -------
  if ($qid) {
    my $nchost_internal = $ENV{'NCHOST_INTERNAL'};
    if (!defined($nchost_internal)) {  # should not happen; try something semi-sane
      $nchost_internal = $nchost;
      $nchost_internal =~ s/https/http/;
      warn "NCHOST_INTERNAL not in environment, using $nchost_internal\n";
    }
    warn "doing: $nchost_internal/cgi-bin/ncommerce3/IPNqrytime?qid=$qid\n" if ($debug);
    my $ua = LWP::UserAgent->new;
    my $res = $ua->request(POST "$nchost_internal/cgi-bin/ncommerce3/IPNqrytime",
       [ 'qid' => $qid ]);
    my $get_stdout="";
    if ($res->is_success) {
        $get_stdout = $res->content;
    } else {
        $get_stdout = "Error ".$res->code.", ".$res->message;
    }
    if ($get_stdout !~ /ok/i) {
      warn "$patsearch: bad result from update of timestamp for qid=$qid\n$get_stdout\n";
    }
  }

  # Done with preferences
  undef %preferences;

} # g1OutputFilter

# Add selected items or query result to new or existing workfile
# (Uses global variables set when parsing each request.)
sub ManageWorkfile {
  my $hitlist = "";
  my $hitdb = "";
  my $hitts = "";
  my $wlref = $SARRAY{"wlref"};
  my $add = $SARRAY{"add"};
  my $wlname = $SARRAY{"wlname"};
  my $pn = "";
  my $location;

  if(defined $SARRAY{"url"}) {
    $location = $SARRAY{"url"};
    delete $SARRAY{"url"};
  } else {
    $location = "$nchost/hm?cmd=WLManager&mode=editadd&-m=$pagesize&-o=$SARRAY{'-o'}&-i=" . urlencode($SARRAY{'-i'});
  }

  if(defined($wlref)) {
    $wlref = "" if($wlref eq "0");
    delete $SARRAY{"wlref"};
  } else {
    $wlref = "";
  }

  if(defined($add)) {
    delete $SARRAY{"add"};
  } else {
    $add = "";
  }

  if(defined($wlname)) {
    delete $SARRAY{"wlname"};
  } else {
    $wlname = "";
  }

  if($add eq "items") {
    $pn .= join(',', @pn);
  } elsif($add eq "all") {
    my $ua = LWP::UserAgent->new;
    # The request parameters have been filtered. Pass them on
    $SARRAY{"-m"} = "0";
    $SARRAY{"-g"} = "9";
    $SARRAY{"-l"} = "workFile";

    my $res=$ua->request(POST "$url_to_call", \%SARRAY);
    if($res->is_success) {
      my $pooldata=$res->content;

      $pooldata=~s/\n/ /g;
      $hitlist="";
      $hitdb="";
      $hitts = "";
      if ($pooldata !~ /IPSRUN\.(HL_POOL\d\d\d\d)\s+(\w+)\s+([\d\-\:\+\.]+)\s+/) {
        return displayHtmlError("Internal Error\nCannot process your request at this time\n"
                                . "Reason: No Pool Data. Please go back and try again");
      }
      $hitlist=lc($1);
      $hitdb=lc($2);
      $hitts=lc($3);
      $pn = "";
    } else {
       return displayHtmlError("Internal Error ($res->code : $res->message)\n"
                               . "Cannot process your request at this time\n"
                               . "Reason: Could not tunnel. Please go back and try again");
    }
  } else {
    return displayHtmlError("Internal Error\nCannot process your request at this time\n"
                            . "Reason: Invalid parameters. Please go back and try again");
  }

  # Redirect to Net.Commerce workfile pages
  if($wlref) {  # Add to an existing workfile
    my $AddPopUrl = '/hm?cmd=ExecJSP&jsp=wl/WLAddPop.jsp&wlref=$' . '(wlref)&added_pn=$' . '(count)&wlname=' . urlencode($wlname);
    $location .= "&wlref=$wlref&url=" . urlencode($AddPopUrl);
  }
  if (!$hitlist) {
     if ((length($location) + length("&pn=$pn")) > 2083) {
       my @retHlist; # 0 is hl table name, 1 is last modified
       if (getHitTable($SARRAY{"GENERAL"}, @pn + 0, @retHlist) && insertHitTable($retHlist[0], @pn)) {
         ($hitlist, $hitdb, $hitts)  = ($retHlist[0], $dbname, $retHlist[1]);
         $hitlist =~ s/^IPSRUN[.]//i;
       }
       else {
         return displayHtmlError("Internal Error\nCannot process your request at this time\n"
                                 . "Reason: Workfile database failure. Please go back and try again");
       }
     }
     else {
      $location .= "&pn=$pn";
     }
  }
  if($hitlist) {
    my $ehitts = urlencode($hitts);
    $location .= "&hl=$hitlist&d=$hitdb&ts=$ehitts";
  }

  select(STDOUT); $| = 1;
  print "Location: $location\n";
  print "Content-type: text/html\n\n";
} # ManageWorkfile

# Subroutine to just pass the output file on to the user
sub g3PassThru
{
  use File::Basename;

  if (-z $response_html) {
    # no output file returned, try one more time if not localhost
    if ($default_verity_server !~ "localhost") {
      print STDERR "patsearch httppost retried\n";
      sleep 1;  # give a dead patquery time to restart
      system "$httppost $httppost_mode \"$url_to_call?\" $qsfilename $response_html >$response_http;" ;
    }
    if (-z $response_html) {  # give up
      chop(my $ts = `date +%T`);
      print STDERR "$ts: patsearch httppost returned no data\n";
      print STDOUT "Content-type: text/html\n\n";
      print STDOUT "No response from search server; please try later";
      print STDOUT "<BR>SINPUT: |$SINPUT|" if ($debug);
      return;
    }
  }
  # Just write the whole output file to STDOUT
  select(STDOUT); $| = 1;
  print STDOUT "Content-type: text/xml\n\n";
  system("cat $response_html");
} # g3PassThru

sub urlencode {
  my ($url)=@_;
  $url=~s/([ -~])/$urlenc{$1}/g;
  return $url;
}

# Subroutine to minimally "htmlencode" a string
sub minimal_htmlencode {
  my ($text) = @_;
  $text =~ s/&/\&amp;/g;  # Must be first
  $text =~ s/</\&lt;/g;
  $text =~ s/>/\&gt;/g;
  $text =~ s/\"/\&quot;/g;
  return $text;
}
# renderImg() - returns HTML to create Thumbnail
sub renderThumbnail($$$$)
{
  my ($patn_in, $image_pages_in, $drawing_pg_in, $isMouseover) = @_;
  my $drawing_page_url = $drawing_pg_in ? "&PAGE=$drawing_pg_in" : "";
  my $drawing_pg_html = $drawing_pg_in ? qq!<FONT SIZE="-2">(p$drawing_pg_in/$image_pages_in)</FONT>! : "";
  # if server has www in it its a production machine - just use root doc specifier and not full name
  my $viewpat_url = ($server =~ /www/i) ? "/" : "$hprefix://www7.delphion.com/";
  $viewpat_url .= "cgi-bin/viewpat.cmd";

# "here" document gets returned
my $retVal = <<EOF
<hr/>
<SCRIPT LANGUAGE="JavaScript">
var img$patn_in = new Image();
</SCRIPT>
<CENTER><A HREF="$viewpat_url/$patn_in?MODE=fstv&OUT_FORMAT=pdf" TARGET="_blank"
EOF
;
if ($isMouseover) {
   $retVal .= qq|onMouseover="img$patn_in.src='$viewpat_url/$patn_in?&download_only=yes&BPS=8&HEIGHT=&SCALE=' + Math.max((img$patn_in.height / 3408), 0.025); return true;"|;
   $retVal .= qq|onMouseout="img$patn_in.src='$viewpat_url/$patn_in?crop=1&PAGES=$image_pages_in$drawing_page_url'; return true;"|;
}
$retVal .= <<EOF
><IMG SRC="$viewpat_url/$patn_in?crop=1&PAGES=$image_pages_in$drawing_page_url"
BORDER="0" VALIGN="BOTTOM" onError="this.src='/art/1x1.gif';"
ID="img$patn_in" NAME="img$patn_in" /></A></CENTER>
$drawing_pg_html
EOF
;
return $retVal;
}

$main::isInitDb2Abst;

sub getAbstract($$)
{
  my ($patn, $datasrc) = @_;
  my $flbl = "getAbstract() error: ";
  my $language = $main::language ? $main::language : "EN";  # language same as abl in hitlist.d2w
  use constant AbstMaxLen => 2000;

  # valid abst.type values - ABST EQU FNT HD HDR PA0 PA1 PA2 PA3 PA4 PAC PAL PAR PARA PAT TBC TBL
  # distinct abst.datasrc values - DEW EPA IFD PAJ PCT UPA USG WO
  if (!$main::isInitDb2Abst) {
    $main::isInitDb2Abst = 1;
    if ($db2h) {
      my $db2AbstStmt = <<EOF
        SELECT patn, SUBSTR(ilang, 1, 2) AS ilang, num, pav AS pav_c, pal AS pal_c, type,
          CASE
           WHEN UPPER(SUBSTR(ilang,1,2)) = UPPER('$language') THEN 'AA'
          ELSE ilang
          END AS ilang_sort
        FROM   inst1.abst
        WHERE  patn = ? and  (0=? or datasrc = ?)
        ORDER BY ilang_sort ASC, num ASC
        FOR FETCH ONLY
EOF
;
      $main::db2AbstSth = $db2h->prepare($db2AbstStmt);
      unless ($main::db2AbstSth) {warn "Could not prepare the abst select", $db2h->errstr; return;}
    } else {
      warn "Db handle not opened during intialization, Abstracts not retrieved $PQDATABASE\n", $DBI::errstr;
      return;
    }
  }
  if ($main::db2AbstSth) {
    my $stmth = \$main::db2AbstSth; # get ref just for more compact code
    my ($qpatn, $ilang, $num, $pav_c, $pal_c, $type, $ilang_sort); # select list
    my ($ilang_first, $ilang_last, $ret);
    my $abl = $language;
    my $ul1; # seems like not assigned anything in hitlist
    my $rowct = 0;
    my $language = $main::language ? $main::language : 'EN';
    my ($ul1, $ab_length, $ab_elipses, $wlref_url); # wlref_url just a dummy variable for hitlist compatibility

    unless ($$stmth->bind_param(1, $patn)) {warn $flbl . "patn=$patn" . $$stmth->errstr . "\n"; return;}
    unless ($$stmth->bind_param(2, length($datasrc))) {warn $flbl . "length(datasrc)=" . length($datasrc) . $$stmth->errstr . "\n"; return;}
    unless ($$stmth->bind_param(3, $datasrc)) {warn $flbl . $$stmth->errstr . "datasrc=$datasrc" . "\n"; return;}
    unless ($$stmth->execute) {warn $flbl . $$stmth->errstr; return;}
    unless ($$stmth->bind_columns(undef, \$qpatn, \$ilang, \$num, \$pav_c, \$pal_c, \$type, \$ilang_sort)) {print stmth->errstr . "\n"; return;}
    while ($$stmth->fetch()) {
      $rowct++;
      trim($qpatn, $type, $ilang_sort);
      if ($rowct == 1) {
         $ilang_first = $ilang;
         $ilang_last = $ilang
      }
      if ($ilang eq $ilang_last && AbstMaxLen && $ab_length >= AbstMaxLen) {
         if (!$ab_elipses) {
            $ret .= qq![<A HREF="! . details_url(undef) . qq!pn=$patn$wlref_url#AB">continued...</A>]!;
            $ab_elipses = 1;
         }
      }
      elsif ($ilang eq $abl || !$abl && $ilang eq $language || $ilang eq $ilang_first) {
         my $clob_name1 = $pav_c ? $pav_c : $pal_c;
         if ($clob_name1) {text_filter_sed($clob_name1);}
         if ($type eq "STM" || $type eq "PAL" || $type eq "RE1" || $type eq "RE2") {
            $ret .= ul1_close(\$ul1) . $clob_name1;
         } elsif ($type eq "PAR") {
            if ($patn =~ /^EP/) {
               $clob_name1 =~ s/\<P ALIGN="LEFT"\>/\<x align="bug2311"\>/gi;
               $clob_name1 =~ s/\<\/P\>/<\/x>/gi;
            }
            $ret .= ul1_closebr(\$ul1) . "&#160;&#160;&#160;&#160;" . $clob_name1;
         } elsif ($type eq "PAC") {
           $ret .=  ul1_close(\$ul1) . "<P><CENTER>" . $clob_name1 . "</CENTER>";
         } elsif ($type eq "PA0" || $type eq "PA1") {
            $ret .= ul1_open(\$ul1) . "<LI>" . $clob_name1 . "</LI>";
         } elsif ($type eq "PA2") {
            $ret .= ul1_open(\$ul1) . "<UL><LI>" . $clob_name1 . "</LI></UL>";
         } elsif ($type eq "PA3") {
            $ret .= ul1_open(\$ul1) . "<UL><UL><LI>" . $clob_name1 . "</LI></UL></UL>";
         } elsif ($type eq "PA4") {
            $ret .= ul1_open(\$ul1) . "<UL><UL><UL><LI>" . $clob_name1 . "</LI></UL></UL></UL>";
         } elsif ($type eq "TBL") {
            $ret .= ul1_closebr(\$ul1). "<PRE>" . $clob_name1 . "</PRE>";
         } elsif ($type eq "EQU") {
           $ret .= "<BR />&#160;&#160;&#160;&#160;$clob_name1<BR />";
         } else {
            $ret .= ul1_closebr(\$ul1) . $clob_name1;
         }
         if (AbstMaxLen) { # if stmt just to use same logic as hitlist.d2w
            $ab_length += length($clob_name1);
         }
      }
      elsif (($num == 1 || $ilang ne $ilang_last) && !$pf) {
         my $txt_pf_sclm = "Show in " . formatILang($ilang);
         $ret .= "<BR /><A HREF=\"" . details_url(undef) . "pn=$patn$wlref_url&abl=$ilang#AB\" MPTYPE=\"SKIP\">[$txt_pf_sclm]</A><BR />";
         $ilang_last = $ilang;
      }
    }
    return $ret;
  }
  else {
     warn "Abstracts not retrievable, db2AbstSth variable has been undefined - internal error";
  }
  return;  # error
}

sub details_url($)
{
   my ($language) = @_;
   my ($lang_url, $details_url, $details_amp);
   my ($tbd, $dw);

   if ($language eq "" || $language eq "en") {
     $lang_url = "";
   } else {
     $lang_url = "&language=$language"
   }
   my $mt_url; # temporary, need to find out what this is
   if ($mt_url || $lang_url) {$details_amp = "&";}

   $details_url = "/details?$lang_url$mt_url$details_amp";
   if ($tbd) {$details_url = "/tdbs/tdb?";}
   if ($dw) {$details_url = "/derwent/dwdetails?";}
   return $details_url;
}

sub formatILang($)
{
   my ($ilang_in) = @_;
   my $ilang_out;
   my $lang_pref = substr($ilang_in, 0, 2);
   if ($lang_pref eq "EN") {$ilang_out = "English";}
   elsif ($lang_pref eq "FR") {$ilang_out = "French";}
   elsif ($lang_pref eq "DE")  {$ilang_out = "German";}
   elsif ($lang_pref eq "IT")  {$ilang_out = "Italian";}
   elsif ($lang_pref eq "JP" || $lang_pref eq "JA") {$ilang_out = "Japanese";}
   elsif ($lang_pref eq "ES") {$ilang_out = "Spanish";}
   elsif ($lang_pref eq "NL") {$ilang_out = "Dutch";}
   else  {$ilang_out = $ilang_in;}
   return $ilang_out;
}

sub ul1_open($)
{
   my $ul1 = $_[0];
   if ($$ul1) {return "";}
   else {$$ul1 = "yes"; return "<ul>";}
}
sub ul1_close($)
{
   my $ul1 = $_[0];
   if ($$ul1) {undef $$ul1; return "</UL>";}
   else {return "";}
}
sub ul1_closebr($)
{
   my $ul1 = $_[0];
   if ($$ul1) {undef $$ul1; return "</UL>";}
   else {return "<bR/>";}
}
sub trim(\$;\$\$\$\$)
{
   while (my $p = shift)
   {
      $$p =~ s/^\s+//;#ltrim
      $$p =~ s/\s+$//;#rtrim
   }
}
sub text_filter_sed(\$)
{
# subset of what's in cgi-bin/text_filter.sed
my $str = $_[0];
if (!$$str) {warn "Must pass reference"; return;}
# This script converts Patent and Trademark Office(PTO) text into HTML
$$str =~ s/\#\#[-A-Za-z0-9]*\#\#/<I>\[Figure\]<\/I>/g;
$$str =~ s/\.sub\.\([-A-Za-z0-9\+\(\)]*\)/<SUB>\1<\/SUB>/g;
$$str =~ s/\.sup\.\([-A-Za-z0-9\+\(\)]*\)/<SUP>\1<\/SUP>/g;
$$str =~ s/\.degree\./\&deg;/g;
$$str =~ s/\.ltoreq\./\&lt;=/g;
$$str =~ s/\.gtoreq\./\&gt;=/g;
$$str =~ s/\.cent\./\&cent;/g;
$$str =~ s/\.times\./\&times;/g;
$$str =~ s/\.div\./\&divide;/g;
$$str =~ s/\.+-\./\&plusmn;/g;
$$str =~ s/\.vertline\./\&#124;/g;
$$str =~ s/\.RTM\./\&reg;/g;
$$str =~ s/\.COPYRG[T]\./\&copy;/g;
$$str =~ s/\.mu\./\&micro;/g;
$$str =~ s/\.sctn\./\&sect;/g;
$$str =~ s/\.O\./\&Oslash;/g;
$$str =~ s/\.o slashed\./\&oslash;/g;
$$str =~ s/\.ae butted\./\&aelig;/g;
$$str =~ s/\.dbd\./=/g;
$$str =~ s/\.about\./\&#126;/g;
$$str =~ s/\.backslash\./\&#92;/g;
# Because the pctft converter produces a non-html entity, we need:
$$str =~ s/&apos;/'/g;
# The following are generated by Alex's parse
$$str =~ s/\\T/<BR>/g;
$$str =~ s/\\A/\&/g;
$$str =~ s/\\V/\&#124;/g;
$$str =~ s/\&#92;V/\&#124;/g;
$$str =~ s/\&bull;/\&#8226;/g;
$$str =~ s/\\\\/\\/g;
# | is generated by os_aix.d2w's TRANSLATE of  <
#s/\([^\|]\)\|\([^\|]\)/\1\&lt;\2/g
$$str =~ s/\.alpha\./\&alpha;/g;
$$str =~ s/\.ALPHA\./\&Alpha;/g;
$$str =~ s/\.beta\./\&beta;/g;
$$str =~ s/\.BETA\./\&Beta;/g;
$$str =~ s/\.bgr\./\&#223/g;
$$str =~ s/\.delta\./\&delta;/g;
$$str =~ s/\.DELTA\./\&Delta;/g;
$$str =~ s/\.epsilon\./\&epsilon;/g;
$$str =~ s/\.EPSILON\./\&Epsilon;/g;
$$str =~ s/\.gamma\./\&gamma;/g;
$$str =~ s/\.GAMMA\./\&Gamma;/g;
$$str =~ s/\.nu\./\&nu;/g;
$$str =~ s/\.NU\./\&Nu;/g;
$$str =~ s/\.omega\./\&omega;/g;
$$str =~ s/\.OMEGA\./\&Omega;/g;
$$str =~ s/\.phi\./\&phi;/g;
$$str =~ s/\.PHI\./\&Phi;/g;
$$str =~ s/\.pi\./\&pi;/g;
$$str =~ s/\.PI\./\&Pi;/g;
$$str =~ s/\.rho\./\&rho;/g;
$$str =~ s/\.RHO\./\&Rho;/g;
$$str =~ s/\.theta\./\&theta;/g;
$$str =~ s/\.THETA\./\&Theta;/g;
$$str =~ s/\.function\./\&fnof;/g;
$$str =~ s/\.rarw\./\&rarr;/g;
$$str =~ s/\.larw\./\&larr;/g;
$$str =~ s/\.ident\./\&equiv;/g;
# Have also seen .parallel. .orgate. .multidot. .gradient. .differential. (US06005916__)
$$str =~ s/\.ndash\./\-/g;
# The following are for RE (reissue) patents
# These are especially dangerous, as they open red cross-outs
# All other .xxx. replacements should be placed before these.
$$str =~ s/\.Iadd\./<I><FONT COLOR="GREEN">/g;
$$str =~ s/\.Iaddend\./<\/FONT><\/I>/g;
$$str =~ s/\.Badd\./<B><FONT COLOR="GREEN">/g;
$$str =~ s/\.Baddend\./<\/FONT><\/B>/g;
$$str =~ s/\.\[\./<STRIKE><FONT COLOR="RED">/g;
$$str =~ s/\.\]\./<\/FONT><\/STRIKE>/g;
# Compress whitespace - (Saves 4-5%)
#s/ [ \n]*/ /g
$$str =~ s/ [ ]*/ /g;
$$str =~ s/^[ \n]*</</g;
# To clean the abstracts
$$str =~ s/\$q//g;
# To clean IMAGE tag
$$str =~ s/\<IMAGE\>//;


# Attempt to breakup long Japanese names
$$str =~ s/\([A-Z]\{20\}\)\([A-Z]\{20\}\)/\1 \2/g;

$$str =~ s/\(U[ \.]*S[\ \.]*Pat[ent]*[ \.]*N[osumber]*[ \.][ \.]*\)\([12]\)\([, ][ ]*\)\([0-9][0-9][0-9]\)\([, ][ ]*\)\([0-9][0-9][0-9]\)/\1<A HREF="\/patlist?uref_pno=US0\2\4\6__\&s_all=1">\2\3\4\5\6<\/A>/g;

# For Japanese patents, add a break for PROBLEM and SOLUTION
$$str =~ s/^ PURPOSE/<B>Purpose<\/B>/g;
$$str =~ s/^ CONSTITUTION/<BR><B>Constitution<\/B>/g;
$$str =~ s/^ COPYRIGHT/<BR>COPYRIGHT/g;
$$str =~ s/^ PROBLEM TO BE SOLVED/<B>Problem to be solved<\/B>/g;
$$str =~ s/^ SOLUTION/<BR><B>Solution<\/B>/g;

# Conversion of <img>somthing</img> into <img src="/art/bmp/low/something.gif">
$$str =~ s/\(<img>[ ]*\)\(.*\)\(\.BMP[ ]*<\/img>\)/<img src="\/art\/bmp\/low\/\2\.gif\" ALIGN="TOP">/g;

# no need to explicitly return $$str is string passed by reference (not by value/copy)
}
sub hashDump(\%)
{
   my $h = $_[0];
   my $retVal;
   foreach my $keyval (sort keys %$h) {
      if ($retVal) {$retVal .= ",";}
      $retVal .= $keyval . "=" . $$h{$keyval};
   }
   return $retVal;
}
# sortFields - First param is array to be sorted, second parameter array sort key
sub sortFields(\@\@)
{
   my ($fields, $field_order) = @_;
   my ($curr_col_idx, $curr_field_idx) = (0, 0);
   foreach my $curr_col_order (@$field_order) {
      $curr_field_idx = 0;
      foreach my $curr_field (@$fields) {
         if ($curr_field_idx < $curr_col_idx) {$curr_field_idx++; next;}
         if ($curr_col_order eq $curr_field) {
            if ($curr_col_idx != $curr_field_idx) {
               my $tmp_curr_field = $curr_field;  # seems like curr_field is reference
               $$fields[$curr_field_idx] = $$fields[$curr_col_idx];
               $$fields[$curr_col_idx] = $tmp_curr_field;
            }
            $curr_col_idx++;
            last;
         }
         $curr_field_idx++;
      }
   }
   $curr_col_idx--;
   # truncate if duplicate names in fields
   if ($#$fields != $curr_col_idx) {$#$fields = $curr_col_idx;}
   # returns modified @$fields array which is passed by reference
}
sub getUserLists($)
{
   my $shopperid_in = $_[0];

   if ($shopperid_in) {
      my $divrem = $shopperid_in % 100;
      if ($divrem < 10) {
         $divrem = "0" . $divrem;
      }
      # each shopper/user has file with info/prefs, 00-99 directories provide some structure
      my $fname = "$IPNROOT/preferences/$divrem/$shopperid_in";
      %preferences = readproperties("$fname.properties");
      if (-e $fname) {
         if (open(PREFS, $fname)) {
            undef $/;
            my $complete_file = <PREFS>;
            close(PREFS);
            $/ = "\n";
            return $complete_file;
            return $complete_file;
         }
         else {
            warn "Unable to open $fname";
            return ""; # Return static empty string
         }
      }
   }
   return undef;
}
sub getPndisp(\$$)
{
   my ($pndisp, $pn2) = @_;
   # we now change the patent number for display, as requested by marketing
   if ($pn2 eq "US") {
      if ($$pndisp =~ /US2/) {
         $$pndisp =~ s/US2(.)/US200${1}0/;
      } else {
         # strip all leading 0's, keeping at least the last digit of the number
         $$pndisp =~ s/^US([A-Z]*)(0*)(?=\d)/US${1}/;
      }
   } elsif ($pn2 eq "JP") {
      $$pndisp =~ s/JP2(.)/JP200$1/;
   } elsif ($pn2 eq "WO") {
      # remove 1st zero, if part of a 0yy12345 number, and not part of a yy123456
      $$pndisp =~ s/^(..)0([^1-6])/$1$2/;
   } elsif ($pn2 eq "DE") {
      if (!%main::deIpRight) {
         # Translation table for German/DE "IP Right" abbreviations.  Done to scrunch German patents into patn char(12) field
         %main::deIpRight = (
         "A" => "10",
         "B" => "11",
         "C" => "12",
         "K" => "20",
         "L" => "21",
         "M" => "22",
         "U" => "50",
         "X" => "60");
      }
      $$pndisp =~ s/^DE([ABCKLMUX])/DE$main::deIpRight{$1}200/;
      $$pndisp =~ s/^(..)0/$1/;  # remove one leading zero, if present
   } else {
      $$pndisp =~ s/^(..)0/$1/;  # remove one leading zero, if present
   }
   $$pndisp =~ s/_//g;
}
sub insertHitTable($\@)
{
   my ($hitTbl, $pn) = @_;
   my $db2HlistIStmt = "INSERT INTO $hitTbl (patn, score) VALUES (?, 1)";
   my ($db2HlistIh, $retCt, $rct);
   unless ($db2HlistIh = $db2h->prepare($db2HlistIStmt)) {warn "dbi->prepare of $db2HlistIStmt failed, db msg: " . $db2h->errstr; return 0;}
   my @parray;
   foreach my $patn (@$pn)
   {
      $rct++;
      push(@parray, $patn);
      if (@parray == 500 || $rct == @$pn) {
         # $db2HlistIh->bind_param_array(1, \@parray);
         my @insert_status;
         $db2HlistIh->execute_array({ArrayTupleStatus => \@insert_status}, \@parray);
         for (my $i = 0; $i < @insert_status; $i++) {
            if ($insert_status[$i]) {$retCt += $insert_status[$i];}
            else {
               warn "insert_status of 0 returned by array insert to $hitTbl\n";
               return 0;
            }
         }
         undef @parray;
      }
   }
   return $retCt;
}
sub getHitTable($$\@)
{
   my ($query, $hitct, $retHlInfo) = @_;
   my ($retHitTableName, $retLastModified);
   if (!$main::db2Hlisth) {
      my $db2HlistStmt = "SELECT MIN(tablename) FROM ipsrun.hitlists WHERE lastmodified = (SELECT MIN(lastmodified) FROM ipsrun.hitlists WHERE lastmodified <= (CURRENT TIMESTAMP - 1 MINUTES))";
      unless($main::db2Hlisth = $db2h->prepare($db2HlistStmt)) {warn "Failed to prepare ipsrun.hitlists query, db msg: " . $db2h->errstr; return undef;}
      my $db2HlistUStmt = "UPDATE ipsrun.hitlists SET itemstoshow = 0, cutoff = 20000, hitsreturned = ?, itemssearched = ?, query = ?, collections = '', errcode = 0 WHERE tablename = ?";
      unless($main::db2HlistUh = $db2h->prepare($db2HlistUStmt)) {warn "Failed to prepare ipsrun.hitlists update, db msg: " . $db2h->errstr; return undef;}
      my $db2HlistTStmt = "SELECT lastmodified FROM ipsrun.hitlists WHERE tablename = ?";
      unless($main::db2HlistTh = $db2h->prepare($db2HlistTStmt)) {warn "Failed to prepare ipsrun.hitlists lastmodified query, db msg: " . $db2h->errstr; return undef;}
   }
   elsif (!$main::db2HlistUh) {
      return undef;
   }
   my $db2Hlisth = $main::db2Hlisth;
   my $db2HlistUh = $main::db2HlistUh;
   my $db2HlistTh = $main::db2HlistTh;
   unless ($db2h->begin_work) {warn "Failed dbi->begin_work in getHitTable, db msg: " . $db2h->errstr; return undef;}
   unless ($db2Hlisth->execute) {warn "Failed pstmt->execute to query ipsrun.hitlists, db msg: "  . $db2h->errstr; $db2h->rollback; return undef;}
   unless ($db2Hlisth->bind_columns(undef, \$retHitTableName)) {warn "pstmt->bind_columns failed for query of ipsrun.lists, db msg: "  . $db2h->errstr; $db2h->rollback; return undef;}
   while ($db2Hlisth->fetch()) {
   }
   if ($retHitTableName) {
      unless ($db2HlistUh->bind_param(1, $hitct)) {warn "pstmt->bind_param failed for ipsrun.hitlists, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2HlistUh->bind_param(2, $hitct)) {warn "pstmt->bind_param failed for ipsrun.hitlists, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2HlistUh->bind_param(3, $query)) {warn "pstmt->bind_param failed for ipsrun.hitlists, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2HlistUh->bind_param(4, $retHitTableName)) {warn "pstmt->bind_param failed for ipsrun.hitlists, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2HlistUh->execute) {warn "update of ipsrun.hitlists failed, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2h->commit) {warn "Failed dbi->commit in getHitTable, db msg: " . $db2h->errstr; $db2h->rollback; return undef;}
      unless ($db2HlistTh->bind_param(1, $retHitTableName)) {warn "pstmt->bind_param failed for ipsrun.hitlists, db msg: " . $db2h->errstr; return undef;}
      unless ($db2HlistTh->execute) {warn "Failed pstmt->execute to query ipsrun.hitlists, db msg: "  . $db2h->errstr; return undef;}
      unless ($db2HlistTh->bind_columns(undef, \$retLastModified)) {warn "pstmt->bind_columns failed for query of ipsrun.lists, db msg: "  . $db2h->errstr; return undef;}
      while ($db2HlistTh->fetch()) {
      }
      my $delCt;
      unless (($delCt = $db2h->do("DELETE FROM $retHitTableName"))) {warn "delete $retHitTableName failed, db msg: " . $db2h->errstr; return undef;}
      @$retHlInfo = ($retHitTableName, $retLastModified);
      return 1;
   }
   else {
      $db2h->rollback;
      warn "Didn't fetch tablename from ipsrun.hitlists - unexpected error";
      return undef;
   }
}

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

sub url_decode($) {
  # default argument is $_
  local $_ = @_ ? shift : $_;
  defined or return;

  # change + signs to spaces
  tr/+/ /;

  # change hex escapes to the proper characters
  s/%([a-fA-F0-9]{2})/pack "H2", $1/eg;

  return $_;
}

sub url_encode($) {
   my ($tag) = @_;
   $tag   =~ s/([^ a-zA-Z0-9-_])/sprintf("%%%02lx",unpack('C',$1))/ge;
   $tag   =~ s/[ ]/+/g;
   return $tag;
}
# returns hash (first parameter) with name value pairs, "sub-cookies" return keys like IPNuser.user
sub setDelphionCookie(\%\$) {
   my ($retCookies, $envcookie) = @_;
   my %cookies;
   %cookies = parse CGI::Cookie($$envcookie);
   foreach my $key (keys %cookies) {
      my $val = url_decode(substr($cookies{$key}, length($key) + 1));
      trimPath($val);
      # basic name/val pair - we encode pairs within pairs (for some unknown reason)
      $$retCookies{$key} = $val;
      if ($key eq "IPNuser") {
         my @ipnUser = split(/&/, $val);
         foreach my $ipnval (@ipnUser) {
            my @iarray = split(/:/, $ipnval);
            my $idx = 0;
            my $extendedKey;
            foreach my $ival (@iarray) {
               if (!$idx) {$extendedKey = "IPNuser." . $ival;}
               else {$$retCookies{$extendedKey} = $ival;}
              $idx++;
            }
         }
      }
      else {
         if ($key eq "Ticket") {
            my @iarray = split(/&/, $val);
            my $idx = 0;
            my $extendedKey;
            foreach my $ival (@iarray) {
               $idx++;
               if ($idx % 2) {$extendedKey = "Ticket." . $ival;}
               else {
                 $$retCookies{$extendedKey} = $ival;
                 if ($extendedKey eq "Ticket.features") {
                    my @featureArray = split(/_/, $ival);
                    my $featureIdx = 0;
                    my $featureKey;
                    foreach my $featureVal (@featureArray) {
                       $featureIdx++;
                       if ($featureIdx % 2) {$featureKey = $extendedKey . "." . $featureVal;}
                       else {$$retCookies{$featureKey} = $featureVal;}
                    }
                 }
               }
            }
         }
      }
   }
}
sub trimPath(\$)
{
   my ($cookieval) = @_;
   my $tok = "; path=";
   my $toklen = length($tok);

   my $idx = length($$cookieval) - 1;
   while ($idx >= 0) {
      if (substr($$cookieval, $idx, 1) eq ";") {
         if (substr($$cookieval, $idx, $toklen) eq $tok) {
            $$cookieval = substr($$cookieval, 0, $idx);
            return;
         }
      }
      $idx--;
   }
}
use constant TrackUrl => "http://localhost:8008/ttrack/servlet/IPNTTstub";
sub trackQuery($$)
{
   my ($matched, $searched) = @_;
   my $qterm;
   my $other_params;
   foreach my $skey (keys %SARRAY) {
      if (index($query, $SARRAY{$skey}) == -1 || $skey !~ /^(field|general)/i) {
         $other_params .= "&" . $skey . "=" . url_encode($SARRAY{$skey});
      }
   }
   my $urlParams = "?ttuid=$delphionCookie{'Ticket.id'}&ttck=$delphionCookie{'Ticket.features.tracking'}&ttsearchStr=" . url_encode($query) . "&ttpath=" . url_encode(url_decode($request_uri)) . "&ttid=S&ttcnt=$matched&tttotcnt=$searched";
   if ($other_params) {$urlParams .= "$other_params";}
   callTrack($urlParams);
}
sub callTrack($) {
   my $urlParams = $_[0];
   my $lwpUrl = TrackUrl . $urlParams;
   my $ua = LWP::UserAgent->new(env_proxy => 1,
                              keep_alive => 1,
                              timeout => 30,
                             );
   my $response = $ua->get($lwpUrl);
   if (!$response->is_success) {
      print STDERR "Error while getting " . $response->request->uri .
   " -- " . $response->status_line . "\n";
   }
}
sub flushout($)
{
return unless open(FLUSHOUT, ">>/tmp/patsearch_flush.out");
print FLUSHOUT $_[0] . "\n";
close(FLUSHOUT);
}
# readproperties(): Reads a Java properties file and returns  a hash
#  Up to caller to delete the returned hash
sub readproperties($)
{
  my ($propfile) = @_;
  my (%props);    # Return value: a hash of property values.
  my ($ln,$name,$value,@nv);

  open(PROPFILE,"$propfile") or warn "Unable to open $propfile";
  while ($ln = <PROPFILE>) {
    chomp $ln;
    $ln =~ s/#(.*$)//;    # Remove line comments in the properties file.
    # if ($1 ne "") { print "# $1\n"; }  ### DEBUG ###
    @nv = split /\s*=/,$ln,2;
    $value = pop @nv;
    $value =~ s/^\s*=?\s*//;
    $value =~ s/\s*$//;
    $name = pop @nv;
    $name =~ s/^\s*//;
    $name =~ s/\s*$//;
    if ($name ne "") {
      $props{$name} = $value;
    #  print "$name=$value\n"; ### DEBUG ###
    }
  }
  close(PROPFILE);
  return %props;
}
#------- History -------
# 11/12/98 cht In g1OutputFilter:
#   Added error case handling, and logging, including one
#   retry if no response from httppost the first time (and not localhost)
#   Simplified VALIGN's in the nav section.
#   Special handling for "No Result".
#
# 11/18/98 cht Added handling for "empty args" (which was the cause of
#   all of our verity server 503's)
#
# 11/20/98 cht Added proper "site wrappings" for empty args case
#   (Someday, instead of system("cat ...") we'd like to do:
#    $tail = "<!--#include file=\"$altsearch_file\"-->\n";
#    print STDOUT $tail;
#   Is that possible?)
#   Also, if no "-g" is specified, default to -g=4 if HTTPS is ON (i.e.
#   gold user) and to -g=1 otherwise.
# 11/23/98 cht Have to html encode the "'s in the query so that
#   our HIDDEN query strings get html-parsed correctly.
# 11/30/98 cht Reword the empty args page
# 12/2/98  cht Add pink dots
# 12/7/98  evs Use searchgold if $HTTPS is ON
# 12/11/98 evs Changed filter_NC for new us class rules.
# 01/18/99 evs Changed filter_NC for leading char(s) in us class.
# 02/23/99 cht Determine default verity_server of localhost/searchfree/
#   searchgold based on the environment variable RULE_FILE
# 04/14/99 cht Uhmm, have to get the value from $ENV{'RULE_FILE'} first.
# 04/29/99 cht Eliminate trailing _'s from the displayed patn's for
#   all patents, not just US (Japanese patn's have one trailing _)
# 05/06/99 cht Add k2 option check, and use k2tunnel instead of
#   pattunnel if set.  Remove unused ERROR_MSG option.
#   Carry any vs or k2 options on to the scrolling invocations of
#   patsearch.  Parameterize the httppost mode ($httppost_mode) and
#   make the default be "-g" as it was (so we can grep our logs for
#   various collections and which html page caused the search).
# 05/24/99 cht Pass on language iff it is passed to us, as per Tom's request.
#   Re-organize the PQ_REDIR_URL code a bit because language needs to
#   be passed on here too.
# 05/25/99 cht Parameterize the natural language strings we put out on
#   the hitlist page (so, someday we can read a language dependent
#   file of strings).
# 06/18/99 cht Add ads to the hitlist we generate, ala ipnfb's histlist
#   on penguin (site gold hitlists don't have ads yet).
# 06/24/99 cht Add query refine box and fix headers for gold users,
#   since we are now using gmode=1 for gold searching while db2 is
#   being flakey.
# 07/09/99 cht Major rewrite of g1OutputFilter for gold users (sort + reorg)
# 08/02/99 cht Remove use of SSI $closing_tags global variable for ads
#   and parse the trailer file instead; add gold field select capability.
# 08/03/99 cht Underline current sort column for gold; fix sort_d setting
# 08/05/99 cht Add hitlistbuy and orderbox_at_top options; new sort columns
#   are 1-index based (goes with corresponding patquery change).
# 09/10/99 cht Add Viador chart button (fixed tablename for now)
# 10/16/99 cht Both cluster and Viador chart buttons -- default set by
#   changing show_chart_button and show_cluster_button.  Overridable
#   either by adding &v &c or &vc to the end of a query in the refine
#   query box, or by adding &via=1 and/or &cluster=1 to a patsearch GET
#   flavor url
# 11/03/99 cht Add code to handle patquery's return of the hitlist timestamp
# 11/05/99 cht No check boxes unless US/EP/WO
# 11/11/99 cht Allow order box at both top and bottom; add check for
#   "<in> claims" and if found make sure we are using the correct
#   collection (the advanced and boolean pages are going to have bibonly
#   as default); look for multiple US collections selected as well.
#   (The additions are in inputFilter().)
# 11/15/99 cht Remove the converteer_datum_velden() routine and its call
#   from inputFilter (it replaced Dutch month names with numbers, and
#   also did conversions needed by antique Verity versions, which are
#   not needed/wanted now).
# 11/22/99 cht Filter out any &search, &Search, or &SEARCH argument, so
#   that Search button's can use -name "Search" instead of mis-using
#   -name "-l"
# 02/01/00 cht Add File history order choice. Provide feedback on which
#   collections were searched
# 02/11/00 cht Add WisDomain button
# 03/06/00 cht Ooops. Update patsearch -o values to match the (changed)
#   patquery values (3=isd and 4=ttl now)
# 03/08/00 cht Go figure out what wording Tom used for inpadoc
#   collections, and add it here.  ("INPADOC"? really?).
#   In prep for site consolidation, add a new free-side control variable,
#   $show_sort_arrows.
# 04/10/00 cht Make navigation be strictly in pagesize hunks from 1
# 04/13/00 cht Add special inpadoc collection mapping
# 04/28/00 cht/tdg Improve line-breaking behavior and spacing of the
#   nav line
# 05/04/00 cht Fix bug in checking which US collection should be active
# 05/09/00 tdg Added DEFAULT_GMODE ENV check to override default -g
# 05/12/00 cht Minimal change to make compatible with new patquery
#   (make the sort column numbers correspond to the column numbers of
#   the returned hit data -- score and patn were reversed)
# 05/17/00 cht Old look, but capability for choosing fields (including
#   the new ASSG and CLAS fields which the new patquery provides if
#   asked) and sorting on any field, in "native" patsearch -g 1 mode
#   (i.e. without using db2 hitlists).
# 05/18/00 cht Mostly old look -- redid the "Choose Fields" area,
#   because Sander suggested two buttons and I liked the idea
# 05/19/00 sjb Correct QUOTE filter
# 05/30/00 sjb Fixed missing HTML tag and removed unused ad code. New
#   look. Fixed score sorting. Quoted (almost) all values in HTML tag-value
#   pairs because Tom wanted it to be forward compatible with XML (which
#   it cannot possibly be as HTML doesn't require closing tags for all its
#   tags). Underlining of current sort column in "choose fields". Lookup
#   table for -r
# 06/20/00 cht Removed wisdomain plan select pulldown; improved vertical
#   spacing of the scrolling line; aligned pink dots at the top, where
#   all other items on each hitlist line are valigned.  Lookup table
#   for default sort direction; use /usr/local/bin/perl so we get
#   a self-consistent perl (not just an executable which may or may
#   not have matching libraries on any particular machine)
# 06/22/00 sjb Using FORMs instead of HREFs for sorting
# 06/22/00 cht Add FormatICL, and some more beautification, and a
#   wisdomain gold key.  Also, make all net commerce url's use our
#   $nchost variable (which must change to www2 on Saturday)
# 06/23/00 cht Removed "oldpatquery" code; finished implementation of
#   a hidden sort column; improve Results Analysis formatting
# 06/24/00 cht Put back the code in OutputHeader() to produce ads on our
#   hitlists (sjb removed?).  Tom says do ads for https users too.
#   fixed -r table to use $hprefix instead of always http:// (undid that)
#   and, a little better alignment of the header sort arrows
# 06/26/00 cht Sander removed the nav/scroll table when there is only
#   one patent in the hitlist sometime in June, so, remove the sort
#   arrows for that case too.  Also, Tom says we need to, temporarily,
#   use GET (instead of $GETPOST) for the clusterbox FORM.
# 06/29/00 sjb Added filter_NC comment
# 06/30/00 cht Use elephant as nchost default from penguin; upgraded DUTCH
#   months to include some more European abbreviations; added parse for
#   &nchost=wwwX or elephant or full https:// url -- to change nc server;
#   clean out old $gold code (including no more &gold=1 to hitlist_sql,
#   hitlist_upc, or tdb.d2w).
# 07/05/00 cht Add a few more ALT=xxx to our various gif's (netscape
#   seems to display the NAME's value for gif's, but ie seems to want
#   ALT's)
# 07/11/00 tdg Use a different details_url for derwent
# 07/11/00 cht Set $nchost from 1) supplied args 2) NCHOST in environment
#   3) a value depending on SERVER_NAME.
# 07/12/00 cht In outputheader(), substitute for the $(nchostu) var as
#   we output the header.hti file.
# 07/19/00 cht Added Switzerland as the description of the ch collection
# 07/24/00 cht Added inpadup10 handling for the ch collection
# 08/21/00 cht Removed ch-specific collection code -- that collection was
#   never made public in that form.  Fix a minor typo in the generation
#   of the $chartbox variable.
# 08/23/00 cht Generalize the field choice area a little, and add some
#   minimalist derwent-specific code.
# 08/24/00 cht Add input filter for Derwent week, assigneecode/titleterms
# 09/12/00 cht Fix inpadoc/inpadup handling so that a search for a
#   specific inpadupN collection doesn't cause the addition of inpadup
#   collections (the index fn args were backwards).
# 09/13/00 cht Make date filter Y2K compliant (via Sander's suggestion)
#   also make it easier to set either pattunnel or k2tunnel as the default.
#   Pick up Tom's latest derwent details_url, from patsearch.tom
#   (But not the rest of his incompatible/undocumented mods.)
# 09/25/00 cht Switch to Sander's improved-for-?'s filter_PN()
# 09/26/00 cht Upgrade "claims" searches to patentft
# 10/31/00 cht Changes for delphion.com
# 11/13/00 cht Format our syntax error announcement more boldly; change
#   to using altsearchps.hti, which will include an ip.com link someday
# 12/14/00 cht Put patsearch into cvs.
# 01/26/01 cht In inputFilter, filter out empty FieldTextN guys of the
#   form:  <or>()   <and>()     ()
#   Also fix up our setting of the default tunnel so that it, like our
#   default verity server, depends on the (ugh) RULE_FILE environment var.
# 01/26/01 cht Replaced the html for the search button with DeeJay's
#   .hti file (with Javascript).  Since no server-side include, we have
#   to read that file and concatenate its lines to the variable full of
#   html we are generating.  But, this new Search button is not aligned
#   like our Search button used to be, and, its "alt" text is different :-(
# 02/05/01 cht Handle Sander's new -g 3 (xml output)
# 02/06/01 cht Use /lb instead of /pinkdot; use the new lblistings dbm file
# 02/09/01 cht Add licensing button legend to pages which have pinkdots
# 02/14/01 cht,azam Build in the Javascript for the animated search button
#   (but, what about the rest of the buttons??)
# 02/16/01 cht,azam Add <label> tags to column headings and "choose"
#   descriptions; account for changes to trailer.hti (no </TD></TR></TABLE>),
#   and to altsearchps.hti (no dotted lines anymore);
#   add code to grab our primary background colors
#   Remove obsolete code to convert a -o name to a -o column-number.
# 02/21/01 cht Fix bad premium features servlet url; add a special feedback page,
#   like the "syntax error" feedback page, for the "query too complex" return
#   codes.
#
# 03/14/2001 azam has added code for hoovers on "OutputHeader" sub function
#   and also has added code for label tag for "Score".  Also, fixed missing
#   > in the animated search button javascript, and, cht added a missing set of
#   {}'s in the swapx function which were causing Netscape to not print our
#   hitlists.
# 03/15/01 cht The above fixes made it so that sometimes the hitlist printed.
#   Bah.  Tom thinks it is the <div> tags causing the trouble.  Anyway,
#   the animated button javascript is even more improved, but printing
#   probablility is not much higher.  Added description of IP.com collection.
# 03/22/01 cht In inputFilter, remove empty FieldN_Type/FieldN_Text pairs.
#   (Also minimally fix indentation in that function so that it is at least
#   properly nested.)
# 04/02/01 santokh  Added button Save Search
# 04/03/01 cht Use a different details_url for ipcom
# 04/05/01 cht Add a few lines so that patsearch knows about the new epaft and epbft collections
# 04/09/01 cht Change "Applicant(s)" to "Assignee" to match our current search pages.
#   Don't show "save search" button if query gets an error.
# 05/02/01 cht Leading zeros are no longer indexed in the upnumber zone; fix
#   filter_UP to remove leading zeros instead of adding them.
# 05/02/01 raj Redo US National Class filter (filter_NC).  Vastly improved.
# 05/04/01 raj Redo International Class filter (filter_IC).  All terms+fixes.
# 05/04/01 sb  The db2xml servlet's are now supplied by the SERVER_NAME server.
# 05/07/01 cht Add AD and DP to the field choices, and break the choices into two lines.
# 05/07/01 cht Pretty up the new date field choices (and use "Filed", which matches
#   the "Delphion Integrated View" wording, instead of "Applied").
# 05/08/01 tdg Add Javascript popup code to header and trailer to warn non-subscribers.
# 05/11/01 cht Don't do the popup if we are already in a hitlist. Add code for pctft.
# 05/14/01 cht Improve the formatting behavior of the Save Search button when there
#   is either a long query or a long list of collections.
# 05/22/01 cht Remove Tom's header/footer popups; do a "Location:" redirect instead
#   for non-subscribers attempting non-bibonly searches.
# 05/25/01 cht Remove our use of the altsearches.hti
# 05/31/01 tdg Allowed access control check to pass collectionless and lblistings cases
# 06/04/01 cht Remove leftover code for checking/upgrading the (obsolete) patent collection
# 06/05/01 cht Add INDEXCLASS to the set of zones undergoing IPC filtering.
# 06/21/01 cht Add error pages for search server problems and invalid collections.
# 06/28/01 cht Add a printer friendly button and the code behind it.  Remove the outdated
#   code from g1OutputFilter() which allowed for subsequent hitlist pages to get produced
#   by net.data macros.
# 07/02/01 cht For -g 3, allow remote_host to be any of: localhost|127.0.0.1|server_addr.
#   Make the final set of collection names passed to k2query be sorted, to ensure
#   consistent k2 search results for equal scores and equal dates.
# 07/05/01 cht Time on the printer friendly output is now GMT instead of the TZ of the
#   server.  Remove obsolete code associated with ads and SSI $closing_tags.
# 07/08/01 cht Fix bug in Choose Fields, where Score was not underlined when Score was
#   the sort order, but not shown in the results list.  Fix savedsearch to use
#   $sortoname (which includes the '-' in front to change the sort to ascending)
#   instead of $sortname.  Replace the Printer Friendly button with a more friendly
#   image.  Remove dead ad/doubleclick code.
# 07/11/01 cht Remove Analysis section if 0 hits; more friendly "No Result" wording.
# 07/??/01 Azam Fast Buy
# 07/28/01 cht Add usapps/usappsft processing
# 07/30/01 azam Add WIDTH and HEIGHT to both the fastbuy and pink .gif's
# 08/02/01 Eric -- new patent number filter (FILTER_PN)
# 08/02/01 Eric -- new patent number filter (FILTER_UP)
# 08/14/01 cht/Eric -- fix inputFilter so it will filter a FieldN_Type of RAW the
#          same way it filters a &RAW or &GENERAL=value input (now that the adv
#          and boolquery search pages no longer use the original design)
# 08/20/01 Santokh --- New access controls for TKM/PLII changed TestSubscriber()
#          changed wisdomain = 1 to wisdomain = 0
# 08/20/01 Santokh --- Changed $GETPOST to GET for patent lab II . Access controls
#           checks for -r=widomain in GET method in go.html.en.
# 08/27/01 cht Make patsearch work as either a cgi-bin or an fcgi-bin program.
# 08/28/01 cht Add code to get the real status of image availability from db2.
#          Also clean up some of the lack of variable declarations.
# 09/05/01 cht Make new filter_PN/filter_UP filters not try to filter query strings
#          with "funny" characters (such as those in <or>).  Fixes InteCap search problem.
#          Also make the db2 image checking code conditional.
# 09/17/01 cht Used Jeff's template scheme for doing the various new-look application tabs.
#          Added GENSTART and GENEND args, to go with GENERAL.  The query sent to the
#          tunnel will now be GENSTART(filtered GENERAL)GENEND.
# 09/22/01 cht Added code to intercept the wisdomain redirect, and modify it with the
#          proper &QB and &QC parameters.
# 09/24/01 cht Use RANDOM from ENV to create unique filenames (the process id doesn't
#          work for fcgi mode)
# 09/27/02 cht Fix various bugs related to the new "app" stuff; clean up some naming
#          and some code in that area too.  Fix the saveURL's value of &query, again (but,
#          I have no idea who unfixed that)
# 10/02/01 cht Add CurrentResults fulltext processing
# 10/13/01 cht Add "database out of rotation" checks
# 10/19/01 cht Improve out of rotation code
# 10/22/01 cht Improve db2 failure messages which get put in httpd-errors.
# 10/23/01 cht Test for new "too complex" return code of 111 from the tunnel.
#          Normalize newlines and such in the input to single blanks.
# 10/31/01 cht Do something semi-sane if a -r which is supposed to always work
#          (like clustering) chooses to provide nothing back.
# 11/01/01 cht Set the template variable querylength -- goes with the startrow template changes
# 11/06/01 cht Stay on the CurrentResults tab if 0 results, even if some other
#          tab was clicked.
# 11/08/01 cht Reformat patent numbers for display; change url encode of spaces to +;
# 11/09/01 cht If a saved search qid is passed, call IPNqrytime.d2w to update that
#          search's timestamp.
# 11/27/01 cht Don't allow the collection selection area if lblistings is searched.
#          (Marketing is not ever going to reallow the original refineAltCSelect text, so,
#          use that part of the currentResults template to implement this.)
# 12/18/01 cht Fix the saved search call to use NCHOST_INTERNAL from the environment;
#          read the header.hti file just once before the fcgi loop, as a template.
# 12/19/01 cht Tom said to change collapse_form.d2w to snapshot_form.d2w -- done.
# 12/27/01 cht Improve the image_pages query (and a few comments).
# 01/03/02 cht Query related info hash values for an optional argument need to get set
#          every time, not just when the optional argument happens to be supplied.
# 01/18/02 cht Use filter_PN on USREFS (so, e.g. US4567890 is Ok, and US2002/7504 will
#          be Ok as soon as db2 uref's are fixed, and all of USG is re-indexed).
# 02/05/02 cht Set the SARRAY -m to 20 (our default pagesize) if no -m is specified for
#          gmodes 1 or 5 (otherwise patquery gives us back 50 items, its default). Bug 1520.
# 02/22/02 cht Do a more precise job of testing a query issued for the current results
#          tab to see if we think we added a trailing date clause, and thus should set
#          the current results tab date controls instead of including the clause in the
#          refine query box.
# 05/16/02 cht Don't let filter_UP remove too many zeroes from a 12-char patent number.
# 05/23/02 cht One hack leads to another ... Add an * to the end of the Italian 12-char
#          filtered result so that re-filtering it works (since * causes no filtering).
# 06/06/02 cht Set the default &annotation value for the tabs based on &annotval in
#          the cookie. Get rid of the "Buy" in "Buy PDF" for unlimited users.
#          New &skipX argument (always ignored); improved description of all args.
#          Grab the showsort_color out of the header file and give it to the templates.
#          Add code to support the "Items per page" in the choose template.
#          Add code to support the additional feedback on errors to the users.
#          Change names in column headers
# 06/11/02 cht An rc of 1 from k2query isn't allowed to be too complex anymore (my
#          waffley wording to include that case (timeout or someone else's search was
#          too complex) was removed by Marketing).  So, for now treat like a -2.
# 06/21/02 cht Process the &pn argument to determine any selected patents, and pass
#          them as before to workfile management, but now pre-load checkmarks in the
#          g1OutputFilter result set.
# 07/11/02 cht The annotation value now comes url-encoded, so, decode before use.
#          Move a bunch of constant initialization out of the fcgi loop.
# 08/07/02 cht Remove extra Content-type output from RedirOutputFilter.
# 09/23/02 cht Use Tom's shorter fastbuy html strings; move the orderbox FORM into the
#          scope of an existing <TD>, to prevent an empty row; First Page and Prev Page
#          should not be active when pagesize==maxdocs (bug #1949); add yet2com lb code.
# 09/24/02 Add $info{ncHost} variable (for patentLab).
# 10/25/02 cht Add $features to invocation of patentLab.fpl.

# $Header: /cvsroot/patsearch/patsearch,v 1.168 2006/03/02 18:29:03 tom Exp $