--- loncom/interface/lonsearchcat.pm 2001/03/15 19:22:09 1.24 +++ loncom/interface/lonsearchcat.pm 2002/07/26 16:37:58 1.144 @@ -1,129 +1,486 @@ -# The LearningOnline Network +# The LearningOnline Network with CAPA # Search Catalog # -# 03/08/2001 Scott Harrison +# $Id: lonsearchcat.pm,v 1.144 2002/07/26 16:37:58 matthew Exp $ # +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# 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. +# +# 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 +# +# 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 +# 6/17 Matthew Hall +# +############################################################################### +############################################################################### + +=pod + +=head1 NAME + +lonsearchcat - LONCAPA Search Interface + +=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 ## +## ## +## 1. Modules used by this module ## +## 2. Variables used throughout the module ## +## 3. handler subroutine called via Apache and mod_perl ## +## 4. Other subroutines ## +## ## +############################################################################### + package Apache::lonsearchcat; +# ------------------------------------------------- modules used by this module use strict; use Apache::Constants qw(:common); use Apache::lonnet(); use Apache::File(); use CGI qw(:standard); +use Text::Query; +use DBI; +use GDBM_File; +use Apache::loncommon(); +use Apache::lonmysql(); -my %language; -my $scrout; -my %metadatafields; -my %cprtag; -my %mimetag; +# ---------------------------------------- variables used throughout the module -sub handler { - my $r = shift; +###################################################################### +###################################################################### -# -------------------------------------- see if called from an interactive mode - 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'})); +=pod - $r->content_type('text/html'); - $r->send_http_header; - return OK if $r->header_only; +=item Global variables - %metadatafields=(); +=over 4 - my $hidden=''; - $hidden=< -END +=item $closebutton -# ------------------------------------------------ First, check out environment - $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; +button that closes the search window -# --------------------------------- Compute various listings of metadata values - - %language=(); - $language{'any'}='Any language'; - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; - $language{$1}=$2; - } <$fh>; - } +=item $importbutton - %cprtag=(); - $cprtag{'any'}='Any copyright/distribution'; - { - my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; - $cprtag{$1}=$2; - } <$fh>; - } +button to take the select results and go to group sorting - %mimetag=(); - $mimetag{'any'}='Any type'; - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/filetypes.tab'); - map { - $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; - $mimetag{$1}=".$1 $3"; - } <$fh>; - } +=item %groupsearch_db + +Database hash used to save values for the groupsearch RAT interface. + +=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(). + +=item %Views + +Hash which associates an output view description with the function +that produces it. Adding a new view type should be as easy as +adding a line to the definition of this hash and making sure the function +takes the proper parameters. + +=item $results_db + +The name of the database results from searches are put in. + +=back + +=cut - if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - return &basicsearch($r,\%ENV); +###################################################################### +###################################################################### + +# -- 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 + +# -- miscellaneous variables +my %groupsearch_db; # database hash +my $diropendb = ""; # db file + +my $results_db = ""; +# View Description Function Pointer +my %Views = ("Detailed Citation View" => \&detailed_citation_view, + "Summary View" => \&summary_view, + "Fielded Format" => \&fielded_format_view, + "XML/SGML" => \&xml_sgml_view ); + +###################################################################### +###################################################################### + +=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 + +=back + +=cut + +###################################################################### +###################################################################### +sub handler { + my $r = shift; + untie %groupsearch_db; + + $r->content_type('text/html'); + $r->send_http_header; + return OK if $r->header_only; + ## + ## Initialize global variables + ## + my $domain = $r->dir_config('lonDefDomain'); + $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). + "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db"; + $results_db = "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). + '_'.&Apache::lonnet::escape($ENV{'user.name'})."_searchresults.db"; + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['catalogmode','launch','acts','mode','form','element', + 'reqinterface']); + ## + ## Clear out old values from groupsearch database + ## + if ($ENV{'form.launch'} eq '1') { + if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { + &start_fresh_session(); + untie %groupsearch_db; + } 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; # Holds 'hidden' html forms + if ($ENV{'form.catalogmode'} eq 'interactive') { + $hidden="". + "\n"; + $closebutton=""."\n"; + } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { + $hidden=< +END + $closebutton=< +END + $importbutton=< +END } - elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - return &advancedsearch($r,\%ENV); + $hidden .= &make_persistent({ "form.mode" => $ENV{'form.mode'}, + "form.form" => $ENV{'form.form'}, + "form.element" => $ENV{'form.element'}, + "form.date" => 2 }); + ## + ## What are we doing? + ## + my $searchtype; + $searchtype = 'Basic' if ($ENV{'form.basicsubmit'} eq 'SEARCH'); + $searchtype = 'Advanced' if ($ENV{'form.advancedsubmit'} eq 'SEARCH'); + if ($searchtype) { + # We are running a search + my ($query,$customquery,$customshow,$libraries) = + (undef,undef,undef,undef); + my $pretty_string; + if ($searchtype eq 'Basic') { + ($query,$pretty_string) = &parse_basic_search($r); + } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { + ($query,$customquery,$customshow,$libraries,$pretty_string) + = &parse_advanced_search($r); + return OK if (! defined($query)); + } + # Output some information to the user. + $r->print(&search_results_header($searchtype,$pretty_string)); + $r->print("Sending search request to LON-CAPA servers.
\n"); + $r->rflush(); + &run_search($r,$query,$customquery,$customshow,$libraries); + &display_results($r,$searchtype,$hidden,$importbutton, + $closebutton); + + $r->rflush(); + } else { + # + # We need to get information to search on + # + # Set the default view if it is not already set. + if (!defined($ENV{'form.viewselect'})) { + $ENV{'form.viewselect'} ="Detailed Citation View"; + } + # Output the advanced interface + if ($ENV{'form.reqinterface'} eq 'advanced') { + $r->print(&advanced_search_form($closebutton,$hidden)); + } else { + # Output normal search interface + $r->print(&basic_search_form($closebutton,$hidden)); + } } + return OK; +} - $scrout=''; # building a part of screen output - $scrout.=&searchphrasefield('Limit by title','title', - $ENV{'form.title'}); +###################################################################### +###################################################################### - $scrout.=&searchphrasefield('Limit by author','author', - $ENV{'form.author'}); +=pod - $scrout.=&searchphrasefield('Limit by subject','subject', - $ENV{'form.subject'}); +=item &basic_search_form() - $scrout.=&searchphrasefield('Limit by keywords','keywords', - $ENV{'form.keywords'}); +Returns a scalar which holds html for the basic search form. - $scrout.=&searchphrasefield('Limit by URL','url', - $ENV{'form.url'}); +=cut - $scrout.=&searchphrasefield('Limit by version','version', - $ENV{'form.version'}); +###################################################################### +###################################################################### - $scrout.=&searchphrasefield('Limit by notes','notes', - $ENV{'form.notes'}); +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'; + my $checkbox = &simplecheckbox('related',$ENV{'form.related'}); + $scrout.=<Advanced Search
$checkbox use related words
+

+

