--- loncom/interface/lonsearchcat.pm 2001/03/08 13:32:04 1.2
+++ loncom/interface/lonsearchcat.pm 2002/06/20 19:43:50 1.125
@@ -1,64 +1,2070 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Search Catalog
#
-# 03/08/2001 Scott Harrison
+# $Id: lonsearchcat.pm,v 1.125 2002/06/20 19:43:50 matthew Exp $
#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+# YEAR=2001
+# 3/8, 3/12, 3/13, 3/14, 3/15, 3/19 Scott Harrison
+# 3/20, 3/21, 3/22, 3/26, 3/27, 4/2, 8/15, 8/24, 8/25 Scott Harrison
+# 10/12,10/14,10/15,10/16,11/28,11/29,12/10,12/12,12/16 Scott Harrison
+# YEAR=2002
+# 1/17 Scott Harrison
+# 6/17 Matthew Hall
+#
+###############################################################################
+###############################################################################
+
+=pod
+
+=head1 NAME
+
+lonsearchcat
+
+=head1 SYNOPSIS
+
+Search interface to LON-CAPAs digital library
+
+=head1 DESCRIPTION
+
+This module enables searching for a distributed browseable catalog.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+lonsearchcat presents the user with an interface to search the LON-CAPA
+digital library. lonsearchcat also initiates the execution of a search
+by sending the search parameters to LON-CAPA servers. The progress of
+search (on a server basis) is displayed to the user in a seperate window.
+
+=head1 Internals
+
+=over 4
+
+=cut
+
+###############################################################################
+###############################################################################
+
+## ##
+## ORGANIZATION OF THIS PERL MODULE ##
+## ##
+## 1. Modules used by this module ##
+## 2. Choices for different output views (detailed, summary, xml, etc) ##
+## 3. BEGIN block (to be run once after compilation) ##
+## 4. Handling routine called via Apache and mod_perl ##
+## 5. Other subroutines ##
+## ##
+###############################################################################
+
package Apache::lonsearchcat;
+# ------------------------------------------------- modules used by this module
use strict;
use Apache::Constants qw(:common);
+use Apache::lonnet();
+use Apache::File();
+use CGI qw(:standard);
+use Text::Query;
+use GDBM_File;
+use Apache::loncommon();
+
+# ---------------------------------------- variables used throughout the module
+
+######################################################################
+######################################################################
+
+=pod
+
+=item Global variables
+
+=over 4
+
+=item %hostdomains
+
+matches host name to host domain
+
+=item %hostips
+
+matches host name to host ip
+
+=item %hitcount
+
+stores number of hits per host
+
+=item $closebutton
+
+button that closes the search window
+
+=item $importbutton
+
+button to take the selecte results and go to group sorting
+
+=item %hash
+
+The ubiquitous database hash
+
+=item $diropendb
+
+The full path to the (temporary) search database file. This is set and
+used in &handler() and is also used in &output_results().
+
+=back
+
+=cut
+
+######################################################################
+######################################################################
+# -- information holders
+my %hostdomains; # matches host name to host domain
+my %hostips; # matches host name to host ip
+my %hitcount; # stores number of hits per host
+
+# -- dynamically rendered interface components
+my $closebutton; # button that closes the search window
+my $importbutton; # button to take the selected results and go to group sorting
+
+# -- miscellaneous variables
+my $yourself; # allows for quickly limiting to oneself
+my %hash; # database hash
+
+# ------------------------------------------ choices for different output views
+# Detailed Citation View ---> sub detailed_citation_view
+# Summary View ---> sub summary_view
+# Fielded Format ---> sub fielded_format_view
+# XML/SGML ---> sub xml_sgml_view
+
+#------------------------------------------------------------- global variables
+my $diropendb = "";
+my $domain = "";
+
+# ----------------------------------------------------------------------- BEGIN
+
+=pod
+
+=item BEGIN block
+
+Load %hostdomains and %hostips with data from lonnet.pm. Only library
+servers are considered.
+
+=cut
+
+BEGIN {
+ foreach (keys (%Apache::lonnet::libserv)) {
+ $hostdomains{$_}=$Apache::lonnet::hostdom{$_};
+ $hostips{$_}=$Apache::lonnet::hostip{$_};
+ }
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &handler() - main handler invoked by httpd child
+
+=item Variables
+
+=over 4
+
+=item $hidden
+
+holds 'hidden' html forms
+
+=item $scrout
+
+string that holds portions of the screen output
+
+=back
+
+=cut
+
+######################################################################
+######################################################################
sub handler {
my $r = shift;
+ untie %hash;
+
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
-# ---------------------------------------------------------------- Print screen
- $r->print(<Search Catalog
+
+ +$closebutton + + + + +
+ + + +ENDDOCUMENT + return $scrout; +} +###################################################################### +###################################################################### + +=pod + +=item &advanced_search_form() + +Returns a scalar which holds html for the advanced search form. + +=cut + +###################################################################### +###################################################################### + +sub advanced_search_form{ + my ($closebutton,$hidden) = @_; + my $scrout=<<"ENDHEADER";'.
+ ''.$uctitle.': Basic search: '.$ENV{'form.basicexp'}.' Advanced search '.$query.'
';
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &advancedsearch()
+
+=cut
+
+######################################################################
+######################################################################
+sub advancedsearch {
+ my ($r,$envhash,$hidden)=@_;
+ my %ENV=%{$envhash};
+ my $fillflag=0;
+ # Clean up fields for safety
+ for my $field ('title','author','subject','keywords','url','version',
+ 'creationdatestart_month','creationdatestart_day',
+ 'creationdatestart_year','creationdateend_month',
+ 'creationdateend_day','creationdateend_year',
+ 'lastrevisiondatestart_month','lastrevisiondatestart_day',
+ 'lastrevisiondatestart_year','lastrevisiondateend_month',
+ 'lastrevisiondateend_day','lastrevisiondateend_year',
+ 'notes','abstract','mime','language','owner',
+ 'custommetadata','customshow') {
+ $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
+ }
+ foreach ('mode','form','element') {
+ # is this required? Hmmm.
+ next unless (exists($ENV{"form.$_"}));
+ $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
+ $ENV{"form.$_"}=~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') {
+ if (&filled($ENV{"form.$field"})) {
+ $fillflag++;
+ }
+ }
+ unless ($fillflag) {
+ &output_blank_field_error($r);
+ return OK;
+ }
+ # Turn the form input into a SQL-based query
+ my $query='';
+ my @queries;
+ # 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'}\")";
+ }
+ if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') {
+ push @queries,"(mime like \"$ENV{'form.mime'}\")";
+ }
+ if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
+ push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
+ }
+ # Evaluate date windows
+ my $datequery=&build_date_queries(
+ $ENV{'form.creationdatestart_month'},
+ $ENV{'form.creationdatestart_day'},
+ $ENV{'form.creationdatestart_year'},
+ $ENV{'form.creationdateend_month'},
+ $ENV{'form.creationdateend_day'},
+ $ENV{'form.creationdateend_year'},
+ $ENV{'form.lastrevisiondatestart_month'},
+ $ENV{'form.lastrevisiondatestart_day'},
+ $ENV{'form.lastrevisiondatestart_year'},
+ $ENV{'form.lastrevisiondateend_month'},
+ $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;
+ }
+ 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; # reply hash reference
+ unless ($customquery or $customshow) {
+ $reply=&Apache::lonnet::metadata_query($query);
+ }
+ else {
+ $reply=&Apache::lonnet::metadata_query($query,
+ $customquery,$customshow);
+ }
+ &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
+ }
+ elsif ($customquery) {
+ my $reply; # reply hash reference
+ $reply=&Apache::lonnet::metadata_query('',
+ $customquery,$customshow);
+ &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
+ }
+ # should not get to this point
+ return 'Error. Should not have gone to this point.';
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &basicsearch()
+
+=cut
+
+######################################################################
+######################################################################
+sub basicsearch {
+ my ($r,$envhash,$hidden)=@_;
+ my %ENV=%{$envhash};
+ # Clean up fields for safety
+ for my $field ('basicexp') {
+ $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
+ }
+ foreach ('mode','form','element') {
+ # is this required? Hmmm.
+ next unless (exists($ENV{"form.$_"}));
+ $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
+ $ENV{"form.$_"}=~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',
+ 'keywords'));
+ $concatarg='title' if $ENV{'form.titleonly'};
+
+ $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
+
+ # 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,$hidden);
+
return OK;
-}
+}
+
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &build_SQL_query()
+
+=cut
+
+######################################################################
+######################################################################
+sub build_SQL_query {
+ my ($field_name,$logic_statement)=@_;
+ my $q=new Text::Query('abc',
+ -parse => 'Text::Query::ParseAdvanced',
+ -build => 'Text::Query::Build');
+ $q->prepare($logic_statement);
+ my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
+ my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
+ return $sql_query;
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &build_custommetadata_query()
+
+=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');
+ $q->prepare($logic_statement);
+ my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
+ # quick fix to change literal into xml tag-matching
+ # will eventually have to write a separate builder module
+ # wordone=wordtwo becomes\Search Catalog
+CATALOGBEGIN
+ $r->print(<
+Search Query
+CATALOGCONTROLS
+ #
+ # Remind them what they searched for
+ #
+ if ($mode eq 'Basic') {
+ $r->print('Search Results
');
+ $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) {
+ $servercount++;
+ $tflag=1;
+ $compiledresult='';
+ my $hostname=$rkey;
+ 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=~/(.*?)\_/;
+ {
+ my $temp=0;
+ WLOOP: while (1) {
+ if (-e $replyfile && $tflag) {
+ &popwin_imgupdate($r,$rkey,"srvhalf.gif");
+ &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
+ '"still transferring..."'.';');
+ $tflag=0;
+ }
+ if (-e "$replyfile.end") {
+ $serversleft--;
+ delete $rhash{$rkey};
+ if (-s $replyfile) {
+ &popwin_imgupdate($r,$rkey,"srvgood.gif");
+ my $fh=Apache::File->new($replyfile) or
+ ($r->print('ERROR: file '.
+ $replyfile.' cannot be opened') and
+ 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 WLOOP;
+ } # end of if ( -e "$replyfile.end")
+ last WLOOP unless $timeremain;
+ sleep 1; # wait for daemons to write files?
+ $timeremain--;
+ $elapsetime++;
+ last WLOOP if ($temp>1);
+ &popwin_js($r,"popwin.document.popremain.".
+ "elapsetime.value=$elapsetime;");
+ $temp++;
+ }
+ }
+ &popwin_js($r,'popwin.document.whirly.'.
+ 'src="/adm/lonIcons/lonanimend.gif";');
+ } # end of if ($reply eq 'con_lost') else statement
+ 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);
+ @customfields=split(/\s+/,$customshow);
+ if ($customshow) {
+ $extrashow="
\n";
+ }
+ }
+ my $customdata='';
+ my %customhash;
+ foreach my $result (@results) {
+ 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;
+ }
+ }
+ if (keys %hash) {
+ untie %hash;
+ }
+ if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ if ($ENV{'form.launch'} eq '1') {
+ &start_fresh_session();
+ }
+ foreach my $result (@results) {
+ next if $result=~/^custom\=/;
+ chomp $result;
+ next unless $result;
+ my @fields=map
+ {&Apache::lonnet::unescape($_)}
+ (split(/\,/,$result));
+ my ($title,$author,$subject,$url,$keywords,$version,
+ $notes,$abstract,$mime,$lang,
+ $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
+ unless ($title =~ /^\s*$/ ) { $title='Untitled'; }
+ unless ($ENV{'user.adv'}) {
+ $keywords='- not displayed -';
+ $fields[4]=$keywords;
+ $notes='- not displayed -';
+ $fields[6]=$notes;
+ $abstract='- not displayed -';
+ $fields[7]=$abstract;
+ $subject='- not displayed -';
+ $fields[2]=$subject;
+ }
+
+ my $shortabstract=$abstract;
+ $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200;
+ $fields[7]=$shortabstract;
+ my $shortkeywords=$keywords;
+ $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200;
+ $fields[4]=$shortkeywords;
+
+ my $extrashow2=$extrashow;
+ if ($extrashow) {
+ foreach my $field (@customfields) {
+ my $value='';
+ if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) {
+ $value=$1;
+ }
+ $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g;
+ }
+ }
+
+ $compiledresult.=<
+END
+ }
+ if ($ENV{'form.catalogmode'} eq 'groupsearch') {
+ $fnum+=0;
+ $hash{"pre_${fnum}_link"}=$url;
+ $hash{"pre_${fnum}_title"}=$title;
+ $compiledresult.=<
+END
+#
+#
+ $fnum++;
+ }
+ my $httphost=$ENV{'HTTP_HOST'};
+
+ my $viewselect;
+ if ($mode eq 'Basic') {
+ $viewselect=$ENV{'form.basicviewselect'};
+ }
+ elsif ($mode eq 'Advanced') {
+ $viewselect=$ENV{'form.advancedviewselect'};
+ }
+
+ if ($viewselect eq 'Detailed Citation View') {
+ $compiledresult.=&detailed_citation_view(@fields,
+ $hostname,$httphost,
+ $extrashow2);
+ }
+ elsif ($viewselect eq 'Summary View') {
+ $compiledresult.=&summary_view(@fields,$hostname,$httphost,
+ $extrashow2);
+ }
+ elsif ($viewselect eq 'Fielded Format') {
+ $compiledresult.=&fielded_format_view(@fields,$hostname,
+ $httphost,$extrashow2);
+ }
+ elsif ($viewselect eq 'XML/SGML') {
+ $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost,
+ $extrashow2);
+ }
+
+ }
+
+ untie %hash;
+ }
+ else {
+ $r->print('Unable to tie hash to db '.
+ 'file');
+ }
+ if ($compiledresult) {
+ $resultflag=1;
+ }
+
+ $r->print(<
'+\n";
+ # $sn is the server number, used ONLY to make sure we have
+ # rows of 10 each. No longer used to index images.
+ my $sn=1;
+ foreach my $sk (sort keys %rhash) {
+ # ''+
+ $grid.="'+\"'\"+')\">'+";
+ $grid.="\n";
+ $grid.="''+\n";
+ $grid.="'
'+\n" unless $sn%10;
+ $sn++;
+ }
+ my $result.=<$title
+$author
+
+Subject: $subject
+Keyword(s): $keywords
+Notes: $notes
+MIME Type:
+END
+ $result.=&Apache::loncommon::filedescription($mime);
+ $result.=<
+$shortabstract +
+END + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &summary_view() + +=cut + +###################################################################### +###################################################################### +sub summary_view { + my ($title,$author,$subject,$url,$keywords,$version, + $notes,$shortabstract,$mime,$lang, + $creationdate,$lastrevisiondate,$owner,$copyright, + $hostname,$httphost,$extrashow)=@_; + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); + my $result=<