--- loncom/interface/lonsearchcat.pm 2001/12/13 14:00:37 1.112 +++ loncom/interface/lonsearchcat.pm 2002/06/20 19:43:50 1.125 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.112 2001/12/13 14:00:37 harris41 Exp $ +# $Id: lonsearchcat.pm,v 1.125 2002/06/20 19:43:50 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,11 +28,45 @@ # 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 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 ## ## ## @@ -58,98 +92,160 @@ 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 %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 +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 # -- miscellaneous variables -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 # Summary View ---> sub summary_view # Fielded Format ---> sub fielded_format_view # XML/SGML ---> sub xml_sgml_view -my $basicviewselect=< - - - - - -END -my $advancedviewselect=< - - - - - -END + +#------------------------------------------------------------- global variables +my $diropendb = ""; +my $domain = ""; # ----------------------------------------------------------------------- BEGIN -sub 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; - } - } + +=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{$_}; } } -my $diropendb = ""; -my $domain = ""; +###################################################################### +###################################################################### + +=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 -# ----------------------------- Handling routine called via Apache and mod_perl +=back + +=cut + +###################################################################### +###################################################################### sub handler { my $r = shift; untie %hash; - &get_unprocessed_cgi(); $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"; - + 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', + 'reqinterface']); + ## + ## Clear out old values from database + ## if ($ENV{'form.launch'} eq '1') { 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; } } - -# ----------------------------------- configure dynamic components of interface - my $hidden=''; + ## + ## Produce some output, so people know it is working + ## + $r->print("\n"); + $r->rflush; + ## + ## Configure dynamic components of interface + ## + my $hidden; # Holds 'hidden' html forms if ($ENV{'form.catalogmode'} eq 'interactive') { $hidden="". "\n"; $closebutton=""."\n"; - } - elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { + } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { $hidden=< END @@ -161,64 +257,164 @@ END onClick='javascript:select_group()'> END } + $hidden .= < + + + +END + ## + ## What are we doing? + ## + if ($ENV{'form.basicsubmit'} eq 'SEARCH') { + # Perform basic search and give results + return &basicsearch($r,\%ENV,$hidden); + } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { + # Perform advanced search and give results + return &advancedsearch($r,\%ENV,$hidden); + } elsif ($ENV{'form.reqinterface'} eq 'advanced') { + # Output the advanced interface + $r->print(&advanced_search_form($closebutton,$hidden)); + return OK; + } else { + # Output normal search interface + $r->print(&basic_search_form($closebutton,$hidden)); + } + return OK; +} -# ------------------------------------------------------ Determine current user - $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; +###################################################################### +###################################################################### -# --- Now, depending on the interface actions, do one of three things here: -# --- 1. a basic search -# --- 2. an advanced search -# --- 3. output a search interface +=pod -# ----------------------------------- See if a search invocation should be done - if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - untie %hash; return &basicsearch($r,\%ENV); - } - elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - untie %hash; return &advancedsearch($r,\%ENV); +=item &basic_search_form() + +Returns a scalar which holds html for the basic search form. + +=cut + +###################################################################### +###################################################################### + +sub basic_search_form{ + my ($closebutton,$hidden) = @_; + my $scrout=<<"ENDDOCUMENT"; + + +The LearningOnline Network with CAPA + + + + +

Search Catalog

+
+$hidden +

Basic Search

+

+Enter terms or phrases separated by AND, OR, or NOT then press SEARCH below. +

+

+ +
+ENDDOCUMENT + $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40). + ' '; +# $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'}); +# $scrout.='Search historic archives'; + $scrout.=<Advanced Search
+

+

+   +$closebutton + + + + +

+
+ + +ENDDOCUMENT + return $scrout; +} +###################################################################### +###################################################################### + +=pod + +=item &advanced_search_form() + +Returns a scalar which holds html for the advanced search form. + +=cut + +###################################################################### +###################################################################### -# ----------------------------- Else, begin building search interface to output - $scrout=''; # building a part of screen output +sub advanced_search_form{ + my ($closebutton,$hidden) = @_; + my $scrout=<<"ENDHEADER"; + + +The LearningOnline Network with CAPA + + + + +

Search Catalog

+
+$hidden +
+

Advanced Search