+   +$closebutton +END + $scrout.=&selectbox(undef,'viewselect', + $ENV{'form.viewselect'}, + undef,undef,undef, + sort(keys(%Views))); + $scrout.=< +

+
+ + +ENDDOCUMENT + return $scrout; +} +###################################################################### +###################################################################### - $scrout.=&searchphrasefield('Limit by abstract','abstract', - $ENV{'form.abstract'}); +=pod - $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'}); - $scrout.=&selectbox('Limit by MIME type','mime', - $ENV{'form.mime'},%mimetag); +=item &advanced_search_form() - $ENV{'form.language'}='any' unless length($ENV{'form.language'}); +Returns a scalar which holds html for the advanced search form. - $scrout.=&selectbox('Limit by language','language', - $ENV{'form.language'},%language); - +=cut + +###################################################################### +###################################################################### +sub advanced_search_form{ + my ($closebutton,$hidden) = @_; + my $advanced_buttons = <<"END"; +

+ + +$closebutton + +

+END + if (!defined($ENV{'form.viewselect'})) { + $ENV{'form.viewselect'} ="Detailed Citation View"; + } + my $scrout=<<"ENDHEADER"; + + +The LearningOnline Network with CAPA + + + + +

Advanced Catalog Search

+
+Enter terms or phrases separated by search operators +such as AND, OR, or NOT.
+
+$advanced_buttons +$hidden + + +\n"; + $scrout.=&searchphrasefield_with_related('title', 'title' , + $ENV{'form.title'}); + $scrout.=&searchphrasefield('author', 'author' ,$ENV{'form.author'}); + $scrout.=&searchphrasefield_with_related('subject', 'subject' , + $ENV{'form.subject'}); + $scrout.=&searchphrasefield_with_related('keywords','keywords', + $ENV{'form.keywords'}); + $scrout.=&searchphrasefield('URL', 'url' ,$ENV{'form.url'}); + $scrout.=&searchphrasefield_with_related('notes', 'notes' , + $ENV{'form.notes'}); + $scrout.=&searchphrasefield_with_related('abstract','abstract', + $ENV{'form.abstract'}); + # Hack - an empty table row. + $scrout.="\n"; + $scrout.=&searchphrasefield('file
extension','mime', + $ENV{'form.mime'}); + $scrout.="\n"; + $scrout.=&searchphrasefield('publisher
owner','owner', + $ENV{'form.owner'}); + $scrout.="
VIEW: +ENDHEADER + $scrout.=&selectbox(undef,'viewselect', + $ENV{'form.viewselect'}, + undef,undef,undef, + sort(keys(%Views))); + $scrout.="Related
Words
   
   
\n"; + $ENV{'form.category'}='any' unless length($ENV{'form.category'}); + $scrout.=&selectbox('File Category','category', + $ENV{'form.category'}, + 'any','Any category', + undef, + (&Apache::loncommon::filecategories())); + $ENV{'form.language'}='any' unless length($ENV{'form.language'}); + #---------------------------------------------------------------- + # Allow restriction to multiple domains. + # I make the crazy assumption that there will never be a domain 'any'. + # + $ENV{'form.domains'} = 'any' if (! exists($ENV{'form.domains'})); + my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}} + : ($ENV{'form.domains'}) ); + my %domain_hash = (); + foreach (@allowed_domains) { + $domain_hash{$_}++; + } + my @domains =&Apache::loncommon::get_domains(); + # adjust the size of the select box + my $size = 4; + my $size = (scalar @domains < ($size - 1) ? scalar @domains + 1 : $size); + # standalone machines do not get to choose a domain to search. + if ((scalar @domains) == 1) { + $scrout .=''."\n"; + } else { + $scrout.="\n".''. + 'DOMAINS
'. + '\n"; + } + #---------------------------------------------------------------- + $scrout.=&selectbox('Limit by language','language', + $ENV{'form.language'},'any','Any Language', + \&{Apache::loncommon::languagedescription}, + (&Apache::loncommon::languageids), + ); # ------------------------------------------------ Compute date selection boxes $scrout.=< LIMIT BY CREATION DATE RANGE: -
+
between: CREATIONDATESTART $scrout.=&dateboxes('creationdatestart',1,1,1976, @@ -131,21 +488,18 @@ CREATIONDATESTART $ENV{'form.creationdatestart_day'}, $ENV{'form.creationdatestart_year'}, ); - $scrout.=< LIMIT BY LAST REVISION DATE RANGE: -
between: +
between: LASTREVISIONDATESTART $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, $ENV{'form.lastrevisiondatestart_month'}, @@ -161,427 +515,1619 @@ LASTREVISIONDATEEND $ENV{'form.lastrevisiondateend_year'}, ); $scrout.='

'; - - $scrout.=&searchphrasefield('Limit by publisher/owner','owner', - $ENV{'form.owner'}); -# $metadatafields{'owner'}); - $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); $scrout.=&selectbox('Limit by copyright/distribution','copyright', - $ENV{'form.copyright'},%cprtag); - + $ENV{'form.copyright'}, + 'any','Any copyright/distribution', + \&{Apache::loncommon::copyrightdescription}, + (&Apache::loncommon::copyrightids), + ); # ------------------------------------------- Compute customized metadata field $scrout.=< -LIMIT BY OTHER METADATA FIELDS: +LIMIT BY SPECIAL METADATA FIELDS: -For author-specific metadata, enter in an expression in the form of -key=value separated by operators such as AND or OR.
+For resource-specific metadata, enter in an expression in the form of +key=value separated by operators such as AND, OR or NOT.
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'; - -# ---------------------------------------------------------------- Print screen - $r->print(< - -The LearningOnline Network with CAPA - - - -

Search Catalog

- -$hidden -
-

Basic Search

+ $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); + $scrout.=< -Enter terms or phrases separated by search operators -such as AND or OR 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'})); - $r->print(<Search historic archives -
- - - -

-
-

Advanced Search

-$scrout -

- - - -

+SHOW SPECIAL METADATA FIELDS: + +Enter in a space-separated list of special metadata fields to show +in a fielded listing for each record result. +
+CUSTOMSHOW + $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); + $scrout.=< ENDDOCUMENT - return OK; -} + return $scrout; +} -# --------------------------------------------------------- Various form fields +###################################################################### +###################################################################### -sub textfield { - my ($title,$name,$value)=@_; - return "\n

