--- loncom/interface/lonsearchcat.pm 2002/06/27 19:28:50 1.133
+++ loncom/interface/lonsearchcat.pm 2002/07/26 16:37:58 1.144
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Search Catalog
#
-# $Id: lonsearchcat.pm,v 1.133 2002/06/27 19:28:50 matthew Exp $
+# $Id: lonsearchcat.pm,v 1.144 2002/07/26 16:37:58 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,7 +40,7 @@
=head1 NAME
-lonsearchcat
+lonsearchcat - LONCAPA Search Interface
=head1 SYNOPSIS
@@ -87,8 +87,10 @@ use Apache::lonnet();
use Apache::File();
use CGI qw(:standard);
use Text::Query;
+use DBI;
use GDBM_File;
use Apache::loncommon();
+use Apache::lonmysql();
# ---------------------------------------- variables used throughout the module
@@ -107,17 +109,28 @@ button that closes the search window
=item $importbutton
-button to take the selecte results and go to group sorting
+button to take the select results and go to group sorting
-=item %hash
+=item %groupsearch_db
-The ubiquitous database hash
+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
@@ -130,9 +143,16 @@ my $closebutton; # button that closes t
my $importbutton; # button to take the selected results and go to group sorting
# -- miscellaneous variables
-my %hash; # database hash
+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 );
+
######################################################################
######################################################################
@@ -160,26 +180,29 @@ string that holds portions of the screen
######################################################################
sub handler {
my $r = shift;
- untie %hash;
+ 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 database
+ ## Clear out old values from groupsearch database
##
if ($ENV{'form.launch'} eq '1') {
- if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
&start_fresh_session();
- untie %hash;
+ untie %groupsearch_db;
} else {
$r->print('
Unable to tie hash to db '.
'file');
@@ -219,19 +242,45 @@ END
##
## What are we doing?
##
- if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
- # Perform basic search and give results
- return &basicsearch($r,$hidden);
- } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
- # Perform advanced search and give results
- return &advancedsearch($r,$hidden);
- } elsif ($ENV{'form.reqinterface'} eq 'advanced') {
+ 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
- $r->print(&advanced_search_form($closebutton,$hidden));
- return OK;
- } else {
- # Output normal search interface
- $r->print(&basic_search_form($closebutton,$hidden));
+ 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;
}
@@ -282,20 +331,21 @@ ENDDOCUMENT
' ';
# $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'});
# $scrout.='Search historic archives ';
- $scrout.=<Advanced Search
+ my $checkbox = &simplecheckbox('related',$ENV{'form.related'});
+ $scrout.=<Advanced Search
+$checkbox use related words
+
$closebutton
-
-
-Detailed Citation View
-Summary View
-Fielded Format
-XML/SGML
-
-
+END
+ $scrout.=&selectbox(undef,'viewselect',
+ $ENV{'form.viewselect'},
+ undef,undef,undef,
+ sort(keys(%Views)));
+ $scrout.=<
@@ -328,6 +378,9 @@ $closebutton
END
+ if (!defined($ENV{'form.viewselect'})) {
+ $ENV{'form.viewselect'} ="Detailed Citation View";
+ }
my $scrout=<<"ENDHEADER";
@@ -352,37 +405,29 @@ $hidden
VIEW:
-
-
- Detailed Citation View
- Summary View
- Fielded Format
- XML/SGML
-
-
-
ENDHEADER
- $scrout.=&searchphrasefield('title','title',
- $ENV{'form.title'});
- $scrout.=&searchphrasefield('author','author',
- $ENV{'form.author'});
- $scrout.=&searchphrasefield('subject','subject',
- $ENV{'form.subject'});
- $scrout.=&searchphrasefield('keywords','keywords',
- $ENV{'form.keywords'});
- $scrout.=&searchphrasefield('URL','url',
- $ENV{'form.url'});
-# $scrout.=&searchphrasefield('Limit by version','version',
-# $ENV{'form.version'});
- $scrout.=&searchphrasefield('notes','notes',
- $ENV{'form.notes'});
- $scrout.=&searchphrasefield('abstract','abstract',
- $ENV{'form.abstract'});
+ $scrout.=&selectbox(undef,'viewselect',
+ $ENV{'form.viewselect'},
+ undef,undef,undef,
+ sort(keys(%Views)));
+ $scrout.="Related Words \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.=" \n";
$scrout.=&searchphrasefield('file extension','mime',
$ENV{'form.mime'});
- $scrout.=" \n";
+ $scrout.=" \n";
$scrout.=&searchphrasefield('publisher owner','owner',
$ENV{'form.owner'});
$scrout.="
\n";
@@ -425,8 +470,6 @@ ENDHEADER
$scrout.="\n";
}
#----------------------------------------------------------------
- #
- #
$scrout.=&selectbox('Limit by language','language',
$ENV{'form.language'},'any','Any Language',
\&{Apache::loncommon::languagedescription},
@@ -527,13 +570,13 @@ to be somewhat persistent.
sub make_persistent {
my %save = %{shift()};
my $persistent='';
- foreach (keys %save) {
- if (/^form\./ && !/submit/) {
- my $name=$_;
+ 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
@@ -543,8 +586,8 @@ END
return $persistent;
}
-
######################################################################
+# HTML form building functions #
######################################################################
=pod
@@ -553,6 +596,13 @@ END
=over 4
+=cut
+
+###############################################
+###############################################
+
+=pod
+
=item &simpletextfield()
Inputs: $name,$value,$size
@@ -560,6 +610,23 @@ 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,$size)=@_;
+ $size = 20 if (! defined($size));
+ return ' ';
+}
+
+###############################################
+###############################################
+
+=pod
+
=item &simplecheckbox()
Inputs: $name,$value
@@ -567,91 +634,106 @@ Inputs: $name,$value
Returns a simple check box with the given $name.
If $value eq 'on' the box is checked.
-=item &searchphrasefield()
+=cut
-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.
+sub simplecheckbox {
+ my ($name,$value)=@_;
+ my $checked='';
+ $checked="checked" if $value eq 'on';
+ return ' ';
+}
-=item &dateboxes()
+###############################################
+###############################################
-Returns html selection form elements for the specification of
-the day, month, and year.
+=pod
-=item &selectbox()
+=item &fieldtitle()
-Returns a scalar containing an html form.
+Input: $title
-Inputs:
+Returns a scalar with html which will display $title as a search
+field heading.
-=over 4
+=cut
-=item $title
+###############################################
+###############################################
-Printed above the select box, in uppercase.
+sub fieldtitle {
+ my $title = uc(shift());
+ return ''.$title.
+ ': ';
+}
-=item $name
+###############################################
+###############################################
-The name element of the tag.
+=pod
-=item $default
+=item &searchphrasefield()
-The default value of the form. Can be $anyvalue or in @idlist.
+Inputs: $title,$name,$value
-=item $anyvalue
+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.
-The used to indicate a default of
-none of the values.
+=cut
-=item $anytag
+###############################################
+###############################################
+
+sub searchphrasefield {
+ my ($title,$name,$value)=@_;
+ return ''.&fieldtitle($title).' '.
+ &simpletextfield($name,$value,50)." \n";
+}
-The text associate with $anyvalue above.
+###############################################
+###############################################
-=item $functionref
+=pod
-Each element in @idlist will be passed as a parameter
-to the function referenced here. The return value of the function should
-be a scalar description of the items. If this value is undefined the
-description of each item in @idlist will be the item name.
+=item &searchphrasefield_with_related()
-=item @idlist
+Inputs: $title,$name,$value
-The items to be selected from. One of these or $anyvalue will be the
-value returned by the form element, $ENV{form.$name}.
+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".
-=back
+=cut
-=back
+###############################################
+###############################################
+
+sub searchphrasefield_with_related {
+ my ($title,$name,$value)=@_;
+ return ''.&fieldtitle($title).' '.
+ &simpletextfield($name,$value,50).' '.
+ &simplecheckbox($name.'_related',$ENV{'form.'.$name.'_related'}).
+ " \n";
+}
-=cut
+###############################################
+###############################################
-######################################################################
-######################################################################
+=pod
-sub simpletextfield {
- my ($name,$value,$size)=@_;
- $size = 20 if (! defined($size));
- return ' ';
-}
+=item &dateboxes()
-sub simplecheckbox {
- my ($name,$value)=@_;
- my $checked='';
- $checked="checked" if $value eq 'on';
- return ' ';
-}
+Returns html selection form elements for the specification of
+the day, month, and year.
-sub searchphrasefield {
- my ($title,$name,$value)=@_;
- my $uctitle=uc($title);
- return ''.
- ''.$uctitle.': '.
- &simpletextfield($name,$value,50)." \n";
-}
+=cut
+
+###############################################
+###############################################
sub dateboxes {
my ($name,$defaultmonth,$defaultday,$defaultyear,
@@ -697,13 +779,71 @@ END
return "$month$day$year";
}
+###############################################
+###############################################
+
+=pod
+
+=item &selectbox()
+
+Returns a scalar containing an html form.
+
+Inputs:
+
+=over 4
+
+=item $title
+
+Printed above the select box, in uppercase. If undefined, only a select
+box will be returned, with no additional html.
+
+=item $name
+
+The name element of the tag.
+
+=item $default
+
+The default value of the form. Can be $anyvalue, or in @idlist.
+
+=item $anyvalue
+
+The used to indicate a default of
+none of the values. Can be undef.
+
+=item $anytag
+
+The text associate with $anyvalue above.
+
+=item $functionref
+
+Each element in @idlist will be passed as a parameter
+to the function referenced here. The return value of the function should
+be a scalar description of the items. If this value is undefined the
+description of each item in @idlist will be the item name.
+
+=item @idlist
+
+The items to be selected from. One of these or $anyvalue will be the
+value returned by the form element, $ENV{form.$name}.
+
+=back
+
+=cut
+
+###############################################
+
sub selectbox {
my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_;
if (! defined($functionref)) { $functionref = sub { $_[0]}; }
- my $uctitle=uc($title);
- my $selout="\n".''.
- ''.$uctitle.': ';
- foreach ($anyvalue,@idlist) {
+ my $selout='';
+ if (defined($title)) {
+ my $uctitle=uc($title);
+ $selout="\n".''.
+ ''.$uctitle.': ';
+ }
+ $selout .= '';
+ unshift @idlist,$anyvalue if (defined($anyvalue));
+ foreach (@idlist) {
$selout.=''.&{$functionref}($_).' ';
@@ -713,25 +853,49 @@ sub selectbox {
}
else {$selout.='>'.&{$functionref}($_).'
';}
}
- return $selout.' ';
+ return $selout.' '.(defined($title)?'':' ');
}
######################################################################
+# End of HTML form building functions #
+######################################################################
+
+=pod
+
+=back
+
+=cut
+
+
+######################################################################
######################################################################
=pod
-=item &advancedsearch()
+=item &parse_advanced_search()
+
+Parse advanced search form and return the following:
+
+=over 4
+
+=item $query Scalar containing an SQL query.
-Parse advanced search results.
+=item $customquery Scalar containing a custom query.
+
+=item $customshow Scalar containing commands to show custom metadata.
+
+=item $libraries_to_query Reference to array of domains to search.
+
+=back
=cut
######################################################################
######################################################################
-sub advancedsearch {
- my ($r,$hidden)=@_;
+sub parse_advanced_search {
+ my ($r)=@_;
my $fillflag=0;
+ my $pretty_search_string = " \n";
# Clean up fields for safety
for my $field ('title','author','subject','keywords','url','version',
'creationdatestart_month','creationdatestart_day',
@@ -766,25 +930,51 @@ sub advancedsearch {
}
unless ($fillflag) {
&output_blank_field_error($r);
- return OK;
+ return ;
}
# Turn the form input into a SQL-based query
my $query='';
my @queries;
+ my $font = '';
# Evaluate logical expression AND/OR/NOT phrase fields.
foreach my $field ('title','author','subject','notes','abstract','url',
'keywords','version','owner','mime') {
if ($ENV{'form.'.$field}) {
- push @queries,&build_SQL_query($field,$ENV{'form.'.$field});
+ my $searchphrase = $ENV{'form.'.$field};
+ $pretty_search_string .= $font."$field 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'},
@@ -803,19 +993,24 @@ sub advancedsearch {
# Test to see if date windows are legitimate
if ($datequery=~/^Incorrect/) {
&output_date_error($r,$datequery);
- return OK;
- }
- elsif ($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='';
+ 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='';
+ 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);
@@ -830,48 +1025,37 @@ sub advancedsearch {
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{$_}++;
}
- foreach (keys(%Apache::lonnet::libserv)) {
- if ($_ eq 'any') {
- $libraries_to_query = undef;
- last;
+ 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 ";
}
- if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) {
- push @$libraries_to_query,$_;
+ 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";
#
- # Send query statements over the network to be processed by either the SQL
- # database or a recursive scheme of 'grep'-like actions (for custom
- # metadata).
if (@queries) {
$query=join(" AND ",@queries);
$query="select * from metadata where $query";
- my $reply; # reply hash reference
- unless ($customquery or $customshow) {
- $reply=&Apache::lonnet::metadata_query($query,undef,undef,
- $libraries_to_query);
- }
- else {
- $reply=&Apache::lonnet::metadata_query($query,
- $customquery,$customshow,
- $libraries_to_query);
- }
- &output_results('Advanced',$r,$customquery,$reply,$hidden);
- return OK;
} elsif ($customquery) {
- my $reply; # reply hash reference
- $reply=&Apache::lonnet::metadata_query('',
- $customquery,$customshow,
- $libraries_to_query);
- &output_results('Advanced',$r,$customquery,$reply,$hidden);
- return OK;
+ $query = '';
}
- # should not get to this point
- return 'Error. Should not have gone to this point.';
+ return ($query,$customquery,$customshow,$libraries_to_query,
+ $pretty_search_string);
}
######################################################################
@@ -879,16 +1063,16 @@ sub advancedsearch {
=pod
-=item &basicsearch()
+=item &parse_basic_search()
-Parse basic search form.
+Parse the basic search form and return a scalar containing an sql query.
=cut
######################################################################
######################################################################
-sub basicsearch {
- my ($r,$hidden)=@_;
+sub parse_basic_search {
+ my ($r)=@_;
# Clean up fields for safety
for my $field ('basicexp') {
$ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
@@ -905,27 +1089,61 @@ sub basicsearch {
&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;
+}
- $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
- # Get reply (either a hash reference to filehandles or bad connection)
-# &Apache::lonnet::logthis("metadata query started:".time);
- my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query);
-# &Apache::lonnet::logthis("metadata query finished:".time);
- # Output search results
+######################################################################
+######################################################################
- &output_results('Basic',$r,$query,$reply,$hidden);
+=pod
- return OK;
-}
+=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));
+}
######################################################################
######################################################################
@@ -1096,6 +1314,400 @@ sub build_date_queries {
######################################################################
######################################################################
+=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
+ }
+ 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;
+}
+
+######################################################################
+######################################################################
+=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;
+}
+######################################################################
+######################################################################
+
+=pod
+
+=item &display_results
+
+=cut
+
+######################################################################
+######################################################################
+sub display_results {
+ my ($r,$mode,$hidden,$importbutton,$closebutton) = @_;
+ ##
+ ## 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);
+ ##
+ ## 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