#!/usr/bin/perl

$path = $0;
$path =~ s#/[^/]*$##;

require "$path/config.ph";
printf("Content-type: text/html\n\n<TITLE>%s</TITLE>",URL_TITLE);

printf("<FORM ACTION=\"http:perform_query\" METHOD=\"POST\">
 $START_SEARCH_MESSAGE\n");


if ($ENV{'REQUEST_METHOD'} eq 'POST') {
      # Read in the desired number of bytes
      read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
} else {
       $request = $ENV{'QUERY_STRING'};
}

print "The Request to generate this page was<br>$request<br>" if $VERBOSE;
print "Set VERBOSE to 0 in config.ph to remove this message.<br><br>" if $VERBOSE;

@field = split(/&/, $request);

$combine_list_method = $ORING;   # Assume Oring unless told otherwise

foreach $next_field (@field) {

    next if $next_field eq "ANDING=off";

    if ( $next_field eq "ANDING=on" ) {
       $combine_list_method = $ANDING ;
       next;
    } else {
        ($field, $type, $search_for) = split(/%5C/, $next_field); 
        $patterns{$field} = "\L$search_for\E";          #Convert it to lowercase
        $types{$field} = $type;
    
        $patterns{$field} =~  s/=on$//;
        $patterns{$field} =~  tr/+/ /;
        $patterns{$field} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $patterns{$field} =~ s/~!/ ~!/g;   # Stops people using subshells apparently

    }

#print "F=$field<br>T=$type<br>S=$patterns{$field}<br><br>";
}
    
$hits = 0;

open ( DBASE, "$DATABASE_FILENAME" ) || die "Unable to open $DATABASE_FILENAME";


MAIN_LOOP:
while ( $record = <DBASE> ) {
   chop $record;

   @the_record = split(/$FIELD_SEPARATOR/, $record);

   foreach $field ( keys %patterns ) {

      $the_record[$field-1] = "\L$the_record[$field-1]\E";

      # Check for substrings which are to be ANDED
      if ( $types{$field} == $ANDING ) {
          $gotcha = 1;

          AND_LOOP :
          foreach $item ( split(/\//,$patterns{$field}) ) {
 
              if ( $the_record[$field-1] !~ /$item/ ) {
                 $gotcha = 0;
                 last AND_LOOP;
                 }
          }
       }

       # Check for substring which are to be ORED
       if ( $types{$field} == $ORING ) {
          $gotcha = 0;

          OR_LOOP:
          foreach $item ( split(/\//,$patterns{$field}) ) {
 
              if ( $the_record[$field-1] =~ /$item/ ) {
                 $gotcha = 1;
                 last OR_LOOP;
                 }
          }
       }

       # Check for regular expression matching
       if ( $types{$field} == $REG_EXP ) {
          $gotcha = 0;

           if ( $the_record[$field-1] =~ /$patterns{$field}/ ) {
              $gotcha = 1;
           }
       }

       # Check for (year) ranges
       if ( $types{$field} == $YEARS ) {
          $gotcha = 0;

          ($lo, $hi) = split(/-/, $patterns{$field});

          $lo =~ s/(.*)BC(.*)/-$1$2/;
          $hi =~ s/(.*)BC(.*)/-$1$2/;

          $lo =~ s/AD//;
          $hi =~ s/AD//;


#print "Is $the_record[$field-1]  in range $lo to $hi ? <br>";

          if ( $the_record[$field-1] ne undef && $the_record[$field-1] >= $lo && $the_record[$field-1] <= $hi ) {
                 $gotcha = 1;
          }
       }

       # Check for century ranges
       if ( $types{$field} == $CENTURIES ) {
          $gotcha = 0;

          ($lo, $hi) = split(/-/, $patterns{$field});

          $lo =~ s/(.*)BC(.*)/-$1$2/;
          $hi =~ s/(.*)BC(.*)/-$1$2/;

          $lo =~ s/AD//;
          $hi =~ s/AD//;

          $record_century = $the_record[$field-1];
          $record_century =~ s/(.*)BC(.*)/-$1$2/;
          $record_century =~ s/AD//;


#print "Is $record_century  in range $lo to $hi ? <br>";

          if ( $record_century ne undef && $record_century >= $lo && $record_century <= $hi ) {
                 $gotcha = 1;
          }
       }



   next  MAIN_LOOP if !$gotcha && $combine_list_method == $ANDING;

   last if $gotcha && $combine_list_method == $ORING


   }
   $od = $OUTPUT_FORMAT;
   $od =~ s/FIELD\[([0-9]*)]/$the_record[$1-1]/eg;

   printf "$od" if $gotcha;

   $hits++ if $gotcha;

}
  
print("Sorry, there were no matching records<br><hr>\n") if !$hits; 

print("$END_SEARCH_MESSAGE");


_END__