--- loncom/interface/lonsearchcat.pm 2001/03/27 02:48:02 1.79 +++ loncom/interface/lonsearchcat.pm 2001/04/16 17:11:57 1.95 @@ -3,7 +3,8 @@ # # 03/08/2001 Scott Harrison # Scott Harrison: 03/12/2001, 03/13/2001, 03/14/2001, 03/15/2001, 03/19/2001 -# Scott Harrison: 03/20/2001 +# Scott Harrison: 03/20/2001, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001 +# Scott Harrison: 04/02/2001 # # Functions # @@ -36,6 +37,21 @@ # recursive_SQL_query_build(field name, reverse notation expression) : # builds a SQL query string from a reverse notation expression # logical expression with AND/OR keywords +# build_custommetadata_query(field_name, logic_statement) : builds a perl +# regular expression from a logical expression with AND/OR +# keywords +# detailed_citation_view, summary_view, fielded_format_view, xml_sgml_view: +# four different ways to view metadata records. Outputs a HTML-ified string. +# Input arguments are title, author, subject, url, keywords, version, notes, +# short abstract, mime, language, creation date, last revision date, owner, +# copyright, hostname, httphost, and extra custom metadata to show. +# build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2, +# lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) : +# Builds a SQL logic query to check time/date entries. +# output_date_error(server reference, error message) : outputs +# an error message specific to bad date format. +# make_persistent() : makes a set of hidden HTML fields to make +# SQL search interface information to be persistent package Apache::lonsearchcat; @@ -46,12 +62,19 @@ use Apache::File(); use CGI qw(:standard); use Text::Query; +# ---------------------------------------- variables used throughout the module my %language; my $scrout; my %metadatafields; my %cprtag; my %mimetag; my $closebutton; + +# ------ form selection elements that allow for choosing different output views +# Detailed Citation View ---> sub detailed_citationview +# Summary View ---> sub summary_view +# Fielded Format ---> sub fielded_format_view +# XML/SGML ---> sub xml_sgml_view my $basicviewselect=< @@ -69,6 +92,7 @@ my $advancedviewselect=< END +# ----------------------------- Handling routine called via Apache and mod_perl sub handler { my $r = shift; @@ -89,13 +113,14 @@ sub handler { %metadatafields=(); my $hidden=''; - $hidden=< END - - $closebutton=< END + } # ------------------------------------------------ First, check out environment $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; @@ -132,6 +157,7 @@ END } <$fh>; } +# ----------------------------------- See if a search invocation should be done if ($ENV{'form.basicsubmit'} eq 'SEARCH') { return &basicsearch($r,\%ENV); } @@ -139,6 +165,7 @@ END return &advancedsearch($r,\%ENV); } +# ----------------------------- Else, begin building search interface to output $scrout=''; # building a part of screen output $scrout.=&searchphrasefield('Limit by title','title', $ENV{'form.title'}); @@ -501,6 +528,8 @@ sub advancedsearch { 'custommetadata','customshow') { $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g; } + + # Check to see if enough information was filled in for my $field ('title','author','subject','keywords','url','version', 'notes','abstract','mime','language','owner', 'custommetadata') { @@ -508,32 +537,34 @@ sub advancedsearch { $fillflag++; } } - unless ($fillflag) { &output_blank_field_error($r); return OK; } + + # Turn the form input into a SQL-based query my $query=''; my @queries; - # Go through logical expression AND/OR/NOT phrase fields. - + # Evaluate logical expression AND/OR/NOT phrase fields. foreach my $field ('title','author','subject','notes','abstract','url', 'keywords','version','owner') { if ($ENV{'form.'.$field}) { push @queries,&build_SQL_query($field,$ENV{'form.'.$field}); } } + # Evaluate option lists if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { - push @queries,"(language like \"\%$ENV{'form.language'}\%\")"; + push @queries,"(language like \"$ENV{'form.language'}\")"; } if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') { - push @queries,"(mime like \"\%$ENV{'form.mime'}\%\")"; + push @queries,"(mime like \"$ENV{'form.mime'}\")"; } if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { - push @queries,"(copyright like \"\%$ENV{'form.copyright'}\%\")"; + push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; } + # Evaluate date windows my $datequery=&build_date_queries( $ENV{'form.creationdatestart_month'}, $ENV{'form.creationdatestart_day'}, @@ -548,6 +579,7 @@ sub advancedsearch { $ENV{'form.lastrevisiondateend_day'}, $ENV{'form.lastrevisiondateend_year'}, ); + # Test to see if date windows are legitimate if ($datequery=~/^Incorrect/) { &output_date_error($r,$datequery); return OK; @@ -555,33 +587,50 @@ sub advancedsearch { elsif ($datequery) { push @queries,$datequery; } + + # Process form information for custom metadata querying my $customquery=''; if ($ENV{'form.custommetadata'}) { $customquery=&build_custommetadata_query('custommetadata', $ENV{'form.custommetadata'}); } + my $customshow=''; + if ($ENV{'form.customshow'}) { + $customshow=$ENV{'form.customshow'}; + $customshow=~s/[^\w\s]//g; + my @fields=split(/\s+/,$customshow); + $customshow=join(" ",@fields); + } + # Send query statements over the network to be processed by either the SQL + # database or a recursive scheme of 'grep'-like actions (for custom + # metadata). if (@queries) { $query=join(" AND ",@queries); $query="select * from metadata where $query"; - my $reply=''; - unless ($customquery) { + my $reply; # reply hash reference + unless ($customquery or $customshow) { $reply=&Apache::lonnet::metadata_query($query); } else { - $reply=&Apache::lonnet::metadata_query($query,$customquery); + $reply=&Apache::lonnet::metadata_query($query, + $customquery,$customshow); } &output_results('Advanced',$r,$envhash,$customquery,$reply); } - else { - &output_results('Advanced',$r,$envhash,$query); + elsif ($customquery) { + my $reply; # reply hash reference + $reply=&Apache::lonnet::metadata_query('', + $customquery,$customshow); + &output_results('Advanced',$r,$envhash,$customquery,$reply); } - return OK; + # should not get to this point + return 'Error. Should not have gone to this point.'; } # ---------------------------------------------------- see if a field is filled sub filled { my ($field)=@_; - if ($field=~/\S/) { + if ($field=~/\S/ && $field ne 'any') { return 1; } else { @@ -599,18 +648,27 @@ sub basicsearch { $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g; } + # Check to see if enough is filled in unless (&filled($ENV{'form.basicexp'})) { &output_blank_field_error($r); return OK; } + # Build SQL query string based on form page my $query=''; my $concatarg=join('," ",', ('title', 'author', 'subject', 'notes', 'abstract')); + $concatarg='title' if $ENV{'form.titleonly'}; + + $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); + - $query="select * from metadata where concat($concatarg) like '\%$ENV{'form.basicexp'}\%'"; - my $reply=&Apache::lonnet::metadata_query($query); + # Get reply (either a hash reference to filehandles or bad connection) + my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query); + + # Output search results &output_results('Basic',$r,$envhash,$query,$reply); + return OK; } @@ -650,58 +708,192 @@ RESULTS # ----------------------------- format and output results based on a reply list sub output_results { - my ($mode,$r,$envhash,$query,@replylist)=@_; + my ($mode,$r,$envhash,$query,$replyref)=@_; my %ENV=%{$envhash}; + my %rhash=%{$replyref}; my $compiledresult=''; + my $timeremain=30; + my $resultflag=0; + my $tflag=1; - foreach my $reply (@replylist) { + # make query information persistent to allow for subsequent revision + my $persistent=&make_persistent(); - my @results; + # output beginning of search page + $r->print(< + +The LearningOnline Network with CAPA +BEGINNING + $r->print(< + function select_data(title,url) { + changeTitle(title); + changeURL(url); + } + function changeTitle(val) { + if (opener.inf.document.forms.resinfo.elements.t) { + opener.inf.document.forms.resinfo.elements.t.value=val; + } + } + function changeURL(val) { + if (opener.inf.document.forms.resinfo.elements.u) { + opener.inf.document.forms.resinfo.elements.u.value=val; + } + } + +SCRIPT + $r->print(< + + +

