--- loncom/interface/lonsearchcat.pm 2002/06/18 21:36:38 1.121 +++ loncom/interface/lonsearchcat.pm 2002/06/20 14:31:31 1.124 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.121 2002/06/18 21:36:38 matthew Exp $ +# $Id: lonsearchcat.pm,v 1.124 2002/06/20 14:31:31 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -121,27 +121,10 @@ button that closes the search window 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 @@ -162,10 +145,8 @@ my %hitcount; # stores number of hits # -- 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; # Holds 'hidden' html forms # -- miscellaneous variables -my $scrout; # string that holds portions of the screen output my $yourself; # allows for quickly limiting to oneself my %hash; # database hash @@ -174,24 +155,6 @@ my %hash; # database hash # 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 = ""; @@ -222,11 +185,24 @@ BEGIN { =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 + +=back + =cut ###################################################################### ###################################################################### -# ----------------------------- Handling routine called via Apache and mod_perl sub handler { my $r = shift; untie %hash; @@ -236,38 +212,40 @@ sub handler { return OK if $r->header_only; 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/".&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']); - + ['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; } } - -# --------------------------- Produce some output, so people know it is working - + ## + ## Produce some output, so people know it is working + ## $r->print("\n"); $r->rflush; - -# ----------------------------------- configure dynamic components of interface - + ## + ## 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 @@ -285,63 +263,158 @@ END END -# ------------------------------------------------------ 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 - -# ----------------------------------- See if a search invocation should be done + ## + ## What are we doing? + ## if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - untie %hash; return &basicsearch($r,\%ENV); + # 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)); } - elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - untie %hash; return &advancedsearch($r,\%ENV); + return OK; +} + +###################################################################### +###################################################################### + +=pod + +=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. -# ----------------------------- Else, begin building search interface to output - $scrout=''; # building a part of screen output +=cut + +###################################################################### +###################################################################### + +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.=< @@ -355,16 +428,13 @@ CREATIONDATESTART $ENV{'form.creationdatestart_day'}, $ENV{'form.creationdatestart_year'}, ); - $scrout.=< LIMIT BY LAST REVISION DATE RANGE: @@ -385,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'}, @@ -396,7 +464,6 @@ LASTREVISIONDATEEND \&{Apache::loncommon::copyrightdescription}, (&Apache::loncommon::copyrightids), ); - # ------------------------------------------- Compute customized metadata field $scrout.=< @@ -407,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: @@ -418,66 +483,29 @@ 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; -} + return $scrout; +} ###################################################################### ###################################################################### @@ -488,13 +516,12 @@ ENDDOCUMENT Returns a scalar which holds the current ENV{'form.*'} values in a 'hidden' html input tag. + =cut ###################################################################### ###################################################################### -# ------------------------------------------------------------- make persistent - sub make_persistent { my $persistent=''; @@ -512,31 +539,73 @@ END return $persistent; } -# --------------------------------------------------------- Various form fields + +###################################################################### +###################################################################### + +=pod + +=item HTML form building functions + +=over 4 + +=item &simpletextfield() + +Inputs: $name,$value,$size + +Returns a text input field with the given name, value, and size. +If size is not specified, a value of 20 is used. + +=item &simplecheckbox() + +Inputs: $name,$value + +Returns a simple check box with the given $name. +If $value eq 'on' the box is checked. + +=item &searchphrasefield() + +Inputs: $title,$name,$value + +Returns html for a title line and an input field for entering search terms. +the instructions "Enter terms or phrases separated by search operators such +as AND, OR, or NOT." are given following the title. The entry field (which +is where the $name and $value are used) is an 80 column simpletextfield. + +=item &dateboxes() + +=item &selectbox() + +=back + +=cut + +###################################################################### +###################################################################### sub simpletextfield { - my ($name,$value)=@_; - return ''; + my ($name,$value,$size)=@_; + $size = 20 if (! defined($size)); + return ''; } sub simplecheckbox { my ($name,$value)=@_; my $checked=''; $checked="CHECKED" if $value eq 'on'; - return ''; + return ''; } sub searchphrasefield { my ($title,$name,$value)=@_; my $instruction=<$uctitle:". - " $instruction
". - ''; + return "\n". + '

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

$uctitle:". - "
".''; foreach ($anyvalue,@idlist) { - $selout.=''; } elsif ($_ eq $value and /^$anyvalue$/) { - $selout.=' selected>'.$anytag.''; + $selout.=' selected >'.$anytag.''; } else {$selout.='>'.&{$functionref}($_).'';} } return $selout.''; } -# ----------------------------------------------- Performing an advanced search +###################################################################### +###################################################################### + +=pod + +=item &advancedsearch() + +=cut + +###################################################################### +###################################################################### sub advancedsearch { - my ($r,$envhash)=@_; + my ($r,$envhash,$hidden)=@_; my %ENV=%{$envhash}; - my $fillflag=0; # Clean up fields for safety for my $field ('title','author','subject','keywords','url','version', @@ -637,11 +715,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', @@ -683,7 +758,6 @@ sub advancedsearch { elsif ($datequery) { push @queries,$datequery; } - # Process form information for custom metadata querying my $customquery=''; if ($ENV{'form.custommetadata'}) { @@ -711,21 +785,31 @@ 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') { @@ -747,7 +831,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'}); @@ -757,12 +842,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', @@ -774,9 +870,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'); @@ -784,12 +892,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); @@ -823,7 +947,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)=@_; @@ -872,14 +1006,26 @@ 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=''; @@ -1217,8 +1363,7 @@ ENDPOP my ($title,$author,$subject,$url,$keywords,$version, $notes,$abstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; - - unless ($title) { $title='Untitled'; } + unless ($title =~ /^\s*$/ ) { $title='Untitled'; } unless ($ENV{'user.adv'}) { $keywords='- not displayed -'; $fields[4]=$keywords; @@ -1336,7 +1481,27 @@ RESULTS RESULTS } -# ------------------------------------------------------ Detailed Citation View +###################################################################### +###################################################################### + +=pod + +=item Metadata Viewing Functions + +Output is a HTML-ified string. +Input arguments are title, author, subject, url, keywords, version, +notes, short abstract, mime, language, creation date, +last revision date, owner, copyright, hostname, httphost, and +extra custom metadata to show. + +=over 4 + +=item &detailed_citation_view() + +=cut + +###################################################################### +###################################################################### sub detailed_citation_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1375,7 +1540,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, @@ -1393,7 +1568,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, @@ -1424,7 +1609,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, @@ -1466,7 +1663,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') { @@ -1477,7 +1684,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 @@ -1511,18 +1728,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(< @@ -1542,7 +1769,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) { @@ -1555,7 +1795,17 @@ sub start_fresh_session { } } -# ----------------------------------------------- send javascript to popwin +###################################################################### +###################################################################### + +=pod + +=item &popwin_js() send javascript to popwin + +=cut + +###################################################################### +###################################################################### sub popwin_js { # Print javascript out to popwin, but make sure we dont generate # any javascript errors in doing so. @@ -1570,6 +1820,17 @@ END $r->rflush(); } +###################################################################### +###################################################################### + +=pod + +=item &popwin_imgupdate() + +=cut + +###################################################################### +###################################################################### sub popwin_imgupdate { my ($r,$imgnum,$icon) = @_; &popwin_js($r,'popwin.document.img'.$imgnum.'.'. @@ -1774,8 +2035,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