--- loncom/interface/lonsearchcat.pm 2002/06/10 23:55:47 1.120 +++ loncom/interface/lonsearchcat.pm 2002/06/19 19:40:38 1.122 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.120 2002/06/10 23:55:47 harris41 Exp $ +# $Id: lonsearchcat.pm,v 1.122 2002/06/19 19:40:38 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,10 +31,42 @@ # 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 ## ## ## @@ -60,20 +92,82 @@ 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 $hidden + +holds 'hidden' html forms + +=item $scrout + +string that holds portions of the screen output + +=item $yourself + +allows for quickly limiting to oneself + +=item %hash + +The ubiquitous database hash + +=item $basicviewselect and $advancedviewselect + +View selection forms. These are not actually global and will be +moved soon. + +=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 +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 $closebutton; # button that closes the search window my $importbutton; # button to take the selected results and go to group sorting -my $hidden; +my $hidden; # Holds 'hidden' html forms # -- miscellaneous variables -my $scrout; # string that holds portions of the screen output +my $scrout; # string that holds portions of the screen output my $yourself; # allows for quickly limiting to oneself -my %hash; +my %hash; # database hash # ------------------------------------------ choices for different output views # Detailed Citation View ---> sub detailed_citation_view @@ -99,25 +193,39 @@ Detailed Citation View END +#------------------------------------------------------------- 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 { - { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/hosts.tab'); - while (<$fh>) { - $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp; - if ($3 eq 'library') { - $hostdomains{$1}=$2; - $hostips{$1}=$4; - } - } + foreach (keys (%Apache::lonnet::libserv)) { + $hostdomains{$_}=$Apache::lonnet::hostdom{$_}; + $hostips{$_}=$Apache::lonnet::hostip{$_}; } } -#------------------------------------------------------------- global variables -my $diropendb = ""; -my $domain = ""; +###################################################################### +###################################################################### + +=pod +=item &handler() - main handler invoked by httpd child + +=cut + +###################################################################### +###################################################################### # ----------------------------- Handling routine called via Apache and mod_perl sub handler { my $r = shift; @@ -127,8 +235,9 @@ sub handler { $r->send_http_header; return OK if $r->header_only; - $domain = $r->dir_config('lonDefDomain'); - $diropendb= "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; + my $domain = $r->dir_config('lonDefDomain'); + $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). + "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db"; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['catalogmode','launch','acts','mode','form','element']); @@ -137,8 +246,7 @@ sub handler { if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { &start_fresh_session(); untie %hash; - } - else { + } else { $r->print('Unable to tie hash to db '. 'file'); return OK; @@ -370,7 +478,21 @@ ENDDOCUMENT return OK; } -# ------------------------------------------------------------- make persistent +###################################################################### +###################################################################### + +=pod + +=item &make_persistent() + +Returns a scalar which holds the current ENV{'form.*'} values in +a 'hidden' html input tag. + +=cut + +###################################################################### +###################################################################### + sub make_persistent { my $persistent=''; @@ -388,31 +510,73 @@ END return $persistent; } -# --------------------------------------------------------- Various form fields + +###################################################################### +###################################################################### + +=pod + +=item HTML form building functions + +=over 4 + +=item &simpletextfield() + +Inputs: $name,$value,$size + +Returns a text input field with the given name, value, and size. +If size is not specified, a value of 20 is used. + +=item &simplecheckbox() + +Inputs: $name,$value + +Returns a simple check box with the given $name. +If $value eq 'on' the box is checked. + +=item &searchphrasefield() + +Inputs: $title,$name,$value + +Returns html for a title line and an input field for entering search terms. +the instructions "Enter terms or phrases separated by search operators such +as AND, OR, or NOT." are given following the title. The entry field (which +is where the $name and $value are used) is an 80 column simpletextfield. + +=item &dateboxes() + +=item &selectbox() + +=back + +=cut + +###################################################################### +###################################################################### sub simpletextfield { - my ($name,$value)=@_; - return ''; + my ($name,$value,$size)=@_; + $size = 20 if (! defined($size)); + return ''; } sub simplecheckbox { my ($name,$value)=@_; my $checked=''; $checked="CHECKED" if $value eq 'on'; - return ''; + return ''; } sub searchphrasefield { my ($title,$name,$value)=@_; my $instruction=<$uctitle:". - " $instruction
". - ''; + return "\n". + '