+ENDHEADER $scrout.=&searchphrasefield('Limit by title','title', $ENV{'form.title'}); - $scrout.=&searchphrasefield('Limit by author','author', $ENV{'form.author'}); - $scrout.=&searchphrasefield('Limit by subject','subject', $ENV{'form.subject'}); - $scrout.=&searchphrasefield('Limit by keywords','keywords', $ENV{'form.keywords'}); - $scrout.=&searchphrasefield('Limit by URL','url', $ENV{'form.url'}); - # $scrout.=&searchphrasefield('Limit by version','version', # $ENV{'form.version'}); - $scrout.=&searchphrasefield('Limit by notes','notes', $ENV{'form.notes'}); - $scrout.=&searchphrasefield('Limit by abstract','abstract', $ENV{'form.abstract'}); - $ENV{'form.mime'}='any' unless length($ENV{'form.mime'}); $scrout.=&selectbox('Limit by MIME type','mime', $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'},'any','Any Language', \&{Apache::loncommon::languagedescription}, (&Apache::loncommon::languageids), ); - # ------------------------------------------------ Compute date selection boxes $scrout.=< @@ -232,16 +428,13 @@ CREATIONDATESTART $ENV{'form.creationdatestart_day'}, $ENV{'form.creationdatestart_year'}, ); - $scrout.=< LIMIT BY LAST REVISION DATE RANGE: @@ -262,10 +455,8 @@ LASTREVISIONDATEEND $ENV{'form.lastrevisiondateend_year'}, ); $scrout.='

'; - $scrout.=&searchphrasefield('Limit by publisher/owner','owner', $ENV{'form.owner'}); - $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); $scrout.=&selectbox('Limit by copyright/distribution','copyright', $ENV{'form.copyright'}, @@ -273,7 +464,6 @@ LASTREVISIONDATEEND \&{Apache::loncommon::copyrightdescription}, (&Apache::loncommon::copyrightids), ); - # ------------------------------------------- Compute customized metadata field $scrout.=< @@ -284,9 +474,7 @@ For resource-specific metadata, enter in Example: grandmother=75 OR grandfather=85
CUSTOMMETADATA -$scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); -$scrout.=' initial users of this system do not need to worry about this option'; - + $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); $scrout.=< SHOW SPECIAL METADATA FIELDS: @@ -295,83 +483,47 @@ Enter in a space-separated list of speci in a fielded listing for each record result.
CUSTOMSHOW -$scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); -$scrout.=' initial users of this system do not need to worry about this option'; - -# ---------------------------------------------------------------- Print screen - $r->print(< - -The LearningOnline Network with CAPA - - - - -

Search Catalog

- -$hidden -
-

Basic Search

-

-Enter terms or phrases separated by search operators -such as AND, OR, or NOT then press SEARCH below. Terms should be specific -to the title, author, subject, notes, or abstract information associated -with a resource. -
-ENDDOCUMENT - $r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'})); - $r->print(' '); - $r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'})); - $r->print('Title only '); -# $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'})); -# Search historic archives - $r->print(< - - -$closebutton -$basicviewselect - -

-
-

Advanced Search

-$scrout + $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); + $scrout.=< $closebutton -$advancedviewselect + + +

