--- loncom/interface/lonsearchcat.pm 2001/10/16 17:12:51 1.101 +++ loncom/interface/lonsearchcat.pm 2002/03/07 20:12:36 1.116 @@ -1,106 +1,50 @@ # The LearningOnline Network with CAPA -# # Search Catalog # -# YEAR=2001 -# 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, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001 -# Scott Harrison: 04/02/2001, 08/15/2001, 08/24/2001, 08/25/2001 -# 10/12,10/14,10/15 Scott Harrison - -############################################################################### -## ## -## ORGANIZATION OF THIS PERL MODULE ## -## ## -## 1. Description of functions ## -## 2. Modules used by this module ## -## 3. Choices for different output views (detailed, summary, xml, etc) ## -## 4. BEGIN block (to be run once after compilation) ## -## 5. Handling routine called via Apache and mod_perl ## -## 6. Other subroutines ## -## ## -############################################################################### - -# ---------------------------------------------------- Description of functions -# -# -# === WEB HANDLER FUNCTIONS -# BEGIN() : run once after compilation to initialize values -# handler(server reference) : interacts with the Apache server layer -# (for /adm/searchcat URLs) -# get_unprocessed_cgi() : reads in critical name/value pairs that may have not -# been processed and passed into %ENV by the web server -# make_persistent() : makes a set of hidden HTML fields to make -# SQL search interface information to be persistent -# -# -# === WEB INTERFACE COMPONENT FUNCTIONS -# simpletextfield(name,value) : returns HTML formatted string for simple text -# field -# simplecheckbox(name,value) : returns HTML formatted string for simple -# checkbox -# searchphrasefield(title,name,value) : returns HTML formatted string for -# a search expression phrase field -# dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML -# formatted string -# for a calendar date -# selectbox(title,name,value,%HASH=options) : returns HTML formatted string for -# a selection box field -# +# $Id: lonsearchcat.pm,v 1.116 2002/03/07 20:12:36 matthew Exp $ # -# === SEARCH FUNCTIONS -# advancedsearch(server reference, environment reference) : perform a complex -# multi-field logical query -# basicsearch(server reference, environment reference) : perform a simple -# single-field logical query -# build_SQL_query(field name, logic) : builds a SQL query string from a -# 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 -# 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_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2, -# lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) : -# Builds a SQL logic query to check time/date entries. +# Copyright Michigan State University Board of Trustees # +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). # -# === OUTPUTTING RESULTS FUNCTION -# output_results(output mode, -# server reference, -# environment reference, -# reply list reference) : outputs results from search +# 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. # -# === DIFFERENT WAYS TO VIEW METADATA RECORDS -# detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -# see metadata viewing notes below -# summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -# see metadata viewing notes below -# fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -# see metadata viewing notes below -# xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -# see metadata viewing notes below -# ___________________________________________________________________________ -# | * Metadata viewing notes | -# | 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. | -# --------------------------------------------------------------------------- +# 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 # -# === TEST CONDITIONAL FUNCTIONS -# filled(field) : determines whether a given field has been filled +# 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 # -# === ERROR FUNCTIONS -# output_blank_field_error(server reference) : outputs a message saying that -# more fields need to be filled in -# output_date_error(server reference, error message) : outputs -# an error message specific to bad date format. +### + +############################################################################### +## ## +## 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; @@ -112,13 +56,11 @@ use Apache::File(); use CGI qw(:standard); use Text::Query; use GDBM_File; +use Apache::loncommon(); # ---------------------------------------- variables used throughout the module # -- information holders -my %language; # holds contents of language.tab -my %cprtag; # holds contents of copyright.tab -my %mimetag; # holds contents of filetypes.tab my %hostdomains; # matches host name to host domain my %hostips; # matches host name to host ip my %hitcount; # stores number of hits per host @@ -155,45 +97,17 @@ my $advancedviewselect=<new($Apache::lonnet::perlvar{'lonTabDir'}. - '/language.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; chomp; - $language{$1}=$2; - } <$fh>; - } - $cprtag{'any'}='Any copyright/distribution'; - { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}. - '/copyright.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; chomp; - $cprtag{$1}=$2; - } <$fh>; - } - $mimetag{'any'}='Any type'; - { - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. - '/filetypes.tab'); - map { - $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; chomp; - $mimetag{$1}=".$1 $3"; - } <$fh>; - } +BEGIN { { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. '/hosts.tab'); - map { + while (<$fh>) { $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp; if ($3 eq 'library') { $hostdomains{$1}=$2; $hostips{$1}=$4; } - } <$fh>; + } } } @@ -203,16 +117,17 @@ my $domain = ""; # ----------------------------- Handling routine called via Apache and mod_perl sub handler { my $r = shift; - - &get_unprocessed_cgi(); + untie %hash; $r->content_type('text/html'); $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"; - $diropendb = "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_indexer.db"; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['catalogmode','launch','acts']); if ($ENV{'form.launch'} eq '1') { if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { @@ -289,15 +204,20 @@ END $scrout.=&searchphrasefield('Limit by abstract','abstract', $ENV{'form.abstract'}); - $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'}); + $ENV{'form.mime'}='any' unless length($ENV{'form.mime'}); $scrout.=&selectbox('Limit by MIME type','mime', - $ENV{'form.mime'},%mimetag); + $ENV{'form.mime'}, + 'any','Any type', + \&{Apache::loncommon::filedescriptionex}, + (&Apache::loncommon::fileextensions)); $ENV{'form.language'}='any' unless length($ENV{'form.language'}); $scrout.=&selectbox('Limit by language','language', - $ENV{'form.language'},%language); - + $ENV{'form.language'},'any','Any Language', + \&{Apache::loncommon::languagedescription}, + (&Apache::loncommon::languageids), + ); # ------------------------------------------------ Compute date selection boxes $scrout.=< @@ -432,23 +356,11 @@ ENDDOCUMENT return OK; } -# ----------- grab unprocessed CGI variables that may have been appended to URL -sub get_unprocessed_cgi { - map { - my ($name, $value) = split(/=/,$_); - $value =~ tr/+/ /; - $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - if ($name eq 'catalogmode' or $name eq 'launch' or $name eq 'acts') { - $ENV{'form.'.$name}=$value; - } - } (split(/&/,$ENV{'QUERY_STRING'})); -} - # ------------------------------------------------------------- make persistent sub make_persistent { my $persistent=''; - map { + foreach (keys %ENV) { if (/^form\./ && !/submit/) { my $name=$_; my $key=$name; @@ -458,7 +370,7 @@ sub make_persistent { END } - } (keys %ENV); + } return $persistent; } @@ -634,18 +546,27 @@ END } sub selectbox { - my ($title,$name,$value,%options)=@_; + my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; my $uctitle=uc($title); my $selout="\n