'.$uctitle.':'. + " $instruction
".&simpletextfield($name,$value,80); } sub dateboxes { @@ -462,26 +626,35 @@ END sub selectbox { my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; my $uctitle=uc($title); - my $selout="\n

$uctitle:". - "
".''; foreach ($anyvalue,@idlist) { - $selout.=''; } elsif ($_ eq $value and /^$anyvalue$/) { - $selout.=' selected>'.$anytag.''; + $selout.=' selected >'.$anytag.''; } else {$selout.='>'.&{$functionref}($_).'';} } return $selout.''; } -# ----------------------------------------------- Performing an advanced search +###################################################################### +###################################################################### + +=pod + +=item &advancedsearch() + +=cut + +###################################################################### +###################################################################### sub advancedsearch { my ($r,$envhash)=@_; my %ENV=%{$envhash}; - my $fillflag=0; # Clean up fields for safety for my $field ('title','author','subject','keywords','url','version', @@ -513,11 +686,8 @@ sub advancedsearch { &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', @@ -559,7 +729,6 @@ sub advancedsearch { elsif ($datequery) { push @queries,$datequery; } - # Process form information for custom metadata querying my $customquery=''; if ($ENV{'form.custommetadata'}) { @@ -599,7 +768,17 @@ sub advancedsearch { return 'Error. Should not have gone to this point.'; } -# --------------------------------------------------- Performing a basic search +###################################################################### +###################################################################### + +=pod + +=item &basicsearch() + +=cut + +###################################################################### +###################################################################### sub basicsearch { my ($r,$envhash)=@_; my %ENV=%{$envhash}; @@ -638,7 +817,18 @@ sub basicsearch { return OK; } -# ------------------------------------------------------------- build_SQL_query + +###################################################################### +###################################################################### + +=pod + +=item &build_SQL_query() + +=cut + +###################################################################### +###################################################################### sub build_SQL_query { my ($field_name,$logic_statement)=@_; my $q=new Text::Query('abc', @@ -650,9 +840,21 @@ sub build_SQL_query { return $sql_query; } -# ------------------------------------------------- build custom metadata 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'); @@ -660,12 +862,28 @@ sub build_custommetadata_query { my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; # 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; + # wordone=wordtwo becomes\[^\<] *wordtwo[^\<]*\<\/wordone\> + $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to + /\\<$1\\>?# \ + \[\^\\<\]?# [^\<] + \*$2\[\^\\<\]?# *wordtwo[^\<] + \*\\<\\\/$1\\>?# *\<\/wordone\> + /g; + &Apache::lonnet::logthis("match expression: ".$matchexp); return $matchexp; } -# - Recursively parse a reverse notation expression into a SQL query expression +###################################################################### +###################################################################### + +=pod + +=item &recursive_SQL_query_build() + +=cut + +###################################################################### +###################################################################### sub recursive_SQL_query_build { my ($dkey,$pattern)=@_; my @matches=($pattern=~/(\[[^\]|\[]*\])/g); @@ -699,7 +917,17 @@ sub recursive_SQL_query_build { &recursive_SQL_query_build($dkey,$pattern); } -# ------------------------------------------------------------ Build date query +###################################################################### +###################################################################### + +=pod + +=item &build_date_queries() + +=cut + +###################################################################### +###################################################################### sub build_date_queries { my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; @@ -748,11 +976,23 @@ sub build_date_queries { return ''; } -# ----------------------------- format and output results based on a reply list -# There are two windows that this function writes to. The main search -# window ("srch") has a listing of the results. A secondary window ("popwin") -# gives the status of the network search (time elapsed, number of machines -# contacted, etc.) +###################################################################### +###################################################################### + +=pod + +=item &output_results() + +Format and output results based on a reply list. +There are two windows that this function writes to. The main search +window ("srch") has a listing of the results. A secondary window ("popwin") +gives the status of the network search (time elapsed, number of machines +contacted, etc.) + +=cut + +###################################################################### +###################################################################### sub output_results { my $fnum; # search result counter my ($mode,$r,$envhash,$query,$replyref)=@_; @@ -1212,7 +1452,27 @@ RESULTS RESULTS } -# ------------------------------------------------------ Detailed Citation View +###################################################################### +###################################################################### + +=pod + +=item Metadata Viewing Functions + +Output is 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. + +=over 4 + +=item &detailed_citation_view() + +=cut + +###################################################################### +###################################################################### sub detailed_citation_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1251,7 +1511,17 @@ END return $result; } -# ---------------------------------------------------------------- Summary View +###################################################################### +###################################################################### + +=pod + +=item &summary_view() + +=cut + +###################################################################### +###################################################################### sub summary_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1269,7 +1539,17 @@ END return $result; } -# -------------------------------------------------------------- Fielded Format +###################################################################### +###################################################################### + +=pod + +=item &fielded_format_view() + +=cut + +###################################################################### +###################################################################### sub fielded_format_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1300,7 +1580,19 @@ END return $result; } -# -------------------------------------------------------------------- XML/SGML +###################################################################### +###################################################################### + +=pod + +=item &xml_sgml_view() + +=back + +=cut + +###################################################################### +###################################################################### sub xml_sgml_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1342,7 +1634,17 @@ END return $result; } -# ---------------------------------------------------- see if a field is filled +###################################################################### +###################################################################### + +=pod + +=item &filled() see if field is filled. + +=cut + +###################################################################### +###################################################################### sub filled { my ($field)=@_; if ($field=~/\S/ && $field ne 'any') { @@ -1353,7 +1655,17 @@ sub filled { } } -# ---------------- Message to output when there are not enough fields filled in +###################################################################### +###################################################################### + +=pod + +=item &output_blank_field_error() + +=cut + +###################################################################### +###################################################################### sub output_blank_field_error { my ($r)=@_; # make query information persistent to allow for subsequent revision @@ -1387,18 +1699,28 @@ processed. RESULTS } -# ----------------------------------------------------------- Output date error +###################################################################### +###################################################################### + +=pod + +=item &output_date_error() + +Output a full html page with an error message. + +=cut + +###################################################################### +###################################################################### sub output_date_error { my ($r,$message)=@_; # make query information persistent to allow for subsequent revision my $persistent=&make_persistent(); - $r->print(<print(< The LearningOnline Network with CAPA -BEGINNING - $r->print(< @@ -1418,7 +1740,20 @@ $message RESULTS } -# --------- settings whenever the user causes the search window to be launched +###################################################################### +###################################################################### + +=pod + +=item &start_fresh_session() + +Cleans the global %hash by removing all fields which begin with +'pre_' or 'store'. + +=cut + +###################################################################### +###################################################################### sub start_fresh_session { delete $hash{'mode_catalog'}; foreach (keys %hash) { @@ -1431,7 +1766,17 @@ sub start_fresh_session { } } -# ----------------------------------------------- send javascript to popwin +###################################################################### +###################################################################### + +=pod + +=item &popwin_js() send javascript to popwin + +=cut + +###################################################################### +###################################################################### sub popwin_js { # Print javascript out to popwin, but make sure we dont generate # any javascript errors in doing so. @@ -1446,6 +1791,17 @@ END $r->rflush(); } +###################################################################### +###################################################################### + +=pod + +=item &popwin_imgupdate() + +=cut + +###################################################################### +###################################################################### sub popwin_imgupdate { my ($r,$imgnum,$icon) = @_; &popwin_js($r,'popwin.document.img'.$imgnum.'.'. @@ -1456,41 +1812,12 @@ sub popwin_imgupdate { __END__ -=head1 NAME +=pod -Apache::lonsearchcat - mod_perl module for handling a searchable catalog - -=head1 SYNOPSIS - -Invoked by /etc/httpd/conf/srm.conf: - - - PerlAccessHandler Apache::lonacc - SetHandler perl-script - PerlHandler Apache::lonsearchcat - ErrorDocument 403 /adm/login - ErrorDocument 500 /adm/errorhandler - - -=head1 INTRODUCTION - -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. - -=head1 BEGIN SUBROUTINE - -This routine is only run once after compilation. +=back =over 4 -=item * - -Initializes %hostdomains and hostips hash table (for hosts.tab). - -=back - =head1 HANDLER SUBROUTINE This routine is called by Apache and mod_perl. @@ -1679,8 +2006,8 @@ more fields need to be filled in =item * -output_date_error(server reference, error message) : outputs -an error message specific to bad date format. +output_date_error(server reference, error message) : + =back