ENDDOCUMENT - return OK; -} - -# ----------- grab unprocessed CGI variables that may have been appended to URL -sub get_unprocessed_cgi { - foreach (split(/&/,$ENV{'QUERY_STRING'})) { - 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; - } - } + return $scrout; } -# ------------------------------------------------------------- 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=''; - foreach (keys %ENV) { if (/^form\./ && !/submit/) { my $name=$_; @@ -379,180 +531,122 @@ sub make_persistent { $ENV{$key}=~s/\'//g; # do not mess with html field syntax $name=~s/^form\.//; $persistent.=< + 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 { my ($name,$defaultmonth,$defaultday,$defaultyear, $currentmonth,$currentday,$currentyear)=@_; ($defaultmonth,$defaultday,$defaultyear)=('','',''); - my $month=< - - - - - - - - - - - - - - -END - $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); + # + # Day my $day=< - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END + for (my $i = 1; $i<=31; $i++) { + $day.="\n"; + } + $day.="\n"; $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); + # + # Month + my $month=< + +END + my $i = 1; + foreach (qw/January February March April May June + July August September October November December /){ + $month .="\n"; + $i++; + } + $month.="\n"; + $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); + # + # Year (obviously) my $year=< - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END + my $maxyear = 2051; + for (my $i = 1976; $i<=$maxyear; $i++) { + $year.="\n"; + } + $year.="\n"; $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); return "$month$day$year"; } @@ -560,30 +654,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.''; } -sub testf { - return @_[0]; -} +###################################################################### +###################################################################### + +=pod + +=item &advancedsearch() -# ----------------------------------------------- Performing an advanced search +=cut + +###################################################################### +###################################################################### sub advancedsearch { - my ($r,$envhash)=@_; + my ($r,$envhash,$hidden)=@_; my %ENV=%{$envhash}; - my $fillflag=0; # Clean up fields for safety for my $field ('title','author','subject','keywords','url','version', @@ -597,7 +696,12 @@ sub advancedsearch { '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', @@ -610,11 +714,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', @@ -656,7 +757,6 @@ sub advancedsearch { elsif ($datequery) { push @queries,$datequery; } - # Process form information for custom metadata querying my $customquery=''; if ($ENV{'form.custommetadata'}) { @@ -684,26 +784,42 @@ sub advancedsearch { $reply=&Apache::lonnet::metadata_query($query, $customquery,$customshow); } - &output_results('Advanced',$r,$envhash,$customquery,$reply); + &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); + &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden); } # should not get to this point return 'Error. Should not have gone to this point.'; } -# --------------------------------------------------- Performing a basic search +###################################################################### +###################################################################### + +=pod + +=item &basicsearch() + +=cut + +###################################################################### +###################################################################### sub basicsearch { - my ($r,$envhash)=@_; + 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'})) { @@ -714,7 +830,8 @@ sub basicsearch { # Build SQL query string based on form page my $query=''; my $concatarg=join('," ",', - ('title', 'author', 'subject', 'notes', 'abstract')); + ('title', 'author', 'subject', 'notes', 'abstract', + 'keywords')); $concatarg='title' if $ENV{'form.titleonly'}; $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); @@ -724,12 +841,23 @@ sub basicsearch { # Output search results - &output_results('Basic',$r,$envhash,$query,$reply); + &output_results('Basic',$r,$envhash,$query,$reply,$hidden); 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', @@ -741,9 +869,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'); @@ -751,12 +891,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); @@ -790,7 +946,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)=@_; @@ -839,91 +1005,39 @@ 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)=@_; + 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(); - - # output beginning of search page - $r->print(< - -The LearningOnline Network with CAPA -BEGINNING - - # conditional output of script functions dependent on the mode in - # which the search was invoked - $r->print(< - function select_data(title,url) { - changeTitle(title); - changeURL(url); - self.close(); - } - 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(< - function select_data(title,url) { -// alert('DEBUG: Should be storing '+title+' and '+url); - } - function queue(val) { - if (eval("document.forms.results.returnvalues["+val+"].checked")) { - document.forms.results.acts.value+='1a'+val+'b'; - } - else { - document.forms.results.acts.value+='0a'+val+'b'; - } - } - function select_group() { - window.location="/adm/groupsort?catalogmode=groupsearch&acts="+ - document.forms.results.acts.value; - } - -SCRIPT - $r->print(< - function displayinfo(val) { - popwin.document.forms.popremain.sdetails.value=val; - } - function openhelp(val) { - openhelpwin=open('/adm/help/searchcat.html','helpscreen', - '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 + # spit out the generic header + $r->print(&search_results_header()); $r->rflush(); - # begin showing the cataloged results $r->print(< @@ -933,6 +1047,7 @@ SCRIPT CATALOGBEGIN $r->print(< +$hidden @@ -942,218 +1057,97 @@ $persistent

Search Query

CATALOGCONTROLS + # + # Remind them what they searched for + # if ($mode eq 'Basic') { - $r->print(< -Basic search: $ENV{'form.basicexp'} -

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

