--- loncom/interface/lonsearchcat.pm 2001/03/19 16:45:38 1.41
+++ loncom/interface/lonsearchcat.pm 2002/06/25 15:08:59 1.129
@@ -1,154 +1,409 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Search Catalog
#
-# 03/08/2001 Scott Harrison
+# $Id: lonsearchcat.pm,v 1.129 2002/06/25 15:08:59 matthew Exp $
#
-# Functions
+# Copyright Michigan State University Board of Trustees
#
-# handler(server reference) : interacts with the Apache server layer
-# (for /adm/searchcat URLs)
-# simpletextfield(name,value) : returns HTML formatted string for simple text
-# field
-# simplecheckbox(name,value) : returns HTML formatted string for simple
-# checkbox
-# searchphrasefield(title,name,value) : returns HTML formatted string for
-# a search expression phrase field
-# dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML
-# formatted string
-# for a calendar date
-# selectbox(title,name,value,%HASH=options) : returns HTML formatted string for
-# a selection box field
-# advancedsearch() :
-# filled(field) : determines whether a given field has been filled
-# basicsearch() :
-# output_blank_field_error() : outputs a message saying that more fields need
-# to be filled in
-# output_results() : outputs results from search
-# build_SQL_query() : builds a SQL query string from a logical expression
-# with AND/OR keywords
+# 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
+
+=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 GDBM_File;
+use Apache::loncommon();
+
+# ---------------------------------------- variables used throughout the module
+
+######################################################################
+######################################################################
+
+=pod
+
+=item Global variables
+
+=over 4
+
+=item $closebutton
+
+button that closes the search window
+
+=item $importbutton
+
+button to take the selecte results and go to group sorting
+
+=item %hash
+
+The ubiquitous database hash
+
+=item $diropendb
+
+The full path to the (temporary) search database file. This is set and
+used in &handler() and is also used in &output_results().
+
+=back
-my %language;
-my $scrout;
-my %metadatafields;
-my %cprtag;
-my %mimetag;
+=cut
+######################################################################
+######################################################################
+
+# -- 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 %hash; # database hash
+my $diropendb = ""; # db file
+
+######################################################################
+######################################################################
+
+=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;
-
-# -------------------------------------- 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'}));
+ untie %hash;
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
- %metadatafields=();
-
- my $hidden='';
- $hidden=<
-END
-
-# ------------------------------------------------ First, check out environment
- $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
-
-# --------------------------------- 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>;
- }
-
- %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>;
- }
-
- %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>;
+ my $domain = $r->dir_config('lonDefDomain');
+ $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain).
+ "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db";
+
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['catalogmode','launch','acts','mode','form','element',
+ 'reqinterface']);
+ ##
+ ## Clear out old values from database
+ ##
+ if ($ENV{'form.launch'} eq '1') {
+ if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ &start_fresh_session();
+ untie %hash;
+ } else {
+ $r->print('Unable to tie hash to db '.
+ 'file');
+ return OK;
+ }
}
-
- if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
- return &basicsearch($r,\%ENV);
+ ##
+ ## 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 .= <
+
+
+
+END
+ ##
+ ## What are we doing?
+ ##
+ if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
+ # Perform basic search and give results
+ return &basicsearch($r,\%ENV,$hidden);
+ } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
+ # Perform advanced search and give results
+ return &advancedsearch($r,\%ENV,$hidden);
+ } elsif ($ENV{'form.reqinterface'} eq 'advanced') {
+ # Output the advanced interface
+ $r->print(&advanced_search_form($closebutton,$hidden));
+ return OK;
+ } else {
+ # Output normal search interface
+ $r->print(&basic_search_form($closebutton,$hidden));
}
+ 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
+
+
+
+$closebutton
+
+
+
+
+
+
+
+
+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
+ my $scrout=<<"ENDHEADER";
+
+
+The LearningOnline Network with CAPA
+
+
+
+
+
Advanced Catalog Search
+
+Enter terms or quoted phrases separated by search operators
+such as AND, OR, or NOT.
+$advanced_buttons
+$hidden
+
\n";
+# $ENV{'form.mime'}='any' unless length($ENV{'form.mime'});
+# $scrout.=&selectbox('Limit by MIME type','mime',
+# $ENV{'form.mime'},
+# 'any','Any type',
+# \&{Apache::loncommon::filedescriptionex},
+# (&Apache::loncommon::fileextensions));
+ $ENV{'form.language'}='any' unless length($ENV{'form.language'});
+ $scrout.=&selectbox('Limit by language','language',
+ $ENV{'form.language'},'any','Any Language',
+ \&{Apache::loncommon::languagedescription},
+ (&Apache::loncommon::languageids),
+ );
# ------------------------------------------------ Compute date selection boxes
$scrout.=<LIMIT BY CREATION DATE RANGE:
-
+
between:
CREATIONDATESTART
$scrout.=&dateboxes('creationdatestart',1,1,1976,
@@ -156,21 +411,18 @@ CREATIONDATESTART
$ENV{'form.creationdatestart_day'},
$ENV{'form.creationdatestart_year'},
);
- $scrout.=<";
-
$scrout.=<LIMIT BY LAST REVISION DATE RANGE:
- between:
+ between:
LASTREVISIONDATESTART
$scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
$ENV{'form.lastrevisiondatestart_month'},
@@ -186,264 +438,283 @@ 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
-
-
-
-
-
-
-
-
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;
+}
+
+######################################################################
+######################################################################
+
+=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 $persistent='';
+ foreach (keys %ENV) {
+ if (/^form\./ && !/submit/) {
+ my $name=$_;
+ my $key=$name;
+ $ENV{$key}=~s/\'//g; # do not mess with html field syntax
+ $name=~s/^form\.//;
+ $persistent.=<
+END
+ }
+ }
+ return $persistent;
+}
+
+
+######################################################################
+######################################################################
+
+=pod
+
+=item HTML form building functions
+
+=over 4
+
+=item &simpletextfield()
+
+Inputs: $name,$value,$size
+
+Returns a text input field with the given name, value, and size.
+If size is not specified, a value of 20 is used.
+
+=item &simplecheckbox()
+
+Inputs: $name,$value
+
+Returns a simple check box with the given $name.
+If $value eq 'on' the box is checked.
+
+=item &searchphrasefield()
+
+Inputs: $title,$name,$value
+
+Returns html for a title line and an input field for entering search terms.
+the instructions "Enter terms or phrases separated by search operators such
+as AND, OR, or NOT." are given following the title. The entry field (which
+is where the $name and $value are used) is an 80 column simpletextfield.
+
+=item &dateboxes()
+
+Returns html selection form elements for the specification of
+the day, month, and year.
+
+=item &selectbox()
-# --------------------------------------------------------- Various form fields
+Returns a scalar containing an html
END
+ for (my $i = 1; $i<=31; $i++) {
+ $day.="
$i
\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=<
-
1976
-
1977
-
1978
-
1979
-
1980
-
1981
-
1982
-
1983
-
1984
-
1985
-
1986
-
1987
-
1988
-
1989
-
1990
-
1991
-
1992
-
1993
-
1994
-
1995
-
1996
-
1997
-
1998
-
1999
-
2000
-
2001
-
2002
-
2003
-
2004
-
2005
-
2006
-
2007
-
2008
-
2009
-
2010
-
2011
-
2012
-
2013
-
2014
-
2015
-
2016
-
2017
-
2018
-
2019
-
2020
-
2021
-
2022
-
2023
-
2024
-
2025
-
2026
-
2027
-
2028
-
2029
-
2030
-
2031
-
2032
-
2033
-
2034
-
2035
-
2036
-
2037
-
2038
-
2039
-
2040
-
2041
-
2042
-
2043
-
2044
-
2045
-
2046
-
2047
-
2048
-
2049
-
2050
-
2051
-
END
+ my $maxyear = 2051;
+ for (my $i = 1976; $i<=$maxyear; $i++) {
+ $year.="
$i
\n";
+ }
+ $year.="\n";
$year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
return "$month$day$year";
}
sub selectbox {
- my ($title,$name,$value,%options)=@_;
+ my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_;
+ if (! defined($functionref)) { $functionref = sub { $_[0]}; }
my $uctitle=uc($title);
- my $selout="\n
';
}
-# ------------------------------------------------ Performing a advanced search
+######################################################################
+######################################################################
+
+=pod
+
+=item &advancedsearch()
+
+Parse advanced search results.
+
+=cut
+
+######################################################################
+######################################################################
sub advancedsearch {
- my ($r,$envhash)=@_;
+ my ($r,$envhash,$hidden)=@_;
my %ENV=%{$envhash};
-
my $fillflag=0;
+ # Clean up fields for safety
+ for my $field ('title','author','subject','keywords','url','version',
+ 'creationdatestart_month','creationdatestart_day',
+ 'creationdatestart_year','creationdateend_month',
+ 'creationdateend_day','creationdateend_year',
+ 'lastrevisiondatestart_month','lastrevisiondatestart_day',
+ 'lastrevisiondatestart_year','lastrevisiondateend_month',
+ 'lastrevisiondateend_day','lastrevisiondateend_year',
+ 'notes','abstract','mime','language','owner',
+ 'custommetadata','customshow') {
+ $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
+ }
+ foreach ('mode','form','element') {
+ # is this required? Hmmm.
+ next unless (exists($ENV{"form.$_"}));
+ $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
+ $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
+ }
+ # Check to see if enough information was filled in
for my $field ('title','author','subject','keywords','url','version',
'notes','abstract','mime','language','owner',
'custommetadata') {
@@ -451,189 +722,729 @@ sub advancedsearch {
$fillflag++;
}
}
-
unless ($fillflag) {
&output_blank_field_error($r);
return OK;
}
-
+ # Turn the form input into a SQL-based query
my $query='';
-# my $concatarg=join('," ",',
-# ('title', 'author', 'subject', 'notes', 'abstract'));
-
- $query="select * from metadata where concat(title) like '\%$ENV{'form.title'}\%'";
- my $reply=&Apache::lonnet::metadata_query($query);
-
- &output_results($r,$envhash,$reply);
- return OK;
-}
-
-# ---------------------------------------------------- see if a field is filled
-sub filled {
- my ($field)=@_;
- if ($field=~/\S/) {
- return 1;
+ my @queries;
+ # 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});
+ }
}
- else {
- return 0;
+ # Evaluate option lists
+ if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
+ push @queries,"(language like \"$ENV{'form.language'}\")";
}
+# if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') {
+# push @queries,"(mime like \"$ENV{'form.mime'}\")";
+# }
+ if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
+ push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
+ }
+ # 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 OK;
+ }
+ elsif ($datequery) {
+ push @queries,$datequery;
+ }
+ # Process form information for custom metadata querying
+ my $customquery='';
+ if ($ENV{'form.custommetadata'}) {
+ $customquery=&build_custommetadata_query('custommetadata',
+ $ENV{'form.custommetadata'});
+ }
+ my $customshow='';
+ if ($ENV{'form.customshow'}) {
+ $customshow=$ENV{'form.customshow'};
+ $customshow=~s/[^\w\s]//g;
+ my @fields=split(/\s+/,$customshow);
+ $customshow=join(" ",@fields);
+ }
+ # 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);
+ }
+ else {
+ $reply=&Apache::lonnet::metadata_query($query,
+ $customquery,$customshow);
+ }
+ &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
+ return OK;
+ } elsif ($customquery) {
+ my $reply; # reply hash reference
+ $reply=&Apache::lonnet::metadata_query('',
+ $customquery,$customshow);
+ &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden);
+ return OK;
+ }
+ # should not get to this point
+ return 'Error. Should not have gone to this point.';
}
-# --------------------------------------------------- Performing a basic search
+######################################################################
+######################################################################
+
+=pod
+
+=item &basicsearch()
+
+Parse basic search form.
+
+=cut
+
+######################################################################
+######################################################################
sub basicsearch {
- my ($r,$envhash)=@_;
+ my ($r,$envhash,$hidden)=@_;
my %ENV=%{$envhash};
+ # 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;
}
+ # Build SQL query string based on form page
my $query='';
my $concatarg=join('," ",',
- ('title', 'author', 'subject', 'notes', 'abstract'));
+ ('title', 'author', 'subject', 'notes', 'abstract',
+ 'keywords'));
+ $concatarg='title' if $ENV{'form.titleonly'};
+
+ $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
+
+ # 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,$envhash,$query,$reply,$hidden);
- $query="select * from metadata where concat($concatarg) like '\%$ENV{'form.basicexp'}\%'";
- my $reply=&Apache::lonnet::metadata_query($query);
- &output_results($r,$envhash,$reply);
return OK;
}
-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
- }
- } (keys %ENV);
- $r->print(<
-
-The LearningOnline Network with CAPA
-BEGINNING
- $r->print(< '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 &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,$envhash,$query,$replyref,$hidden)=@_;
+ my %ENV=%{$envhash};
+ my %rhash=%{$replyref};
+ my $compiledresult='';
+ my $timeremain=300; # (seconds)
+ my $elapsetime=0;
+ my $resultflag=0;
+ my $tflag=1;
+ #
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+ # spit out the generic header
+ $r->print(&search_results_header());
+ $r->rflush();
+ # begin showing the cataloged results
+ $r->print(<