--- loncom/interface/lonsearchcat.pm 2001/08/26 21:19:35 1.98 +++ loncom/interface/lonsearchcat.pm 2002/05/22 16:21:50 1.119 @@ -1,105 +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 - -############################################################################### -## ## -## 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.119 2002/05/22 16:21:50 www 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; @@ -110,13 +55,12 @@ use Apache::lonnet(); 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 @@ -124,11 +68,12 @@ my %hitcount; # stores number of hits pe # -- dynamically rendered interface components my $closebutton; # button that closes the search window my $importbutton; # button to take the selected results and go to group sorting +my $hidden; # -- miscellaneous variables my $scrout; # string that holds portions of the screen output -my $fnum; # search result counter my $yourself; # allows for quickly limiting to oneself +my %hash; # ------------------------------------------ choices for different output views # Detailed Citation View ---> sub detailed_citation_view @@ -153,60 +98,58 @@ 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>; + } } } +#------------------------------------------------------------- global variables +my $diropendb = ""; +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"; + + &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)) { + &start_fresh_session(); + untie %hash; + } + else { + $r->print('Unable to tie hash to db '. + 'file'); + return OK; + } + } + +# --------------------------- 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"; @@ -225,7 +168,12 @@ END onClick='javascript:select_group()'> END } - + $hidden .= < + + + +END # ------------------------------------------------------ Determine current user $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; @@ -236,10 +184,10 @@ END # ----------------------------------- See if a search invocation should be done if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - return &basicsearch($r,\%ENV); + untie %hash; return &basicsearch($r,\%ENV); } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - return &advancedsearch($r,\%ENV); + untie %hash; return &advancedsearch($r,\%ENV); } # ----------------------------- Else, begin building search interface to output @@ -268,15 +216,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.=<LIMIT BY SPECIAL METADATA FIELDS: For resource-specific metadata, enter in an expression in the form of -key=value separated by operators such as AND or OR.
+key=value separated by operators such as AND, OR or NOT.
Example: grandmother=75 OR grandfather=85
CUSTOMMETADATA @@ -358,6 +315,13 @@ $scrout.=' initial users of this syst The LearningOnline Network with CAPA + @@ -368,7 +332,7 @@ $hidden

Basic Search

Enter terms or phrases separated by search operators -such as AND or OR then press SEARCH below. Terms should be specific +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.
@@ -385,6 +349,7 @@ ENDDOCUMENT $closebutton $basicviewselect +

Advanced Search

@@ -394,6 +359,7 @@ $scrout $closebutton $advancedviewselect +

@@ -402,23 +368,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') { - $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; @@ -428,7 +382,7 @@ sub make_persistent { END } - } (keys %ENV); + } return $persistent; } @@ -451,7 +405,7 @@ sub searchphrasefield { my ($title,$name,$value)=@_; my $instruction=<$uctitle:". @@ -463,156 +417,61 @@ 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"; } sub selectbox { - my ($title,$name,$value,%options)=@_; + my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; my $uctitle=uc($title); my $selout="\n

