--- loncom/interface/lonsearchcat.pm 2002/06/20 14:31:31 1.124
+++ loncom/interface/lonsearchcat.pm 2002/06/24 15:09:52 1.126
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Search Catalog
#
-# $Id: lonsearchcat.pm,v 1.124 2002/06/20 14:31:31 matthew Exp $
+# $Id: lonsearchcat.pm,v 1.126 2002/06/24 15:09:52 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -515,7 +515,8 @@ ENDDOCUMENT
=item &make_persistent()
Returns a scalar which holds the current ENV{'form.*'} values in
-a 'hidden' html input tag.
+a 'hidden' html input tag. This allows search interface information
+to be somewhat persistent.
=cut
@@ -524,7 +525,6 @@ a 'hidden' html input tag.
sub make_persistent {
my $persistent='';
-
foreach (keys %ENV) {
if (/^form\./ && !/submit/) {
my $name=$_;
@@ -532,7 +532,7 @@ sub make_persistent {
$ENV{$key}=~s/\'//g; # do not mess with html field syntax
$name=~s/^form\.//;
$persistent.=<
+
END
}
}
@@ -574,8 +574,13 @@ is where the $name and $value are used)
=item &dateboxes()
+Returns html selection form elements for the specification of
+the day, month, and year.
+
=item &selectbox()
+Returns html selection form.
+
=back
=cut
@@ -675,7 +680,9 @@ sub selectbox {
=pod
-=item &advancedsearch()
+=item &advancedsearch()
+
+Parse advanced search results.
=cut
@@ -786,12 +793,13 @@ sub advancedsearch {
$customquery,$customshow);
}
&output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
- }
- elsif ($customquery) {
+ return OK;
+ } elsif ($customquery) {
my $reply; # reply hash reference
$reply=&Apache::lonnet::metadata_query('',
$customquery,$customshow);
&output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
+ return OK;
}
# should not get to this point
return 'Error. Should not have gone to this point.';
@@ -804,6 +812,8 @@ sub advancedsearch {
=item &basicsearch()
+Parse basic search form.
+
=cut
######################################################################
@@ -838,8 +848,9 @@ sub basicsearch {
$query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
# Get reply (either a hash reference to filehandles or bad connection)
+# &Apache::lonnet::logthis("metadata query started:".time);
my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query);
-
+# &Apache::lonnet::logthis("metadata query finished:".time);
# Output search results
&output_results('Basic',$r,$envhash,$query,$reply,$hidden);
@@ -855,6 +866,9 @@ sub basicsearch {
=item &build_SQL_query()
+Builds a SQL query string from a logical expression with AND/OR keywords
+using Text::Query and &recursive_SQL_query_builder()
+
=cut
######################################################################
@@ -877,14 +891,15 @@ sub build_SQL_query {
=item &build_custommetadata_query()
+Constructs a custom metadata query using a rather heinous regular
+expression.
+
=cut
######################################################################
######################################################################
sub build_custommetadata_query {
my ($field_name,$logic_statement)=@_;
- &Apache::lonnet::logthis("Entered build_custommetadata_query:".
- $field_name.':'.$logic_statement);
my $q=new Text::Query('abc',
-parse => 'Text::Query::ParseAdvanced',
-build => 'Text::Query::BuildAdvancedString');
@@ -899,7 +914,6 @@ sub build_custommetadata_query {
\*$2\[\^\\<\]?# *wordtwo[^\<]
\*\\<\\\/$1\\>?# *\<\/wordone\>
/g;
- &Apache::lonnet::logthis("match expression: ".$matchexp);
return $matchexp;
}
@@ -910,6 +924,8 @@ sub build_custommetadata_query {
=item &recursive_SQL_query_build()
+Recursively constructs an SQL query. Takes as input $dkey and $pattern.
+
=cut
######################################################################
@@ -954,6 +970,9 @@ sub recursive_SQL_query_build {
=item &build_date_queries()
+Builds a SQL logic query to check time/date entries.
+Also reports errors (check for /^Incorrect/).
+
=cut
######################################################################
@@ -1024,31 +1043,393 @@ contacted, etc.)
######################################################################
######################################################################
sub output_results {
+# &Apache::lonnet::logthis("output_results:".time);
my $fnum; # search result counter
my ($mode,$r,$envhash,$query,$replyref,$hidden)=@_;
my %ENV=%{$envhash};
my %rhash=%{$replyref};
my $compiledresult='';
- my $timeremain=300;
+ my $timeremain=300; # (seconds)
my $elapsetime=0;
my $resultflag=0;
my $tflag=1;
-
+ #
# make query information persistent to allow for subsequent revision
my $persistent=&make_persistent();
+ # spit out the generic header
+ $r->print(&search_results_header());
+ $r->rflush();
+ # begin showing the cataloged results
+ $r->print(<
+
+
+
');
+ $r->rflush();
+ #
+ # make the pop-up window for status
+ #
+ $r->print(&make_popwin(%rhash));
+ $r->rflush();
+ ##
+ ## Prepare for the main loop below
+ ##
+ my $servercount=0;
+ my $hitcountsum=0;
+ my $servernum=(keys %rhash);
+ my $serversleft=$servernum;
+ ##
+ ## Run until we run out of time or we run out of servers
+ ##
+ while($serversleft && $timeremain) {
+ ##
+ ## %rhash has servers deleted from it as results come in
+ ## (within the foreach loop below).
+ ##
+ foreach my $rkey (sort keys %rhash) {
+# &Apache::lonnet::logthis("Server $rkey:".time);
+ $servercount++;
+ $compiledresult='';
+ my $reply=$rhash{$rkey};
+ my @results;
+ if ($reply eq 'con_lost') {
+ &popwin_imgupdate($r,$rkey,"srvbad.gif");
+ $serversleft--;
+ delete $rhash{$rkey};
+ } else {
+ # must do since 'use strict' checks for tainting
+ $reply=~/^([\.\w]+)$/;
+ my $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
+ $reply=~/(.*?)\_/;
+ for (my $counter=0;$counter<2;$counter++) {
+ if (-e $replyfile && ! -e "$replyfile.end") {
+ &popwin_imgupdate($r,$rkey,"srvhalf.gif");
+ &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
+ '"still transferring..."'.';');
+ }
+ # Are we finished transferring data?
+ if (-e "$replyfile.end") {
+ $serversleft--;
+ delete $rhash{$rkey};
+ if (-s $replyfile) {
+ &popwin_imgupdate($r,$rkey,"srvgood.gif");
+ my $fh;
+ unless ($fh=Apache::File->new($replyfile)){
+ # Is it really appropriate to die on this error?
+ $r->print('ERROR: file '.
+ $replyfile.' cannot be opened');
+ return OK;
+ }
+ @results=<$fh> if $fh;
+ $hitcount{$rkey}=@results+0;
+ &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
+ $hitcount{$rkey}.';');
+ $hitcountsum+=$hitcount{$rkey};
+ &popwin_js($r,'popwin.document.forms.popremain.'.
+ 'numhits.value='.$hitcountsum.';');
+ } else {
+ &popwin_imgupdate($r,$rkey,"srvempty.gif");
+ &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;');
+ }
+ last;
+ } # end of if ( -e "$replyfile.end")
+ last unless $timeremain;
+ sleep 1; # wait for daemons to write files?
+ $timeremain--;
+ $elapsetime++;
+ &popwin_js($r,"popwin.document.popremain.".
+ "elapsetime.value=$elapsetime;");
+ }
+ &popwin_js($r,'popwin.document.whirly.'.
+ 'src="/adm/lonIcons/lonanimend.gif";');
+ } # end of if ($reply eq 'con_lost') else statement
+ my %Fields = undef; # Holds the data to be sent to the various
+ # *_view routines.
+ my ($extrashow,$customfields,$customhash) = &handle_custom_fields(\@results);
+ my @customfields = @$customfields;
+ my %customhash = %$customhash;
+ untie %hash if (keys %hash);
+ #
+ if (! tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ $r->print('Unable to tie hash to db '.
+ 'file');
+ } else {
+ if ($ENV{'form.launch'} eq '1') {
+ &start_fresh_session();
+ }
+ foreach my $result (@results) {
+ next if $result=~/^custom\=/;
+ chomp $result;
+ next unless $result;
+ %Fields = &parse_raw_result($result,$rkey);
+ $Fields{'extrashow'}=$extrashow;
+ if ($extrashow) {
+ foreach my $field (@customfields) {
+ my $value='';
+ $value = $1 if ($customhash{$Fields{'url'}}=~/\<{$field}[^\>]*\>(.*?)\<\/{$field}[^\>]*\>/s);
+ $Fields{'extrashow'}=~s/\<\!\-\- $field \-\-\>/ $value/g;
+ }
+ }
+ if ($compiledresult or $servercount!=$servernum) {
+ $compiledresult.="";
+ }
+ $compiledresult.="\n