Search Catalog

+CATALOGBEGIN + $r->print(< + +$closebutton +$persistent +
+

Search Query

+RESULTS + if ($mode eq 'Basic') { + $r->print(< +Basic search: $ENV{'form.basicexp'} +

+RESULTS + } + elsif ($mode eq 'Advanced') { + $r->print(< +Advanced search +$query +

+RESULTS + } + $r->print('

Search Results

'); + $r->rflush(); + $r->print(< + popwin=open('','popwin','width=400,height=200'); + popwin.document.writeln(''+ + '

Search Results Progress

'+ + '
'+ + '
Server space '+ + '
Status '+ + '
Maximum remaining time '+ + '
'+ + ''); + popwin.document.close(); + +ENDPOP + $r->rflush(); + my $servernum=(keys %rhash)+0; + $r->print(''); + $r->rflush(); + my $servercount=0; + foreach my $rkey (keys %rhash) { + $servercount++; + $tflag=1; + $compiledresult=''; + my $hostname=$rkey; + $r->print(''); + $r->rflush(); + my $reply=$rhash{$rkey}; + my @results; + my $replyfile=''; - $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting - $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; - $reply=~/(.*?)\_/; - my $hostname=$1; - sleep 3; # temporary fix, need to check for completion and status - { - while (1) { - last if -e $replyfile; - sleep 1; + + if ($reply eq 'con_lost') { + my $percent=sprintf('%3.0f',($servercount/$servernum*100)); + $r->print(''); + } + else { + $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting + $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; + $reply=~/(.*?)\_/; + { + while (1) { + if (-e $replyfile && $tflag) { + $r->print(''); + $r->rflush(); + $tflag=0; + } + last if -e "$replyfile.end"; + last unless $timeremain; + sleep 1; + $timeremain--; + $r->print(''); + $r->rflush(); + } + # QUESTION: how should I handle this error condition.. + # I'm sure there is syntax elsewhere I can use.. + my $fh=Apache::File->new($replyfile) or + ($r->print('ERROR: file cannot be opened') and return OK); + @results=<$fh>; } - # QUESTION: how should I handle this error condition.. - # I'm sure there is syntax elsewhere I can use.. - my $fh=Apache::File->new($replyfile) or - ($r->print('file cannot be opened') and return OK); - @results=<$fh>; } - my $customshow=''; my $extrashow=''; + my @customfields; if ($ENV{'form.customshow'}) { $customshow=$ENV{'form.customshow'}; $customshow=~s/[^\w\s]//g; - my @fields=map {"$_:"} - split(/\s+/,$customshow); - $extrashow="
  • ".join("
  • ",@fields)."
\n"; + my @fields=map {"$_:"} + split(/\s+/,$customshow); + @customfields=split(/\s+/,$customshow); + if ($customshow) { + $extrashow="
  • ".join("
  • ",@fields)."
\n"; + } } my $customdata=''; + my %customhash; foreach my $result (@results) { - $result=~/(\&custom.*)$/; # grab all custom metadata - $custom=$1; - $result=~s/\&custom.*$//; # remove custom metadata + if ($result=~/^(custom\=.*)$/) { # grab all custom metadata + my $tmp=$result; + $tmp=~s/^custom\=//; + my ($k,$v)=map {&Apache::lonnet::unescape($_); + } split(/\,/,$tmp); + $customhash{$k}=$v; + } } foreach my $result (@results) { + next if $result=~/^custom\=/; + chomp $result; + next unless $result; my @fields=map - {&Apache::lonnet::unescape($_)} - (split(/\,/,$result)); + {&Apache::lonnet::unescape($_)} + (split(/\,/,$result)); my ($title,$author,$subject,$url,$keywords,$version, $notes,$abstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; my $shortabstract=$abstract; $shortabstract=substr($abstract,0,200) if length($abstract)>200; $fields[7]=$shortabstract; - $compiledresult.=<]*\>(.*?)\<\/${field}[^\>]*\>/s) { + $value=$1; + } + $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g; + } + } + + $compiledresult.=< +END + $compiledresult.=< END $compiledresult.=<print(< - -The LearningOnline Network with CAPA -BEGINNING - $r->print(< - function select_data(title,url) { - changeTitle(title); - changeURL(url); - } - function changeTitle(val) { - if (opener.inf.document.forms.resinfo.elements.t) { - opener.inf.document.forms.resinfo.elements.t.value=val; - } - } - function changeURL(val) { - if (opener.inf.document.forms.resinfo.elements.u) { - opener.inf.document.forms.resinfo.elements.u.value=val; - } - } - -SCRIPT - $r->print(< - - -

Search Catalog

-
-$custom - -$closebutton -$persistent -
-

Search Query

-RESULTS - if ($mode eq 'Basic') { $r->print(< -Basic search: $ENV{'form.basicexp'} -

+$compiledresult RESULTS + my $percent=sprintf('%3.0f',($servercount/$servernum*100)); + $r->print(''); } - elsif ($mode eq 'Advanced') { - $r->print(< -Advanced search -$query -

-RESULTS + unless ($resultflag) { + $r->print("\nThere were no results that matched your query\n"); } - $r->print(<Search Results -$compiledresult + $r->print(''); $r->rflush(); + $r->print(< RESULTS - } } # ------------------------------------------------------------- build_SQL_query @@ -831,7 +977,7 @@ sub build_custommetadata_query { # quick fix to change literal into xml tag-matching # will eventually have to write a separate builder module my $oldmatchexp=$matchexp; - $matchexp=~s/(\w+)\\\=(\w+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g; + $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g; return $matchexp; } @@ -847,6 +993,11 @@ sub recursive_SQL_query_build { if ($key eq 'literal') { $replacement="($dkey like \"\%$value\%\")"; } + elsif ($key eq 'not') { + $value=~s/like/not like/; +# $replacement="($dkey not like $value)"; + $replacement="$value"; + } elsif ($key eq 'and') { $value=~/(.*[\"|\)]) ([|\(|\^].*)/; $replacement="($1 AND $2)";