$title:
". - ''; +=pod + +=item &make_persistent() + +Returns a scalar which holds the current ENV{'form.*'} values in +a 'hidden' html input tag. This allows search interface information +to be somewhat persistent. + +=cut + +###################################################################### +###################################################################### + +sub make_persistent { + my %save = %{shift()}; + my $persistent=''; + foreach my $name (keys %save) { + if ($name =~ /^form\./ && $name !~ /submit/) { + my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name})); + $name=~s/^form\.//; + foreach (@values) { + s/\"/\'/g; # do not mess with html field syntax + next if (! $_ ); + $persistent.=< +END + } + } + } + return $persistent; } +###################################################################### +# HTML form building functions # +###################################################################### + +=pod + +=item HTML form building functions + +=over 4 + +=cut + +############################################### +############################################### + +=pod + +=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. + +=cut + +############################################### +############################################### + sub simpletextfield { - my ($name,$value)=@_; - return ''; + my ($name,$value,$size)=@_; + $size = 20 if (! defined($size)); + return ''; } +############################################### +############################################### + +=pod + +=item &simplecheckbox() + +Inputs: $name,$value + +Returns a simple check box with the given $name. +If $value eq 'on' the box is checked. + +=cut + +############################################### +############################################### + sub simplecheckbox { my ($name,$value)=@_; my $checked=''; - $checked="CHECKED" if $value eq 'on'; - return ''; + $checked="checked" if $value eq 'on'; + return ''; +} + +############################################### +############################################### + +=pod + +=item &fieldtitle() + +Input: $title + +Returns a scalar with html which will display $title as a search +field heading. + +=cut + +############################################### +############################################### + +sub fieldtitle { + my $title = uc(shift()); + return ''.$title. + ': '; } +############################################### +############################################### + +=pod + +=item &searchphrasefield() + +Inputs: $title,$name,$value + +Returns html for a title line and an input field for entering search terms. +The entry field (which is where the $name and $value are used) is a 50 column +simpletextfield. The html returned is for a row in a three column table. + +=cut + +############################################### +############################################### + sub searchphrasefield { my ($title,$name,$value)=@_; - my $instruction=<$uctitle:". - " $instruction
". - ''; + return ''.&fieldtitle($title).''. + &simpletextfield($name,$value,50)." \n"; } +############################################### +############################################### + +=pod + +=item &searchphrasefield_with_related() + +Inputs: $title,$name,$value + +Returns html for a title line and an input field for entering search terms +and a check box for 'related words'. The entry field (which is where the +$name and $value are used) is a 50 column simpletextfield. The name of +the related words checkbox is "$name_related". + +=cut + +############################################### +############################################### + +sub searchphrasefield_with_related { + my ($title,$name,$value)=@_; + return ''.&fieldtitle($title).''. + &simpletextfield($name,$value,50).' '. + &simplecheckbox($name.'_related',$ENV{'form.'.$name.'_related'}). + " \n"; +} + +############################################### +############################################### + +=pod + +=item &dateboxes() + +Returns html selection form elements for the specification of +the day, month, and year. + +=cut + +############################################### +############################################### + 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"; } +############################################### +############################################### + +=pod + +=item &selectbox() + +Returns a scalar containing an html tag. + +=item $default + +The default value of the form. Can be $anyvalue, or in @idlist. + +=item $anyvalue + +The

$uctitle:". - "
".''; + unshift @idlist,$anyvalue if (defined($anyvalue)); + foreach (@idlist) { $selout.=''; + } + elsif ($_ eq $default and /^$anyvalue$/) { + $selout.=' selected >'.$anytag.''; + } + else {$selout.='>'.&{$functionref}($_).'';} + } + return $selout.''.(defined($title)?'