$uctitle:". "
".''; } @@ -632,9 +491,14 @@ sub advancedsearch { 'lastrevisiondateend_day','lastrevisiondateend_year', 'notes','abstract','mime','language','owner', 'custommetadata','customshow') { - $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g; + $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', @@ -741,6 +605,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'})) { @@ -882,11 +752,12 @@ sub build_date_queries { # gives the status of the network search (time elapsed, number of machines # contacted, etc.) sub output_results { + my $fnum; # search result counter my ($mode,$r,$envhash,$query,$replyref)=@_; my %ENV=%{$envhash}; my %rhash=%{$replyref}; my $compiledresult=''; - my $timeremain=30; + my $timeremain=300; my $elapsetime=0; my $resultflag=0; my $tflag=1; @@ -903,8 +774,10 @@ BEGINNING # conditional output of script functions dependent on the mode in # which the search was invoked - $r->print(< + if ($ENV{'form.catalogmode'} eq 'interactive'){ + if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { + $r->print(< function select_data(title,url) { changeTitle(title); changeURL(url); @@ -922,13 +795,36 @@ BEGINNING } SCRIPT - $r->print(< + } elsif ($ENV{'form.mode'} eq 'edit') { + my $form = $ENV{'form.form'}; + my $element = $ENV{'form.element'}; + $r->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); +// alert('DEBUG: Should be storing '+title+' and '+url); } function queue(val) { - if (eval("document.forms."+val+".filelink.checked")) { + if (eval("document.forms.results.returnvalues["+val+"].checked")) { document.forms.results.acts.value+='1a'+val+'b'; } else { @@ -936,15 +832,25 @@ SCRIPT } } function select_group() { - alert('DEBUG: Should be moving on to group sorting stage'+' acts'); + window.location= + "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ + document.forms.results.acts.value; } SCRIPT - $r->print(< + $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) { + popwin.close(); + } SCRIPT $r->rflush(); @@ -958,6 +864,7 @@ SCRIPT CATALOGBEGIN $r->print(< +$hidden @@ -998,28 +905,29 @@ RESULTS $grid.="javascript:opener.displayinfo('+"; # "'"+'key $grid.="\"'\"+'"; - $grid.=$sk." domain=".$hostdomains{$sk}; + $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']+\"+\"'\"+'"; - $hcinit.="hc[\"$sk\"]=0;"; + $hcinit.="hc[\"$sk\"]=\"not yet connected...\";"; } $grid.=" hitcount=".$hc; + $grid.=" domain=".$hostdomains{$sk}; $grid.=" IP=".$hostips{$sk}; # '+"'"+'">'+ $grid.="'+\"'\"+')\">'+"; $grid.="\n"; $grid.="'\"".$sk."\"'+\n"; + " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" />'+\n"; $grid.="'
'+\n" unless $sn%10; $sn++; } $r->print(< - popwin=open('','popwin','scrollbars=1,width=400,height=200'); +'); - $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=''; my $hostname=$rkey; - $r->print(''."\n"); - $r->rflush(); my $reply=$rhash{$rkey}; my @results; my $replyfile=''; if ($reply eq 'con_lost') { - my $percent=sprintf('%3.0f',($servercount/$servernum*100)); - $r->print(''); + &popwin_imgupdate($r,$sn,"srvbad.gif"); + $bloop--; + $orkey{$rkey}=1; } else { $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting @@ -1102,55 +1004,51 @@ 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; } - last WLOOP if $temp>5; 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 { + &popwin_imgupdate($r,$sn,"srvempty.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); } last WLOOP; } + if ($temp>1) { + sleep 1; + $timeremain--; + $elapsetime++; + last WLOOP; + } last WLOOP unless $timeremain; sleep 1; $timeremain--; $elapsetime++; - $r->print(''."\n"); - $r->rflush(); - $r->print(''."\n"); - $r->rflush(); + &popwin_js($r,"popwin.document.popremain.". + "elapsetime.value=$elapsetime;"); $temp++; } } + &popwin_js($r,'popwin.document.whirly.'. + 'src="/adm/lonIcons/lonanimend.gif";'); } my $customshow=''; my $extrashow=''; @@ -1176,80 +1074,122 @@ ENDPOP $customhash{$k}=$v; } } - foreach my $result (@results) { - next if $result=~/^custom\=/; - chomp $result; - next unless $result; - my @fields=map - {&Apache::lonnet::unescape($_)} - (split(/\,/,$result)); - my ($title,$author,$subject,$url,$keywords,$version, - $notes,$abstract,$mime,$lang, - $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; - my $shortabstract=$abstract; - $shortabstract=substr($abstract,0,200) if length($abstract)>200; - $fields[7]=$shortabstract; - my $extrashow2=$extrashow; - if ($extrashow) { - foreach my $field (@customfields) { - my $value=''; - if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) { - $value=$1; - } - $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g; - } - } + if (keys %hash) { + untie %hash; + } + if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { + if ($ENV{'form.launch'} eq '1') { + &start_fresh_session(); + } + foreach my $result (@results) { + next if $result=~/^custom\=/; + chomp $result; + next unless $result; + my @fields=map + {&Apache::lonnet::unescape($_)} + (split(/\,/,$result)); + my ($title,$author,$subject,$url,$keywords,$version, + $notes,$abstract,$mime,$lang, + $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; + + unless ($title) { $title='Untitled'; } + unless ($ENV{'user.adv'}) { + $keywords='- not displayed -'; + $fields[4]=$keywords; + $notes='- not displayed -'; + $fields[6]=$notes; + $abstract='- not displayed -'; + $fields[7]=$abstract; + $subject='- not displayed -'; + $fields[2]=$subject; + } + + my $shortabstract=$abstract; + $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200; + $fields[7]=$shortabstract; + my $shortkeywords=$keywords; + $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200; + $fields[4]=$shortkeywords; + + my $extrashow2=$extrashow; + if ($extrashow) { + foreach my $field (@customfields) { + my $value=''; + if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) { + $value=$1; + } + $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g; + } + } - $compiledresult.=< END - $compiledresult.=< END - $compiledresult.=< +onClick="javascript:select_data('$titleesc','$url')">
END - $compiledresult.=< + - -
END - my $httphost=$ENV{'HTTP_HOST'}; - - my $viewselect; - if ($mode eq 'Basic') { - $viewselect=$ENV{'form.basicviewselect'}; - } - elsif ($mode eq 'Advanced') { - $viewselect=$ENV{'form.advancedviewselect'}; - } +# +# + $fnum++; + } + my $httphost=$ENV{'HTTP_HOST'}; + + my $viewselect; + if ($mode eq 'Basic') { + $viewselect=$ENV{'form.basicviewselect'}; + } + elsif ($mode eq 'Advanced') { + $viewselect=$ENV{'form.advancedviewselect'}; + } - if ($viewselect eq 'Detailed Citation View') { - $compiledresult.=&detailed_citation_view(@fields, + if ($viewselect eq 'Detailed Citation View') { + $compiledresult.=&detailed_citation_view(@fields, $hostname,$httphost, $extrashow2); - } - elsif ($viewselect eq 'Summary View') { - $compiledresult.=&summary_view(@fields,$hostname,$httphost, + } + elsif ($viewselect eq 'Summary View') { + $compiledresult.=&summary_view(@fields,$hostname,$httphost, $extrashow2); - } - elsif ($viewselect eq 'Fielded Format') { - $compiledresult.=&fielded_format_view(@fields,$hostname, + } + elsif ($viewselect eq 'Fielded Format') { + $compiledresult.=&fielded_format_view(@fields,$hostname, $httphost,$extrashow2); - } - elsif ($viewselect eq 'XML/SGML') { - $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost, + } + elsif ($viewselect eq 'XML/SGML') { + $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost, $extrashow2); - } + } - } + } + untie %hash; + } + else { + $r->print('Unable to tie hash to db '. + 'file'); + } if ($compiledresult) { $resultflag=1; } @@ -1258,14 +1198,12 @@ END $compiledresult RESULTS my $percent=sprintf('%3.0f',($servercount/$servernum*100)); - $r->print(''."\n"); } + } unless ($resultflag) { $r->print("\nThere were no results that matched your query\n"); } -# $r->print(''."\n"); $r->rflush(); +# $r->print(''."\n"); $r->rflush(); $r->print(< @@ -1287,9 +1225,21 @@ sub detailed_citation_view { Subject: $subject
Keyword(s): $keywords
Notes: $notes
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
-Copyright/Distribution: $cprtag{$copyright}
+MIME Type: +END + $result.=&Apache::loncommon::filedescription($mime); + $result.=< +Language: +END + $result.=&Apache::loncommon::languagedescription($lang); + $result.=< +Copyright/Distribution: +END + $result.=&Apache::loncommon::copyrightdescription($copyright); + $result.=<

$extrashow

@@ -1305,11 +1255,12 @@ sub summary_view { $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); my $result=<$author
$title
$owner -- $lastrevisiondate
-$cprtag{$copyright}
+$cprtag
$extrashow

END @@ -1322,6 +1273,9 @@ sub fielded_format_view { $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $mimetag=&Apache::loncommon::filedescription($mime); + my $language=&Apache::loncommon::languagedescription($lang); + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); my $result=<URL: $url
@@ -1330,12 +1284,12 @@ sub fielded_format_view { Subject: $subject
Keyword(s): $keywords
Notes: $notes
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
+MIME Type: $mimetag
+Language: $language
Creation Date: $creationdate
Last Revision Date: $lastrevisiondate
Publisher/Owner: $owner
-Copyright/Distribution: $cprtag{$copyright}
+Copyright/Distribution: $cprtag
Repository Location: $hostname
Abstract: $shortabstract
$extrashow @@ -1350,6 +1304,9 @@ sub xml_sgml_view { $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); + my $mimetag=&Apache::loncommon::filedescription($mime); + my $language=&Apache::loncommon::languagedescription($lang); my $result=< <LonCapaResource> @@ -1361,18 +1318,18 @@ sub xml_sgml_view { <notes>$notes</notes> <mimeInfo> <mime>$mime</mime> -<mimetag>$mimetag{$mime}</mimetag> +<mimetag>$mimetag</mimetag> </mimeInfo> <languageInfo> <language>$lang</language> -<languagetag>$language{$lang}</languagetag> +<languagetag>$language</languagetag> </languageInfo> <creationdate>$creationdate</creationdate> <lastrevisiondate>$lastrevisiondate</lastrevisiondate> <owner>$owner</owner> <copyrightInfo> <copyright>$copyright</copyright> -<copyrighttag>$cprtag{$copyright}</copyrighttag> +<copyrighttag>$cprtag</copyrighttag> </copyrightInfo> <repositoryLocation>$hostname</repositoryLocation> <shortabstract>$shortabstract</shortabstract> @@ -1459,6 +1416,270 @@ $message RESULTS } +# --------- settings whenever the user causes the search window to be launched +sub start_fresh_session { + delete $hash{'mode_catalog'}; + foreach (keys %hash) { + if ($_ =~ /^pre_/) { + delete $hash{$_}; + } + if ($_ =~ /^store/) { + delete $hash{$_}; + } + } +} + +# ----------------------------------------------- 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(); +} + +sub popwin_imgupdate { + my ($r,$imgnum,$icon) = @_; + &popwin_js($r,'popwin.document.img'.$imgnum.'.'. + 'src="/adm/lonIcons/'.$icon.'";'); +} + 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 + + +=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. + +=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. + +=over 4 + +=item * + +configure dynamic components of interface + +=item * + +determine current user + +=item * + +see if a search invocation should be done + +=item * + +else, begin building search interface to output + +=item * + +compute date selection boxes + +=item * + +compute customized metadata field + +=item * + +print screen + +=back + +=head1 OTHER SUBROUTINES + +=over 4 + +=item * + +get_unprocessed_cgi() : reads in critical name/value pairs that may have not +been processed and passed into %ENV by the web server + +=item * + +make_persistent() : makes a set of hidden HTML fields to make +SQL search interface information to be persistent + +=back + +WEB INTERFACE COMPONENT FUNCTIONS + +=over 4 + +=item * + +simpletextfield(name,value) : returns HTML formatted string for simple text +field + +=item * + +simplecheckbox(name,value) : returns HTML formatted string for simple +checkbox + +=item * + +searchphrasefield(title,name,value) : returns HTML formatted string for +a search expression phrase field + +=item * + +dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML +formatted string for a calendar date + +=item * + +selectbox(title,name,value,%HASH=options) : returns HTML formatted string for +a selection box field + +=back + +SEARCH FUNCTIONS + +=over 4 + +=item * + +advancedsearch(server reference, environment reference) : perform a complex +multi-field logical query + +=item * + +basicsearch(server reference, environment reference) : perform a simple +single-field logical query + +=item * + +build_SQL_query(field name, logic) : builds a SQL query string from a +logical expression with AND/OR keywords + +=item * + +build_custommetadata_query(field_name, logic_statement) : builds a perl +regular expression from a logical expression with AND/OR keywords + +=item * + +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 + +=item * + +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. + +=back + +OUTPUTTING RESULTS FUNCTION + +=over 4 + +=item * + +output_results(output mode, server reference, environment reference, +reply list reference) : outputs results from search + +=back + +DIFFERENT WAYS TO VIEW METADATA RECORDS + +=over 4 + +=item * + +detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : +see metadata viewing notes below + +=item * + +summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : +see metadata viewing notes below + +=item * + +fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : +see metadata viewing notes below + +=item * + +xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : +see metadata viewing notes below + +=back + + _____________________________________________________________________ + | * 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. | + --------------------------------------------------------------------- + +TEST CONDITIONAL FUNCTIONS + +=over 4 + +=item * + +filled(field) : determines whether a given field has been filled + +=back + +ERROR FUNCTIONS + +=over 4 + +=item * + +output_blank_field_error(server reference) : outputs a message saying that +more fields need to be filled in + +=item * + +output_date_error(server reference, error message) : outputs +an error message specific to bad date format. + +=back + +=cut