$uctitle:". "
".''; } +sub testf { + return @_[0]; +} + # ----------------------------------------------- Performing an advanced search sub advancedsearch { my ($r,$envhash)=@_; @@ -917,7 +838,7 @@ sub output_results { my %ENV=%{$envhash}; my %rhash=%{$replyref}; my $compiledresult=''; - my $timeremain=30; + my $timeremain=300; my $elapsetime=0; my $resultflag=0; my $tflag=1; @@ -982,6 +903,11 @@ SCRIPT 'scrollbars=1,width=400,height=300'); openhelpwin.focus(); } + function abortsearch(val) { + openhelpwin=open('/adm/help/searchcat.html','helpscreen', + 'scrollbars=1,width=400,height=300'); + openhelpwin.focus(); + } SCRIPT $r->rflush(); @@ -1038,7 +964,7 @@ RESULTS $grid.=$sk; my $hc; if ($rhash{$sk} eq 'con_lost') { - $hc="!!!BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR!!!"; + $hc="BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR "; } else { $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'"; @@ -1057,7 +983,7 @@ RESULTS } $r->print(< - popwin=open('','popwin','scrollbars=1,width=400,height=200'); + popwin=open('','popwin','scrollbars=1,width=400,height=220'); popwin.focus(); popwin.document.writeln('<'+'html>'); popwin.document.writeln('<'+'head>'); @@ -1085,12 +1011,12 @@ RESULTS $grid '<'+'br />'+ 'Server details '+ - '<'+'input type="text" size="25" name="sdetails"'+ + '<'+'input type="text" size="35" name="sdetails"'+ ' value="" />'+ '<'+'br />'+ ' <'+'input type="button" name="button"'+ ' value="abort search and view current results" '+ - ' />'+ + ' onClick="javascript:opener.abortsearch()" />'+ ' <'+'input type="button" name="button"'+ ' value="help" onClick="javascript:opener.openhelp()" />'+ '<'+'/tt>'+ @@ -1102,10 +1028,16 @@ ENDPOP $r->rflush(); my $servercount=0; - $sn=0; my $hitcountsum=0; - foreach my $rkey (sort keys %rhash) { + my $bloop=$servernum; + my %orkey; + BLOOP: while(1) { + my $sn=0; + last BLOOP unless $bloop; + last BLOOP unless $timeremain; + RLOOP: foreach my $rkey (sort keys %rhash) { $sn++; + next RLOOP if $orkey{$rkey}; $servercount++; $tflag=1; $compiledresult=''; @@ -1121,6 +1053,8 @@ ENDPOP 'src="/adm/lonIcons/srvbad.gif";'. "\n"); $r->rflush(); + $bloop--; + $orkey{$rkey}=1; } else { $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting @@ -1142,8 +1076,9 @@ ENDPOP $r->rflush(); $tflag=0; } - last WLOOP if $temp>5; if (-e "$replyfile.end") { + $bloop--; + $orkey{$rkey}=1; if (-s $replyfile) { $r->print('