':' '); } -# ------------------------------------------------ Performing a advanced search -sub advancedsearch { - my ($r,$envhash)=@_; - my %ENV=%{$envhash}; +###################################################################### +# End of HTML form building functions # +###################################################################### - $r->print(< contains ". + $searchphrase.""; + if ($ENV{'form.'.$field.'_related'}) { + my @New_Words; + ($searchphrase,@New_Words) = &related_version($searchphrase); + if (@New_Words) { + $pretty_search_string .= " with related words: ". + "@New_Words."; + } else { + $pretty_search_string .= " with no related words."; + } + } + $pretty_search_string .= "
\n"; + push @queries,&build_SQL_query($field,$searchphrase); + } + } + # I dislike the hack below. + if ($ENV{'form.category'}) { + $ENV{'form.mime'}=''; + } + # Evaluate option lists + if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { + push @queries,"(language like \"$ENV{'form.language'}\")"; + $pretty_search_string.=$font."language= ". + &Apache::loncommon::languagedescription($ENV{'form.language'}). + "
\n"; + } + if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { + push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; + $pretty_search_string.=$font."copyright = ". + &Apache::loncommon::copyrightdescription($ENV{'form.copyright'}). + "
\n"; + } + # + # Evaluate date windows + my $datequery=&build_date_queries( + $ENV{'form.creationdatestart_month'}, + $ENV{'form.creationdatestart_day'}, + $ENV{'form.creationdatestart_year'}, + $ENV{'form.creationdateend_month'}, + $ENV{'form.creationdateend_day'}, + $ENV{'form.creationdateend_year'}, + $ENV{'form.lastrevisiondatestart_month'}, + $ENV{'form.lastrevisiondatestart_day'}, + $ENV{'form.lastrevisiondatestart_year'}, + $ENV{'form.lastrevisiondateend_month'}, + $ENV{'form.lastrevisiondateend_day'}, + $ENV{'form.lastrevisiondateend_year'}, + ); + # Test to see if date windows are legitimate + if ($datequery=~/^Incorrect/) { + &output_date_error($r,$datequery); + return ; + } elsif ($datequery) { + # Here is where you would set up pretty_search_string to output + # date query information. + push @queries,$datequery; + } + # Process form information for custom metadata querying + my $customquery=undef; + if ($ENV{'form.custommetadata'}) { + $pretty_search_string .=$font."Custom Metadata Search: ". + $ENV{'form.custommetadata'}."
\n"; + $customquery=&build_custommetadata_query('custommetadata', + $ENV{'form.custommetadata'}); + } + my $customshow=undef; + if ($ENV{'form.customshow'}) { + $pretty_search_string .=$font."Custom Metadata Display: ". + $ENV{'form.customshow'}."
\n"; + $customshow=$ENV{'form.customshow'}; + $customshow=~s/[^\w\s]//g; + my @fields=split(/\s+/,$customshow); + $customshow=join(" ",@fields); + } + ## --------------------------------------------------------------- + ## Deal with restrictions to given domains + ## + my $libraries_to_query = undef; + # $ENV{'form.domains'} can be either a scalar or an array reference. + # We need an array. + my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}} + : ($ENV{'form.domains'}) ); + my %domain_hash = (); + my $pretty_domains_string; + foreach (@allowed_domains) { + $domain_hash{$_}++; + } + if ($domain_hash{'any'}) { + $pretty_domains_string = "Searching all domains."; + } else { + if (@allowed_domains > 1) { + $pretty_domains_string = "Searching domains:"; + } else { + $pretty_domains_string = "Searching domain "; + } + foreach (sort @allowed_domains) { + $pretty_domains_string .= "$_ "; + } + foreach (keys(%Apache::lonnet::libserv)) { + if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) { + push @$libraries_to_query,$_; + } + } + } + $pretty_search_string .= $pretty_domains_string."
\n"; + # + if (@queries) { + $query=join(" AND ",@queries); + $query="select * from metadata where $query"; + } elsif ($customquery) { + $query = ''; + } + return ($query,$customquery,$customshow,$libraries_to_query, + $pretty_search_string); } -# --------------------------------------------------- Performing a basic search -sub basicsearch { - my ($r,$envhash)=@_; - my %ENV=%{$envhash}; +###################################################################### +###################################################################### + +=pod + +=item &parse_basic_search() - unless (length($ENV{'form.basicexp'}) { +Parse the basic search form and return a scalar containing an sql query. + +=cut + +###################################################################### +###################################################################### +sub parse_basic_search { + my ($r)=@_; + # 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'})) { &output_blank_field_error($r); return OK; } + my $pretty_search_string = ''.$ENV{'form.basicexp'}.''; + my $search_string = $ENV{'form.basicexp'}; + if ($ENV{'form.related'}) { + my @New_Words; + ($search_string,@New_Words) = &related_version($ENV{'form.basicexp'}); + if (@New_Words) { + $pretty_search_string .= " with related words: @New_Words."; + } else { + $pretty_search_string .= " with no related words."; + } + } + # Build SQL query string based on form page + my $query=''; + my $concatarg=join('," ",', + ('title', 'author', 'subject', 'notes', 'abstract', + 'keywords')); + $concatarg='title' if $ENV{'form.titleonly'}; + $query=&build_SQL_query('concat('.$concatarg.')',$search_string); + $pretty_search_string .= "
\n"; + return 'select * from metadata where '.$query,$pretty_search_string; +} - my $query=$ENV{'form.basicexp'}; - $query="select * from metadata where concat(title,\" \",author) like '\%$ENV{'form.basicexp'}\%'"; - my $reply=&Apache::lonnet::metadata_query($query); - &output_results($r,$envhash,$reply); - return OK; + +###################################################################### +###################################################################### + +=pod + +=item &related_version + +Modifies an input string to include related words. Words in the string +are replaced with parenthesized lists of 'OR'd words. For example +"torque" is replaced with "(torque OR word1 OR word2 OR ...)". + +Note: Using this twice on a string is probably silly. + +=cut + +###################################################################### +###################################################################### +sub related_version { + my $search_string = shift; + my $result = $search_string; + my %New_Words = (); + while ($search_string =~ /(\w+)/cg) { + my $word = $1; + next if (lc($word) =~ /\b(or|and|not)\b/); + my @Words = &Apache::loncommon::get_related_words($word); + @Words = ($#Words>4? @Words[0..4] : @Words); + foreach (@Words) { $New_Words{$_}++;} + my $replacement = join " OR ", ($word,@Words); + $result =~ s/(\b)$word(\b)/$1($replacement)$2/g; + } + return $result,sort(keys(%New_Words)); } -sub output_blank_field_error { - my ($r)=@_; - # make query information persistent to allow for subsequent revision - my $persistent=''; - map { - if (/^form\./ && !/submit/) { - my $name=$_; - my $key=$name; - $name=~s/^form\.//; - $persistent.=< -END +###################################################################### +###################################################################### + +=pod + +=item &build_SQL_query() + +Builds a SQL query string from a logical expression with AND/OR keywords +using Text::Query and &recursive_SQL_query_builder() + +=cut + +###################################################################### +###################################################################### +sub build_SQL_query { + my ($field_name,$logic_statement)=@_; + my $q=new Text::Query('abc', + -parse => 'Text::Query::ParseAdvanced', + -build => 'Text::Query::Build'); + $q->prepare($logic_statement); + my $matchexp=${$q}{'matchexp'}; chomp $matchexp; + my $sql_query=&recursive_SQL_query_build($field_name,$matchexp); + return $sql_query; +} + +###################################################################### +###################################################################### + +=pod + +=item &build_custommetadata_query() + +Constructs a custom metadata query using a rather heinous regular +expression. + +=cut + +###################################################################### +###################################################################### +sub build_custommetadata_query { + my ($field_name,$logic_statement)=@_; + my $q=new Text::Query('abc', + -parse => 'Text::Query::ParseAdvanced', + -build => 'Text::Query::BuildAdvancedString'); + $q->prepare($logic_statement); + my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; + # quick fix to change literal into xml tag-matching + # will eventually have to write a separate builder module + # wordone=wordtwo becomes\[^\<] *wordtwo[^\<]*\<\/wordone\> + $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to + /\\<$1\\>?# \ + \[\^\\<\]?# [^\<] + \*$2\[\^\\<\]?# *wordtwo[^\<] + \*\\<\\\/$1\\>?# *\<\/wordone\> + /g; + return $matchexp; +} + +###################################################################### +###################################################################### + +=pod + +=item &recursive_SQL_query_build() + +Recursively constructs an SQL query. Takes as input $dkey and $pattern. + +=cut + +###################################################################### +###################################################################### +sub recursive_SQL_query_build { + my ($dkey,$pattern)=@_; + my @matches=($pattern=~/(\[[^\]|\[]*\])/g); + return $pattern unless @matches; + foreach my $match (@matches) { + $match=~/\[ (\w+)\s(.*) \]/; + my ($key,$value)=($1,$2); + my $replacement=''; + if ($key eq 'literal') { + $replacement="($dkey like \"\%$value\%\")"; + } + elsif ($key eq 'not') { + $value=~s/like/not like/; +# $replacement="($dkey not like $value)"; + $replacement="$value"; + } + elsif ($key eq 'and') { + $value=~/(.*[\"|\)]) ([|\(|\^].*)/; + $replacement="($1 AND $2)"; + } + elsif ($key eq 'or') { + $value=~/(.*[\"|\)]) ([|\(|\^].*)/; + $replacement="($1 OR $2)"; + } + substr($pattern, + index($pattern,$match), + length($match), + $replacement + ); + } + &recursive_SQL_query_build($dkey,$pattern); +} + +###################################################################### +###################################################################### + +=pod + +=item &build_date_queries() + +Builds a SQL logic query to check time/date entries. +Also reports errors (check for /^Incorrect/). + +=cut + +###################################################################### +###################################################################### +sub build_date_queries { + my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, + $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; + my @queries; + if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) { + unless ($cmonth1 and $cday1 and $cyear1 and + $cmonth2 and $cday2 and $cyear2) { + return "Incorrect entry for the creation date. You must specify ". + "a starting month, day, and year and an ending month, ". + "day, and year."; + } + my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1); + $cnumeric1+=0; + my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2); + $cnumeric2+=0; + if ($cnumeric1>$cnumeric2) { + return "Incorrect entry for the creation date. The starting ". + "date must occur before the ending date."; + } + my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '". + "$cyear2-$cmonth2-$cday2 23:59:59')"; + push @queries,$cquery; + } + if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) { + unless ($lmonth1 and $lday1 and $lyear1 and + $lmonth2 and $lday2 and $lyear2) { + return "Incorrect entry for the last revision date. You must ". + "specify a starting month, day, and year and an ending ". + "month, day, and year."; + } + my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1); + $lnumeric1+=0; + my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2); + $lnumeric2+=0; + if ($lnumeric1>$lnumeric2) { + return "Incorrect entry for the last revision date. The ". + "starting date must occur before the ending date."; + } + my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '". + "$lyear2-$lmonth2-$lday2 23:59:59')"; + push @queries,$lquery; + } + if (@queries) { + return join(" AND ",@queries); + } + return ''; +} + +###################################################################### +###################################################################### + +=pod + +=item ©right_check() + +=cut + +###################################################################### +###################################################################### + +sub copyright_check { + my $Metadata = shift; + # Check copyright tags and skip results the user cannot use + my (undef,undef,$resdom,$resname) = split('/', + $Metadata->{'url'}); + # Check for priv + if (($Metadata->{'copyright'} eq 'priv') && + (($ENV{'user.name'} ne $resname) && + ($ENV{'user.domain'} ne $resdom))) { + return 0; + } + # Check for domain + if (($Metadata->{'copyright'} eq 'domain') && + ($ENV{'user.domain'} ne $resdom)) { + return 0; + } + return 1; +} + +##################################################################### +##################################################################### + +=pod + +=item MySQL Table Description + +MySQL table creation requires a precise description of the data to be +stored. The use of the correct types to hold data is vital to efficient +storage and quick retrieval of records. The columns must be described in +the following format: + +=cut + +## +## Restrictions: +## columns of type 'text' and 'blob' cannot have defaults. +## columns of type 'enum' cannot be used for FULLTEXT. +## +my @DataOrder = qw/id title author subject url keywords version notes + abstract mime lang owner copyright creationdate lastrevisiondate hostname + idx_title idx_author idx_subject idx_abstract idx_mime idx_language + idx_owner idx_copyright/; + +my %Datatypes = + ( id =>{ type => 'INT', + restrictions => 'NOT NULL', + primary_key => 'yes', + auto_inc => 'yes' + }, + title =>{ type=>'TEXT'}, + author =>{ type=>'TEXT'}, + subject =>{ type=>'TEXT'}, + url =>{ type=>'TEXT', + restrictions => 'NOT NULL' }, + keywords =>{ type=>'TEXT'}, + version =>{ type=>'TEXT'}, + notes =>{ type=>'TEXT'}, + abstract =>{ type=>'TEXT'}, + mime =>{ type=>'TEXT'}, + lang =>{ type=>'TEXT'}, + owner =>{ type=>'TEXT'}, + copyright =>{ type=>'TEXT'}, + hostname =>{ type=>'TEXT'}, + #-------------------------------------------------- + creationdate =>{ type=>'DATETIME'}, + lastrevisiondate =>{ type=>'DATETIME'}, + #-------------------------------------------------- + idx_title =>{ type=>'FULLTEXT', target=>'title'}, + idx_author =>{ type=>'FULLTEXT', target=>'author'}, + idx_subject =>{ type=>'FULLTEXT', target=>'subject'}, + idx_abstract =>{ type=>'FULLTEXT', target=>'abstract'}, + idx_mime =>{ type=>'FULLTEXT', target=>'mime'}, + idx_language =>{ type=>'FULLTEXT', target=>'lang'}, + idx_owner =>{ type=>'FULLTEXT', target=>'owner'}, + idx_copyright =>{ type=>'FULLTEXT', target=>'copyright'}, + ); + +###################################################################### +###################################################################### + +=pod + +=item &write_status() + +=cut + +###################################################################### +###################################################################### +sub write_status { + my ($r,$string) = @_; + $r->print("
".$string."
\n"); + $r->rflush(); + return; +} + +###################################################################### +###################################################################### + +=pod + +=item &run_search + +=cut + +###################################################################### +###################################################################### +sub run_search { + my ($r,$query,$customquery,$customshow,$serverlist) = @_; + # + my @Servers_to_contact; + if (defined($serverlist)) { + @Servers_to_contact = @$serverlist; + } else { + @Servers_to_contact = sort(keys(%Apache::lonnet::libserv)); + } + my %Server_status; + # + # Timing variables + my $starttime = time; + my $max_time = 120; # seconds for the search to complete + # + # Create Table + ##################################### + my $table = &Apache::lonmysql::create_table + ( { columns => \%Datatypes, + column_order => \@DataOrder, + } ); + if (! defined($table)) { + # What do I do now? Print out an error page. + &Apache::lonnet::logthis("lonmysql attempted to create a table ". + "and this was the result:". + &Apache::lonmysql::get_error()); + $r->print("An internal error occured with the database.
". + "The error has been logged, but you should probably alert". + " your system administrator."); + return; + } + $ENV{'form.table'}=$table; + # + ##################################### + my $hitcountsum; + my $server; + my $status; + while ((time - $starttime < $max_time) && + ((@Servers_to_contact) || keys(%Server_status))) { + # Send out a search request if it needs to be done. + if (@Servers_to_contact) { + # Contact one server + my $server = shift(@Servers_to_contact); + my $reply=&Apache::lonnet::metadata_query($query,$customquery, + $customshow,[$server]); + # We should let the user know we have contacted another server + ($server) = keys(%$reply); + $Server_status{$server} = $reply->{$server}; + # &write_status($r,"Contacted:$server:reply:". + # $Server_status{$server}); + # Hmmm, should we add to $max_time if we contact a server? + } else { + sleep(1); # wait a sec. to give time for files to be written } - } (keys %ENV); + while (my ($server,$status) = each(%Server_status)) { + if ($status eq 'con_lost') { + delete ($Server_status{$server}); + # &write_status($r,"Removing $server"); + next; + } + $status=~/^([\.\w]+)$/; + my $datafile=$r->dir_config('lonDaemons').'/tmp/'.$1; + if (-e $datafile && ! -e "$datafile.end") { + # Let the user know we are receiving data from the server + &write_status($r,"$server:Receiving file"); + next; + } + if (-e "$datafile.end") { + if (-z "$datafile") { + delete($Server_status{$server}); + next; + } + my $fh; + if (!($fh=Apache::File->new($datafile))) { + # Error opening file... + # Tell the user and exit...? + # Should I give up on opening it? + &write_status("Unable to open $datafile"); + next; + } + # Read in the whole file. + while (my $result = <$fh>) { + # handle custom fields? Someday we will! + chomp($result); + next unless $result; + # Parse the result. + my %Fields = &parse_raw_result($result,$server); + $Fields{'hostname'} = $server; + next if (! ©right_check(\%Fields)); + # Store the result in the mysql database + my $result = &Apache::lonmysql::store_row($table,\%Fields); + if (! defined($result)) { + &write_status($r,&Apache::lonmysql::get_error()); + } + # &write_status($r,&Apache::lonmysql::get_debug()); + $hitcountsum ++; + } # End of foreach (@results) + $fh->close(); + # $server is only deleted if the results file has been + # found and (successfully) opened. This may be a bad idea. + delete($Server_status{$server}); + } + } + # Finished looping through the servers + } + &Apache::lonmysql::disconnect_from_db(); + # We have run out of time or run out of servers to talk to and + # results to get. + if ($hitcountsum > 0) { + $r->print("

Total results = $hitcountsum

"); + } + return; +} - $r->print(< - -The LearningOnline Network with CAPA -BEGINNING - $r->print(< - - -

Search Catalog

- -$persistent - - -
-

Helpful Message

-

-Incorrect search query due to blank entry fields. -You need to fill in the relevant -fields on the search page in order for a query to be -processed. -

- - -RESULTS +###################################################################### +###################################################################### +=pod + +=item &display_buttons + +=cut + +###################################################################### +###################################################################### +sub display_buttons { + my ($low,$high,$otherparms) = @_; + my $maxshow = 20; + my $lowest = ($low - $maxshow < 0 ? 0 : $low-$maxshow); + my $highest = $high + $maxshow; + my ($previous,$current,$next); + if ($lowest < $low) { + $previous = qq{prev}; + } else { + $previous = "prev"; + } + $current = qq{reload}; + $next = qq{next}; + my $result = $previous." ".$current." ".$next; + return $result; } +###################################################################### +###################################################################### -# ----------------------------- format and output results based on a reply list -sub output_results { - my ($r,$envhash,@replylist)=@_; - my %ENV=%{$envhash}; - foreach my $reply (@replylist) { +=pod - my @results; +=item &display_results - my $replyfile=''; - $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting - $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; - $reply=~/(.*?)\_/; - my $hostname=$1; - - { - while (1) { - last if -e $replyfile; - sleep 1; - } - # QUESTION: how should I handle this error condition.. - # I'm sure there is syntax elsewhere I can use.. - my $fh=Apache::File->new($replyfile) or - ($r->print('file cannot be opened') and return OK); - @results=<$fh>; - } - - my $compiledresult=''; - - foreach my $result (@results) { - my ($title,$author,$subject,$url,$keywords,$version, - $notes,$abstract,$mime,$lang, - $creationdate,$lastrevisiondate,$owner,$copyright - )=map {&Apache::lonnet::unescape($_)} (split(/\,/,$result)); - my $shortabstract=$abstract; - $shortabstract=substr($abstract,0,200) if length($abstract)>200; - $compiledresult.=< -END - $compiledresult.=<print("Internal Error - Bad view selected.\n"); + $r->rflush(); + return; + } + ## + ## make query information persistent to allow for subsequent revision + ## + my $persistent=&make_persistent(\%ENV); + ## + ## Get the catalog controls setup + ## + my $action = "/adm/searchcat"; + if ($mode eq 'Basic') { + $action .= "?reqinterface=basic"; + } elsif ($mode eq 'Advanced') { + $action .= "?reqinterface=advanced"; + } + $r->print(< +$hidden + + +$importbutton +$closebutton +$persistent +
+CATALOGCONTROLS + if (! tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { + $r->print('Unable to tie hash to db file'); + $r->rflush(); + return; + } + # + my $fnum; + # For now, just query the whole lot and spit them out. + my $table = $ENV{'form.table'}; + my $connection_result = &Apache::lonmysql::connect_to_db(); + if (!defined($connection_result)) { + &write_status($r,&Apache::lonmysql::get_error()); + } + my @Results = &Apache::lonmysql::get_rows($table,'id>=0'); + #&write_status($r,&Apache::lonmysql::get_debug()); + #&write_status($r,&Apache::lonmysql::get_error()); + foreach my $row (@Results) { + my %Fields = %{&parse_row(@$row)}; + my $output="\n

\n"; + if ($ENV{'form.catalogmode'} eq 'interactive') { + my $titleesc=$Fields{'title'}; + $titleesc=~s/\'/\\'/; # ' + if ($ENV{'form.catalogmode'} eq 'interactive') { + $output.=< +onClick="javascript:select_data('$titleesc','$Fields{'url'}')"> -
+
END - $compiledresult.=<URL: $url -
-Title: $title
-Author(s): $author
-Subject: $subject
-Keyword(s): $keywords
-Notes: $notes
-Abstract: $shortabstract
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
-Creation Date: $creationdate
-Last Revision Date: $lastrevisiondate
-Publisher/Owner: $owner
-Copyright/Distribution: $copyright
-Repository Location: $hostname -

+ } + } + if ($ENV{'form.catalogmode'} eq 'groupsearch') { + $fnum+=0; + $groupsearch_db{"pre_${fnum}_link"}=$Fields{'url'}; + $groupsearch_db{"pre_${fnum}_title"}=$Fields{'title'}; + $output.=< + + +
END +# +# + $fnum++; + } + # Render the result into html + $output.= &$viewfunction(%Fields); + if ($output) { + $output.="
"; } + $r->print($output); + $r->rflush(); + } + if (@Results < 1) { + $r->print("There were no results matching your query"); + } + $r->print(""); + $r->rflush(); + untie %groupsearch_db; + return; +} - unless ($compiledresult) { - $compiledresult="There were no results that matched your query"; - } +###################################################################### +###################################################################### + +=pod + +=item &parse_row + +Parse a row returned from the database. + +=cut - # make query information persistent to allow for subsequent revision - my $persistent=''; - map { - if (/^form\./ && !/submit/) { - my $name=$_; - my $key=$name; - $name=~s/^form\.//; - $persistent.=< +###################################################################### +###################################################################### +sub parse_row { + my @Row = @_; + my %Fields; + for (my $i=0;$i<=$#Row;$i++) { + $Fields{$DataOrder[$i]}=&Apache::lonnet::unescape($Row[$i]); + } + $Fields{'language'} = + &Apache::loncommon::languagedescription($Fields{'lang'}); + $Fields{'copyrighttag'} = + &Apache::loncommon::copyrightdescription($Fields{'copyright'}); + $Fields{'mimetag'} = + &Apache::loncommon::filedescription($Fields{'mime'}); + return \%Fields; +} +###################################################################### +###################################################################### + +=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 { +# &Apache::lonnet::logthis("output_results:".time); + my $fnum; # search result counter + my ($mode,$r,$replyref,$hidden)=@_; + my %rhash=%{$replyref}; + my $compiledresult=''; + my $timeremain=300; # (seconds) + my $elapsetime=0; + my $resultflag=0; + my $tflag=1; + ## + ## Set viewing function + ## + my $viewfunction = $Views{$ENV{'form.viewselect'}}; + if (!defined($viewfunction)) { + $r->print("Internal Error - Bad view selected.\n"); + $r->rflush(); + return; + } + # + # make query information persistent to allow for subsequent revision + my $persistent=&make_persistent(\%ENV); + # + # Begin producing output + $r->rflush(); + # + # begin showing the cataloged results + my $action = "/adm/searchcat"; + if ($mode eq 'Basic') { + $action .= "?reqinterface=basic"; + } elsif ($mode eq 'Advanced') { + $action .= "?reqinterface=advanced"; + } + $r->print(< +$hidden + + +$importbutton +$closebutton +$persistent +
+CATALOGCONTROLS + # + # 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 $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) { +# &Apache::lonnet::logthis("Server $rkey:".time); + $servercount++; + $compiledresult=''; + my $reply=$rhash{$rkey}; + my @results; + if ($reply eq 'con_lost') { + &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=~/(.*?)\_/; + for (my $counter=0;$counter<2;$counter++) { + if (-e $replyfile && ! -e "$replyfile.end") { + &popwin_imgupdate($r,$rkey,"srvhalf.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + '"still transferring..."'.';'); + } + # Are we finished transferring data? + if (-e "$replyfile.end") { + $serversleft--; + delete $rhash{$rkey}; + if (-s $replyfile) { + &popwin_imgupdate($r,$rkey,"srvgood.gif"); + my $fh; + unless ($fh=Apache::File->new($replyfile)){ + # Is it really appropriate to die on this error? + $r->print('ERROR: file '. + $replyfile.' cannot be opened'); + return OK; + } + @results=<$fh> if $fh; + my $hits =@results; + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + $hits.';'); + $hitcountsum+=$hits; + &popwin_js($r,'popwin.document.forms.popremain.'. + 'numhits.value='.$hitcountsum.';'); + } else { + &popwin_imgupdate($r,$rkey,"srvempty.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); + } + last; + } # end of if ( -e "$replyfile.end") + last unless $timeremain; + sleep 1; # wait for daemons to write files? + $timeremain--; + $elapsetime++; + &popwin_js($r,"popwin.document.popremain.". + "elapsetime.value=$elapsetime;"); + } + &popwin_js($r,'popwin.document.whirly.'. + 'src="/adm/lonIcons/lonanimend.gif";'); + } # end of if ($reply eq 'con_lost') else statement + my %Fields = undef; # Holds the data to be sent to the various + # *_view routines. + my ($extrashow,$customfields,$customhash) = + &handle_custom_fields(\@results); + my @customfields = @$customfields; + my %customhash = %$customhash; + untie %groupsearch_db if (tied %groupsearch_db); + # + if (! tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { + $r->print('Unable to tie hash to db '. + 'file'); + } else { + if ($ENV{'form.launch'} eq '1') { + &start_fresh_session(); + } + foreach my $result (@results) { + next if $result=~/^custom\=/; + chomp $result; + next unless $result; + %Fields = &parse_raw_result($result,$rkey); + # + # Check copyright tags and skip results the user cannot use + my (undef,undef,$resdom,$resname) = split('/',$Fields{'url'}); + # Check for priv + if (($Fields{'copyright'} eq 'priv') && + (($ENV{'user.name'} ne $resname) && + ($ENV{'user.domain'} ne $resdom))) { + next; + } + # Check for domain + if (($Fields{'copyright'} eq 'domain') && + ($ENV{'user.domain'} ne $resdom)) { + next; + } + # + $Fields{'extrashow'}=$extrashow; + if ($extrashow) { + foreach my $field (@customfields) { + my $value=''; + $value = $1 if ($customhash{$Fields{'url'}}=~/\<{$field}[^\>]*\>(.*?)\<\/{$field}[^\>]*\>/s); + $Fields{'extrashow'}=~s/\<\!\-\- $field \-\-\>/ $value/g; + } + } + $compiledresult.="\n

\n"; + if ($ENV{'form.catalogmode'} eq 'interactive') { + my $titleesc=$Fields{'title'}; + $titleesc=~s/\'/\\'/; # ' + $compiledresult.=< + +
+END + } + if ($ENV{'form.catalogmode'} eq 'groupsearch') { + $fnum+=0; + $groupsearch_db{"pre_${fnum}_link"}=$Fields{'url'}; + $groupsearch_db{"pre_${fnum}_title"}=$Fields{'title'}; + $compiledresult.=< + + +
END +# +# + $fnum++; + } + # Render the result into html + $compiledresult.= &$viewfunction(%Fields, hostname => $rkey ); + if ($compiledresult or $servercount!=$servernum) { + $compiledresult.="

"; + } } - } (keys %ENV); + untie %groupsearch_db; + } + if ($compiledresult) { + $resultflag=1; + $r->print($compiledresult); + } + } # End of foreach loop over servers remaining + } # End of big loop - while($serversleft && $timeremain) + unless ($resultflag) { + $r->print("\nThere were no results that matched your query\n"); + } + $r->print(''. + "\n"); + $r->print("\n\n"); + $r->rflush(); + return; +} + +########################################################### +########################################################### + +=pod + +=item &parse_raw_result() + +Takes a line from the file of results and parse it. Returns a hash +with keys for the following fields: +'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes', +'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate', +'lastrevisiondate'. + +In addition, the following tags are set by calling the appropriate +lonnet function: 'language', 'cprtag', 'mimetag'. + +The 'title' field is set to "Untitled" if the title field is blank. + +'abstract' and 'keywords' are truncated to 200 characters. + +=cut + +########################################################### +########################################################### +sub parse_raw_result { + my ($result,$hostname) = @_; + # Check for a comma - if it is there then we do not need to unescape the + # string. There seems to be some kind of problem with some items in + # the database - the entire string gets sent out unescaped...? + unless ($result =~ /,/) { + $result = &Apache::lonnet::unescape($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 %Fields = + ( title => &Apache::lonnet::unescape($title), + author => &Apache::lonnet::unescape($author), + subject => &Apache::lonnet::unescape($subject), + url => &Apache::lonnet::unescape($url), + keywords => &Apache::lonnet::unescape($keywords), + version => &Apache::lonnet::unescape($version), + notes => &Apache::lonnet::unescape($notes), + abstract => &Apache::lonnet::unescape($abstract), + mime => &Apache::lonnet::unescape($mime), + lang => &Apache::lonnet::unescape($lang), + owner => &Apache::lonnet::unescape($owner), + copyright => &Apache::lonnet::unescape($copyright), + creationdate => &Apache::lonnet::unescape($creationdate), + lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate) + ); + $Fields{'language'} = + &Apache::loncommon::languagedescription($Fields{'lang'}); + $Fields{'copyrighttag'} = + &Apache::loncommon::copyrightdescription($Fields{'copyright'}); + $Fields{'mimetag'} = + &Apache::loncommon::filedescription($Fields{'mime'}); + if ($Fields{'author'}=~/^(\s*|error)$/) { + $Fields{'author'}="Unknown Author"; + } + # Put spaces in the keyword list, if needed. + $Fields{'keywords'}=~ s/,([A-z])/, $1/g; + if ($Fields{'title'}=~ /^\s*$/ ) { + $Fields{'title'}='Untitled'; + } + unless ($ENV{'user.adv'}) { + # What is this anyway? + $Fields{'keywords'} = '- not displayed -'; + $Fields{'notes'} = '- not displayed -'; + $Fields{'abstract'} = '- not displayed -'; + $Fields{'subject'} = '- not displayed -'; + } + if (length($Fields{'abstract'})>200) { + $Fields{'abstract'} = + substr($Fields{'abstract'},0,200).'...'; + } + if (length($Fields{'keywords'})>200) { + $Fields{'keywords'} = + substr($Fields{'keywords'},0,200).'...'; + } + return %Fields; +} + +########################################################### +########################################################### + +=pod + +=item &handle_custom_fields() + +=cut + +########################################################### +########################################################### +sub handle_custom_fields { + my @results = @{shift()}; + my $customshow=''; + my $extrashow=''; + my @customfields; + if ($ENV{'form.customshow'}) { + $customshow=$ENV{'form.customshow'}; + $customshow=~s/[^\w\s]//g; + my @fields=map { + "$_:"; + } split(/\s+/,$customshow); + @customfields=split(/\s+/,$customshow); + if ($customshow) { + $extrashow="
  • ".join("
  • ",@fields)."
\n"; + } + } + my $customdata=''; + my %customhash; + foreach my $result (@results) { + if ($result=~/^(custom\=.*)$/) { # grab all custom metadata + my $tmp=$result; + $tmp=~s/^custom\=//; + my ($k,$v)=map {&Apache::lonnet::unescape($_); + } split(/\,/,$tmp); + $customhash{$k}=$v; + } + } + return ($extrashow,\@customfields,\%customhash); +} + +###################################################################### +###################################################################### + +=pod + +=item &search_results_header + +Output the proper html headers and javascript code to deal with different +calling modes. + +Takes most inputs directly from %ENV, except $mode. + +=over 4 + +=item $mode is either (at this writing) 'Basic' or 'Advanced' + +=back + +The following environment variables are checked: + +=over 4 - $r->print(< -The LearningOnline Network with CAPA +$title BEGINNING - $r->print(< + # 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) { @@ -595,29 +2141,505 @@ BEGINNING } SCRIPT - $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 + } + } + $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 + $result.=< +

$title

+END + if ($pretty_query) { + $result .= "

Search query: $pretty_query

"; + } + 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.="'+\"'\"+')\">'+"; + $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, and +extra custom metadata to show. + +=over 4 + +=item &detailed_citation_view() + +=cut + +###################################################################### +###################################################################### +sub detailed_citation_view { + my %values = @_; + my $result=<$values{'title'} +

+$values{'author'}, $values{'owner'}
+ +Subject: $values{'subject'}
+Keyword(s): $values{'keywords'}
+Notes: $values{'notes'}
+MIME Type: $values{'mimetag'}
+Language: $values{'language'}
+Copyright/Distribution: $values{'cprtag'}
+

+$values{'extrashow'} +

+$values{'shortabstract'} +

+END + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &summary_view() + +=cut + +###################################################################### +###################################################################### +sub summary_view { + my %values = @_; + my $result=<$values{'author'}
+$values{'title'}
+$values{'owner'} -- $values{'lastrevisiondate'}
+$values{'copyrighttag'}
+$values{'extrashow'} +

+END + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &fielded_format_view() + +=cut + +###################################################################### +###################################################################### +sub fielded_format_view { + my %values = @_; + my $result=<URL: $values{'url'} +
+Title: $values{'title'}
+Author(s): $values{'author'}
+Subject: $values{'subject'}
+Keyword(s): $values{'keywords'}
+Notes: $values{'notes'}
+MIME Type: $values{'mimetag'}
+Language: $values{'language'}
+Creation Date: $values{'creationdate'}
+Last Revision Date: $values{'lastrevisiondate'}
+Publisher/Owner: $values{'owner'}
+Copyright/Distribution: $values{'copyrighttag'}
+Repository Location: $values{'hostname'}
+Abstract: $values{'shortabstract'}
+$values{'extrashow'} +

+END + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &xml_sgml_view() + +=back + +=cut + +###################################################################### +###################################################################### +sub xml_sgml_view { + my %values = @_; + my $result=< +<LonCapaResource> +<url>$values{'url'}</url> +<title>$values{'title'}</title> +<author>$values{'author'}</author> +<subject>$values{'subject'}</subject> +<keywords>$values{'keywords'}</keywords> +<notes>$values{'notes'}</notes> +<mimeInfo> +<mime>$values{'mime'}</mime> +<mimetag>$values{'mimetag'}</mimetag> +</mimeInfo> +<languageInfo> +<language>$values{'lang'}</language> +<languagetag>$values{'language'}</languagetag> +</languageInfo> +<creationdate>$values{'creationdate'}</creationdate> +<lastrevisiondate>$values{'lastrevisiondate'}</lastrevisiondate> +<owner>$values{'owner'}</owner> +<copyrightInfo> +<copyright>$values{'copyright'}</copyright> +<copyrighttag>$values{'copyrighttag'}</copyrighttag> +</copyrightInfo> +<repositoryLocation>$values{'hostname'}</repositoryLocation> +<shortabstract>$values{'shortabstract'}</shortabstract> +</LonCapaResource> + +$values{'extrashow'} +END + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &filled() see if field is filled. + +=cut + +###################################################################### +###################################################################### +sub filled { + my ($field)=@_; + if ($field=~/\S/ && $field ne 'any') { + return 1; + } + else { + return 0; + } +} + +###################################################################### +###################################################################### + +=pod + +=item &output_blank_field_error() + +=cut + +###################################################################### +###################################################################### +sub output_blank_field_error { + my ($r)=@_; + # make query information persistent to allow for subsequent revision + my $persistent=&make_persistent(\%ENV); + + $r->print(< + +The LearningOnline Network with CAPA +BEGINNING + $r->print(< + +

Search Catalog

+$persistent - +onClick='this.form.submit();' /> +$closebutton +
+

Helpful Message

+

+Incorrect search query due to blank entry fields. +You need to fill in the relevant +fields on the search page in order for a query to be +processed. +

+ + +RESULTS +} + +###################################################################### +###################################################################### + +=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(\%ENV); + + $r->print(< + +The LearningOnline Network with CAPA + + + +

Search Catalog

+ $persistent -
-

Search Query

+ +$closebutton +
+

Helpful Message

-Basic search: $ENV{'form.basicexp'} +$message

-

Search Results

-$compiledresult RESULTS +} + +###################################################################### +###################################################################### + +=pod + +=item &start_fresh_session() + +Cleans the global %groupsearch_db by removing all fields which begin with +'pre_' or 'store'. + +=cut + +###################################################################### +###################################################################### +sub start_fresh_session { + delete $groupsearch_db{'mode_catalog'}; + foreach (keys %groupsearch_db) { + if ($_ =~ /^pre_/) { + delete $groupsearch_db{$_}; + } + if ($_ =~ /^store/) { + delete $groupsearch_db{$_}; + } + } +} + +###################################################################### +###################################################################### + +=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. + my ($r,$text) = @_; + $r->print(<<"END"); + +END + $r->rflush(); } +###################################################################### +###################################################################### + +=pod + +=item &popwin_imgupdate() + +Send a given image (and its location) out to the browser. Takes as +input $r, loncapa server id, and an icon URL. + +=cut + +###################################################################### +###################################################################### +sub popwin_imgupdate { + my ($r,$server,$icon) = @_; + &popwin_js($r,'popwin.document.img_'.$Apache::lonnet::hostdom{$server}. + '_'.$server.'.'.'src="/adm/lonIcons/'.$icon.'";'); +} + 1; + __END__ + +=pod + +=back + +=cut