--- loncom/interface/lonsearchcat.pm 2002/01/17 13:53:45 1.115 +++ loncom/interface/lonsearchcat.pm 2002/06/18 21:36:38 1.121 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.115 2002/01/17 13:53:45 harris41 Exp $ +# $Id: lonsearchcat.pm,v 1.121 2002/06/18 21:36: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,19 +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; # 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 @@ -81,7 +176,8 @@ my %hash; # XML/SGML ---> sub xml_sgml_view my $basicviewselect=< - + @@ -89,44 +185,62 @@ my $basicviewselect=< - + 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{$_}; } } -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; 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'); + my $domain = $r->dir_config('lonDefDomain'); + $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::unescape($domain). + "\_".&Apache::lonnet::unescape($ENV{'user.name'})."_searchcat.db"; - $diropendb= "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['catalogmode','launch','acts','mode','form','element']); if ($ENV{'form.launch'} eq '1') { if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { @@ -140,8 +254,13 @@ sub handler { } } +# --------------------------- Produce some output, so people know it is working + + $r->print("\n"); + $r->rflush; + # ----------------------------------- configure dynamic components of interface - my $hidden=''; + if ($ENV{'form.catalogmode'} eq 'interactive') { $hidden="". "\n"; @@ -160,7 +279,12 @@ END onClick='javascript:select_group()'> END } - + $hidden .= < + + + +END # ------------------------------------------------------ Determine current user $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; @@ -305,7 +429,7 @@ $scrout.=' initial users of this syst @@ -355,19 +479,22 @@ 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; - } - } -} +###################################################################### +###################################################################### + +=pod + +=item &make_persistent() + +Returns a scalar which holds the current ENV{'form.*'} values in +a 'hidden' html input tag. +=cut + +###################################################################### +###################################################################### # ------------------------------------------------------------- make persistent + sub make_persistent { my $persistent=''; @@ -416,142 +543,42 @@ 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"; } @@ -574,10 +601,6 @@ sub selectbox { return $selout.''; } -sub testf { - return @_[0]; -} - # ----------------------------------------------- Performing an advanced search sub advancedsearch { my ($r,$envhash)=@_; @@ -596,7 +619,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', @@ -703,6 +731,12 @@ sub basicsearch { 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'})) { @@ -751,7 +785,7 @@ sub build_custommetadata_query { # quick fix to change literal into xml tag-matching # will eventually have to write a separate builder module my $oldmatchexp=$matchexp; - $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g; + $matchexp=~s/(\w+)\\=([\w\\\+]+)/\\<$1\\>\[\^\\<\]\*$2\[\^\\<\]\*\\<\\\/$1\\>/g; return $matchexp; } @@ -866,7 +900,9 @@ BEGINNING # conditional output of script functions dependent on the mode in # which the search was invoked - $r->print(<print(< function select_data(title,url) { changeTitle(title); @@ -885,7 +921,30 @@ BEGINNING } SCRIPT - $r->print(<print(< +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 + } + } + $r->print(< function select_data(title,url) { // alert('DEBUG: Should be storing '+title+' and '+url); @@ -899,12 +958,13 @@ SCRIPT } } function select_group() { - window.location="/adm/groupsort?catalogmode=groupsearch&acts="+ + window.location= + "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ document.forms.results.acts.value; } SCRIPT - $r->print(<print(< function displayinfo(val) { popwin.document.forms.popremain.sdetails.value=val; @@ -915,9 +975,7 @@ SCRIPT openhelpwin.focus(); } function abortsearch(val) { - openhelpwin=open('/adm/help/searchcat.html','helpscreen', - 'scrollbars=1,width=400,height=300'); - openhelpwin.focus(); + popwin.close(); } SCRIPT @@ -932,6 +990,7 @@ SCRIPT CATALOGBEGIN $r->print(< +$hidden @@ -975,7 +1034,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']+\"+\"'\"+'"; @@ -994,7 +1053,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>'); @@ -1022,11 +1081,11 @@ 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" '+ + ' value="close this window" '+ ' onClick="javascript:opener.abortsearch()" />'+ ' <'+'input type="button" name="button"'+ ' value="help" onClick="javascript:opener.openhelp()" />'+ @@ -1059,11 +1118,7 @@ ENDPOP my $replyfile=''; if ($reply eq 'con_lost') { - $r->print(''. - "\n"); - $r->rflush(); + &popwin_imgupdate($r,$sn,"srvbad.gif"); $bloop--; $orkey{$rkey}=1; } @@ -1075,58 +1130,31 @@ ENDPOP my $temp=0; WLOOP: while (1) { if (-e $replyfile && $tflag) { - $r->print(''. - "\n"); - $r->rflush(); - $r->print(''. - "\n"); - $r->rflush(); + &popwin_imgupdate($r,$sn,"srvhalf.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + '"still transferring..."'.';'); $tflag=0; } if (-e "$replyfile.end") { $bloop--; $orkey{$rkey}=1; if (-s $replyfile) { - $r->print(''."\n"); - $r->rflush(); + &popwin_imgupdate($r,$sn,"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,$sn,"srvempty.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); } last WLOOP; } @@ -1140,18 +1168,13 @@ ENDPOP sleep 1; $timeremain--; $elapsetime++; - $r->print(''."\n"); - $r->rflush(); + &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";'); } my $customshow=''; my $extrashow=''; @@ -1195,6 +1218,7 @@ ENDPOP $notes,$abstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; + unless ($title) { $title='Untitled'; } unless ($ENV{'user.adv'}) { $keywords='- not displayed -'; $fields[4]=$keywords; @@ -1232,10 +1256,9 @@ END END if ($ENV{'form.catalogmode'} eq 'interactive') { my $titleesc=$title; - $titleesc=~s/\'/\\'/; + $titleesc=~s/\'/\\'/; # ' - $compiledresult.=< @@ -1247,7 +1270,8 @@ END $hash{"pre_${fnum}_link"}=$url; $hash{"pre_${fnum}_title"}=$title; $compiledresult.=< +
@@ -1531,45 +1555,37 @@ 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 - +# ----------------------------------------------- send javascript to popwin +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(); +} -=head1 INTRODUCTION +sub popwin_imgupdate { + my ($r,$imgnum,$icon) = @_; + &popwin_js($r,'popwin.document.img'.$imgnum.'.'. + 'src="/adm/lonIcons/'.$icon.'";'); +} -This module enables searching for a distributed browseable catalog. +1; -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. +__END__ -=head1 BEGIN SUBROUTINE +=pod -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.