-RESULTS + $r->print('

Basic search: '.$ENV{'form.basicexp'}.'

'); + } elsif ($mode eq 'Advanced') { + $r->print('

Advanced search '.$query.'

'); } $r->print('

Search Results

'); $r->rflush(); - my $servernum=(keys %rhash)+0; - - # define server grid (shows status of multiple machines) - my $hcinit; - my $grid="'
'+"; - $grid.="\n"; - my $sn=1; - for my $sk (sort keys %rhash) { - # ''+ - $grid.="'+\"'\"+')\">'+"; - $grid.="\n"; - $grid.="'\"".$sk."\"'+\n"; - $grid.="'
'+\n" unless $sn%10; - $sn++; - } - $r->print(< - popwin=open('','popwin','scrollbars=1,width=400,height=200'); - popwin.focus(); - popwin.document.writeln('<'+'html>'); - popwin.document.writeln('<'+'head>'); - popwin.document.writeln('<'+'script>'); - popwin.document.writeln('hc=new Array();$hcinit'); - popwin.document.writeln('<'+'/script>'); - popwin.document.writeln('<'+'/head>'+ - '<'+'body bgcolor="#FFFFFF">'+ - '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+ - 'lonanim.gif" '+ - 'alt="animated logo" />'+ - '<'+'h3>Search Results Progress<'+'/h3>'+ - '<'+'form name="popremain">'+ - '<'+'tt>'+ - '<'+'br clear="all"/>PLEASE BE PATIENT'+ - '<'+'br />SCANNING $servernum SERVERS'+ - '<'+'br clear="all" />Number of record hits found '+ - '<'+'input type="text" size="10" name="numhits"'+ - ' value="0" />'+ - '<'+'br clear="all" />Time elapsed '+ - '<'+'input type="text" size="10" name="elapsetime"'+ - ' value="0" />'+ - '<'+'br />'+ - 'SERVER GRID (click on any cell for details)'+ - $grid - '<'+'br />'+ - 'Server details '+ - '<'+'input type="text" size="25" 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>'+ - '<'+'/form>'+ - '<'+'/body><'+'/html>'); - popwin.document.close(); - -ENDPOP + # + # 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 $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}; + 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; - - my $replyfile=''; - if ($reply eq 'con_lost') { - $r->print(''. - "\n"); - $r->rflush(); - $bloop--; - $orkey{$rkey}=1; - } - else { - $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting - $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; + &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) { - $r->print(''. - "\n"); - $r->rflush(); - $r->print(''. - "\n"); - $r->rflush(); + &popwin_imgupdate($r,$rkey,"srvhalf.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + '"still transferring..."'.';'); $tflag=0; } if (-e "$replyfile.end") { - $bloop--; - $orkey{$rkey}=1; + $serversleft--; + delete $rhash{$rkey}; if (-s $replyfile) { - $r->print(''."\n"); - $r->rflush(); + &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; - $r->print(''. - "\n"); - $r->rflush(); + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + $hitcount{$rkey}.';'); $hitcountsum+=$hitcount{$rkey}; - $r->print(''. - "\n"); - $r->rflush(); + &popwin_js($r,'popwin.document.forms.popremain.'. + 'numhits.value='.$hitcountsum.';'); } else { - $r->print(''. - "\n"); - $r->rflush(); - $r->print(''. - "\n"); - $r->rflush(); + &popwin_imgupdate($r,$rkey,"srvempty.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); } last WLOOP; - } - if ($temp>1) { - sleep 1; - $timeremain--; - $elapsetime++; - last WLOOP; - } + } # end of if ( -e "$replyfile.end") last WLOOP unless $timeremain; - sleep 1; + sleep 1; # wait for daemons to write files? $timeremain--; $elapsetime++; - $r->print(''."\n"); - $r->rflush(); + last WLOOP if ($temp>1); + &popwin_js($r,"popwin.document.popremain.". + "elapsetime.value=$elapsetime;"); $temp++; } } - $r->print(''."\n"); - $r->rflush(); - } + &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; @@ -1195,7 +1189,7 @@ ENDPOP 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; @@ -1231,18 +1225,24 @@ END $compiledresult.=< END - $compiledresult.=< +onClick="javascript:select_data('$titleesc','$url')">
END + } if ($ENV{'form.catalogmode'} eq 'groupsearch') { $fnum+=0; $hash{"pre_${fnum}_link"}=$url; $hash{"pre_${fnum}_title"}=$title; $compiledresult.=< +
@@ -1307,7 +1307,225 @@ RESULTS RESULTS } -# ------------------------------------------------------ Detailed Citation View +###################################################################### +###################################################################### + +=pod + +=item &search_results_header + +=cut + +###################################################################### +###################################################################### +sub search_results_header { + my $result = ''; + # output beginning of search page + $result.=< + +The LearningOnline Network with CAPA +BEGINNING + # conditional output of script functions dependent on the mode in + # which the search was invoked + if ($ENV{'form.catalogmode'} eq 'interactive'){ + if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { + $result.=< + function select_data(title,url) { + changeTitle(title); + changeURL(url); + self.close(); + } + 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 + } elsif ($ENV{'form.mode'} eq 'edit') { + my $form = $ENV{'form.form'}; + my $element = $ENV{'form.element'}; + $result.=< +function select_data(title,url) { + changeURL(url); + self.close(); +} +function changeTitle(val) { +} +function changeURL(val) { + if (window.opener.document) { + window.opener.document.forms["$form"].elements["$element"].value=val; + } else { + var url = 'forms[\"$form\"].elements[\"$element\"].value'; + alert("Unable to transfer data to "+url); + } +} + +SCRIPT + } + } + $result.=< +SCRIPT + $result.=< + function displayinfo(val) { + popwin.document.forms.popremain.sdetails.value=val; + } + function openhelp(val) { + openhelpwin=open('/adm/help/searchcat.html','helpscreen', + 'scrollbars=1,width=400,height=300'); + openhelpwin.focus(); + } + function abortsearch(val) { + popwin.close(); + } + +SCRIPT + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &make_popwin() + +Returns html with javascript in it to open up the status window. + +=cut + +###################################################################### +###################################################################### +sub make_popwin { + my %rhash = @_; + my $servernum=(keys %rhash); + my $hcinit; + my $grid="'
'+\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.="'\"".$sk."\"'+\n"; + $grid.="'
'+\n" unless $sn%10; + $sn++; + } + my $result.=< + popwin=open('','popwin','scrollbars=1,width=400,height=220'); + popwin.focus(); + popwin.document.writeln('<'+'html>'); + popwin.document.writeln('<'+'head>'); + popwin.document.writeln('<'+'script>'); + popwin.document.writeln('hc=new Array();$hcinit'); + popwin.document.writeln('<'+'/script>'); + popwin.document.writeln('<'+'/head>'+ + '<'+'body bgcolor="#FFFFFF">'+ + '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+ + 'lonanim.gif" '+ + 'alt="animated logo" />'+ + '<'+'h3>Search Results Progress<'+'/h3>'+ + '<'+'form name="popremain">'+ + '<'+'tt>'+ + '<'+'br clear="all"/>PLEASE BE PATIENT'+ + '<'+'br />SCANNING $servernum SERVERS'+ + '<'+'br clear="all" />Number of record hits found '+ + '<'+'input type="text" size="10" name="numhits"'+ + ' value="0" />'+ + '<'+'br clear="all" />Time elapsed '+ + '<'+'input type="text" size="10" name="elapsetime"'+ + ' value="0" />'+ + '<'+'br />'+ + 'SERVER GRID (click on any cell for details)'+ + $grid + '<'+'br />'+ + 'Server details '+ + '<'+'input type="text" size="35" name="sdetails"'+ + ' value="" />'+ + '<'+'br />'+ + ' <'+'input type="button" name="button"'+ + ' value="close this window" '+ + ' onClick="javascript:opener.abortsearch()" />'+ + ' <'+'input type="button" name="button"'+ + ' value="help" onClick="javascript:opener.openhelp()" />'+ + '<'+'/tt>'+ + '<'+'/form>'+ + '<'+'/body><'+'/html>'); + popwin.document.close(); + +ENDPOP + return $result; +} + +###################################################################### +###################################################################### + +=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, @@ -1346,7 +1564,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, @@ -1364,7 +1592,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, @@ -1395,7 +1633,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, @@ -1437,7 +1687,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') { @@ -1448,7 +1708,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 @@ -1482,18 +1752,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(< @@ -1513,7 +1793,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) { @@ -1526,56 +1819,60 @@ sub start_fresh_session { } } -1; - -__END__ - -=head1 NAME - -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 - +=pod -=head1 INTRODUCTION +=item &popwin_js() send javascript to popwin -This module enables searching for a distributed browseable catalog. +=cut -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. - -=head1 BEGIN SUBROUTINE +###################################################################### +###################################################################### +sub popwin_js { + # Print javascript out to popwin, but make sure we dont generate + # any javascript errors in doing so. + my ($r,$text) = @_; + $r->print(<<"END"); + +END + $r->rflush(); +} -This routine is only run once after compilation. +###################################################################### +###################################################################### -=over 4 +=pod -=item * +=item &popwin_imgupdate() -Initializes %language hash table. +Send a given image (and its location) out to the browser. Takes as +input $r, loncapa server id, and an icon URL. -=item * +=cut -Initializes %cprtag hash table (for copyright.tab). +###################################################################### +###################################################################### +sub popwin_imgupdate { + my ($r,$server,$icon) = @_; + &popwin_js($r,'popwin.document.img_'.$hostdomains{$server}.'_'.$server.'.'. + 'src="/adm/lonIcons/'.$icon.'";'); +} -=item * +1; -Initializes %mimetag hash table (for filetypes.tab). +__END__ -=item * +=pod -Initializes %hostdomains and hostips hash table (for hosts.tab). +=back -=back +=over 4 =head1 HANDLER SUBROUTINE @@ -1765,8 +2062,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