--- loncom/interface/lonsearchcat.pm 2001/03/22 14:13:53 1.72
+++ loncom/interface/lonsearchcat.pm 2001/12/13 14:00:37 1.112
@@ -1,57 +1,85 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Search Catalog
#
-# 03/08/2001 Scott Harrison
-# Scott Harrison: 03/12/2001, 03/13/2001, 03/14/2001, 03/15/2001, 03/19/2001
-# Scott Harrison: 03/20/2001
+# $Id: lonsearchcat.pm,v 1.112 2001/12/13 14:00:37 harris41 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(server reference, environment reference) : perform a complex
-# multi-field logical query
-# filled(field) : determines whether a given field has been filled
-# basicsearch(server reference, environment reference) : perform a simple
-# single-field logical query
-# output_blank_field_error(server reference) : outputs a message saying that
-# more fields need to be filled in
-# output_results(output mode,
-# server reference,
-# environment reference,
-# reply list reference) : outputs results from search
-# build_SQL_query(field name, logic) : builds a SQL query string from a
-# logical expression with AND/OR keywords
-# recursive_SQL_query_build(field name, reverse notation expression) :
-# builds a SQL query string from a reverse notation expression
-# logical expression with AND/OR keywords
+# 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 Scott Harrison
+#
+###
+
+###############################################################################
+## ##
+## ORGANIZATION OF THIS PERL MODULE ##
+## ##
+## 1. Modules used by this module ##
+## 2. Choices for different output views (detailed, summary, xml, etc) ##
+## 3. BEGIN block (to be run once after compilation) ##
+## 4. Handling routine called via Apache and mod_perl ##
+## 5. Other subroutines ##
+## ##
+###############################################################################
package Apache::lonsearchcat;
+# ------------------------------------------------- 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();
-my %language;
-my $scrout;
-my %metadatafields;
-my %cprtag;
-my %mimetag;
-my $closebutton;
+# ---------------------------------------- variables used throughout the module
+
+# -- information holders
+# my %language; # holds contents of language.tab
+# my %cprtag; # holds contents of copyright.tab
+# my %mimetag; # holds contents of filetypes.tab
+my %hostdomains; # matches host name to host domain
+my %hostips; # matches host name to host ip
+my %hitcount; # stores number of hits per host
+
+# -- 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 $scrout; # string that holds portions of the screen output
+my $yourself; # allows for quickly limiting to oneself
+my %hash;
+
+# ------------------------------------------ choices for different output views
+# Detailed Citation View ---> sub detailed_citation_view
+# Summary View ---> sub summary_view
+# Fielded Format ---> sub fielded_format_view
+# XML/SGML ---> sub xml_sgml_view
my $basicviewselect=<<END;
<select name='basicviewselect'>
<option value='Detailed Citation View'>Detailed Citation View</option>
@@ -69,76 +97,88 @@ my $advancedviewselect=<<END;
</select>
END
+# ----------------------------------------------------------------------- BEGIN
+sub BEGIN {
+ {
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
+ '/hosts.tab');
+ while (<$fh>) {
+ $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp;
+ if ($3 eq 'library') {
+ $hostdomains{$1}=$2;
+ $hostips{$1}=$4;
+ }
+ }
+ }
+}
+
+my $diropendb = "";
+my $domain = "";
+
+# ----------------------------- Handling routine called via Apache and mod_perl
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;
+ &get_unprocessed_cgi();
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
- %metadatafields=();
+ $domain = $r->dir_config('lonDefDomain');
+ $diropendb= "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db";
+
+ if ($ENV{'form.launch'} eq '1') {
+ if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ &start_fresh_session();
+ untie %hash;
+ }
+ else {
+ $r->print('<html><head></head><body>Unable to tie hash to db '.
+ 'file</body></html>');
+ return OK;
+ }
+ }
+
+# ----------------------------------- configure dynamic components of interface
my $hidden='';
- $hidden=<<END if $ENV{'form.catalogmode'} eq 'interactive';
-<input type='hidden' name='catalogmode' value='interactive'>
+ if ($ENV{'form.catalogmode'} eq 'interactive') {
+ $hidden="<input type='hidden' name='catalogmode' value='interactive'>".
+ "\n";
+ $closebutton="<input type='button' name='close' value='CLOSE' ".
+ "onClick='self.close()'>"."\n";
+ }
+ elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
+ $hidden=<<END;
+<input type='hidden' name='catalogmode' value='groupsearch'>
END
-
- $closebutton=<<END if $ENV{'form.catalogmode'} eq 'interactive';
-<input type="button" name="close" value='CLOSE' onClick="self.close()">
+ $closebutton=<<END;
+<input type='button' name='close' value='CLOSE' onClick='self.close()'>
+END
+ $importbutton=<<END;
+<input type='button' name='import' value='IMPORT'
+onClick='javascript:select_group()'>
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\-]+)/; chomp;
- $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\-]+)/; chomp;
- $cprtag{$1}=$2;
- } <$fh>;
- }
+# ------------------------------------------------------ Determine current user
+ $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
- %mimetag=();
- $mimetag{'any'}='Any type';
- {
- my $fh=Apache::File->new($r->dir_config('lonTabDir').'/filetypes.tab');
- map {
- $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; chomp;
- $mimetag{$1}=".$1 $3";
- } <$fh>;
- }
+# --- Now, depending on the interface actions, do one of three things here:
+# --- 1. a basic search
+# --- 2. an advanced search
+# --- 3. output a search interface
+# ----------------------------------- See if a search invocation should be done
if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
- return &basicsearch($r,\%ENV);
+ untie %hash; return &basicsearch($r,\%ENV);
}
elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
- return &advancedsearch($r,\%ENV);
+ untie %hash; return &advancedsearch($r,\%ENV);
}
+# ----------------------------- Else, begin building search interface to output
$scrout=''; # building a part of screen output
$scrout.=&searchphrasefield('Limit by title','title',
$ENV{'form.title'});
@@ -155,8 +195,8 @@ END
$scrout.=&searchphrasefield('Limit by URL','url',
$ENV{'form.url'});
- $scrout.=&searchphrasefield('Limit by version','version',
- $ENV{'form.version'});
+# $scrout.=&searchphrasefield('Limit by version','version',
+# $ENV{'form.version'});
$scrout.=&searchphrasefield('Limit by notes','notes',
$ENV{'form.notes'});
@@ -164,22 +204,27 @@ END
$scrout.=&searchphrasefield('Limit by abstract','abstract',
$ENV{'form.abstract'});
- $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'});
+ $ENV{'form.mime'}='any' unless length($ENV{'form.mime'});
$scrout.=&selectbox('Limit by MIME type','mime',
- $ENV{'form.mime'},%mimetag);
+ $ENV{'form.mime'},
+ 'any','Any type',
+ \&{Apache::loncommon::filedescriptionex},
+ (&Apache::loncommon::fileextensions));
$ENV{'form.language'}='any' unless length($ENV{'form.language'});
$scrout.=&selectbox('Limit by language','language',
- $ENV{'form.language'},%language);
-
+ $ENV{'form.language'},'any','Any Language',
+ \&{Apache::loncommon::languagedescription},
+ (&Apache::loncommon::languageids),
+ );
# ------------------------------------------------ Compute date selection boxes
$scrout.=<<CREATIONDATESTART;
<p>
<font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
</font>
-<br>
+<br />
between:
CREATIONDATESTART
$scrout.=&dateboxes('creationdatestart',1,1,1976,
@@ -201,7 +246,7 @@ CREATIONDATEEND
<p>
<font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
</b></font>
-<br>between:
+<br />between:
LASTREVISIONDATESTART
$scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
$ENV{'form.lastrevisiondatestart_month'},
@@ -220,59 +265,81 @@ LASTREVISIONDATEEND
$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.=<<CUSTOMMETADATA;
<p>
-<font color="#800000" face="helvetica"><b>LIMIT BY OTHER METADATA FIELDS:</b>
+<font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
</font>
-For author-specific metadata, enter in an expression in the form of
-<i>key</i>=<i>value</i> separated by operators such as AND or OR.<br>
+For resource-specific metadata, enter in an expression in the form of
+<i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
<b>Example:</b> grandmother=75 OR grandfather=85
-<br>
+<br />
CUSTOMMETADATA
$scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
$scrout.=' <i>initial users of this system do not need to worry about this option</i>';
+ $scrout.=<<CUSTOMSHOW;
+<p>
+<font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b>
+</font>
+Enter in a space-separated list of special metadata fields to show
+in a fielded listing for each record result.
+<br />
+CUSTOMSHOW
+$scrout.=&simpletextfield('customshow',$ENV{'form.customshow'});
+$scrout.=' <i>initial users of this system do not need to worry about this option</i>';
+
# ---------------------------------------------------------------- Print screen
$r->print(<<ENDDOCUMENT);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
+<script type="text/javascript">
+ function openhelp(val) {
+ openhelpwin=open('/adm/help/searchcat.html','helpscreen',
+ 'scrollbars=1,width=400,height=300');
+ openhelpwin.focus();
+ }
+</script>
</head>
<body bgcolor="#FFFFFF">
-<img align=right src=/adm/lonIcons/lonlogos.gif>
+<img align='right' src='/adm/lonIcons/lonlogos.gif' />
<h1>Search Catalog</h1>
<form method="post" action="/adm/searchcat">
$hidden
-<hr>
+<hr />
<h3>Basic Search</h3>
<p>
Enter terms or phrases separated by search operators
-such as AND or OR then press SEARCH below. Terms should be specific
+such as AND, OR, or NOT then press SEARCH below. Terms should be specific
to the title, author, subject, notes, or abstract information associated
with a resource.
-<br>
+<br />
ENDDOCUMENT
$r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'}));
$r->print(' ');
$r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'}));
$r->print('<font color="#800000">Title only</font> ');
- $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'}));
+# $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'}));
+# <font color="#800000">Search historic archives</font>
$r->print(<<ENDDOCUMENT);
-<font color="#800000">Search historic archives</font>
-<br>
+<br />
<input type="submit" name="basicsubmit" value='SEARCH' />
<input type="reset" name="reset" value='RESET' />
$closebutton
$basicviewselect
+<input type="button" value="HELP" onClick="openhelp()" />
</p>
-<hr>
+<hr />
<h3>Advanced Search</h3>
$scrout
<p>
@@ -280,6 +347,7 @@ $scrout
<input type="reset" name="reset" value='RESET' />
$closebutton
$advancedviewselect
+<input type="button" value="HELP" onClick="openhelp()" />
</p>
</form>
</body>
@@ -288,6 +356,36 @@ ENDDOCUMENT
return OK;
}
+# ----------- grab unprocessed CGI variables that may have been appended to URL
+sub get_unprocessed_cgi {
+ foreach (split(/&/,$ENV{'QUERY_STRING'})) {
+ 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' or $name eq 'launch' or $name eq 'acts') {
+ $ENV{'form.'.$name}=$value;
+ }
+ }
+}
+
+# ------------------------------------------------------------- make persistent
+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;
+<input type='hidden' name='$name' value='$ENV{$key}' />
+END
+ }
+ }
+ return $persistent;
+}
+
# --------------------------------------------------------- Various form fields
sub simpletextfield {
@@ -307,11 +405,11 @@ sub searchphrasefield {
my ($title,$name,$value)=@_;
my $instruction=<<END;
Enter terms or phrases separated by search operators such
-as AND or OR.
+as AND, OR, or NOT.
END
my $uctitle=uc($title);
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>".
- "</FONT> $instruction<br>".
+ "</FONT> $instruction<br />".
'<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>';
}
@@ -460,18 +558,27 @@ END
}
sub selectbox {
- my ($title,$name,$value,%options)=@_;
+ my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_;
my $uctitle=uc($title);
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
- "</b></font><br>".'<select name="'.$name.'">';
- map {
+ "</b></font><br />".'<select name="'.$name.'">';
+ foreach ($anyvalue,@idlist) {
$selout.='<option value=\''.$_.'\'';
- if ($_ eq $value) { $selout.=' selected'; }
- $selout.='>'.$options{$_}.'</option>';
- } sort keys %options;
+ if ($_ eq $value and !/^any$/) {
+ $selout.=' selected>'.&{$functionref}($_).'</option>';
+ }
+ elsif ($_ eq $value and /^$anyvalue$/) {
+ $selout.=' selected>'.$anytag.'</option>';
+ }
+ else {$selout.='>'.&{$functionref}($_).'</option>';}
+ }
return $selout.'</select>';
}
+sub testf {
+ return @_[0];
+}
+
# ----------------------------------------------- Performing an advanced search
sub advancedsearch {
my ($r,$envhash)=@_;
@@ -487,9 +594,11 @@ sub advancedsearch {
'lastrevisiondatestart_year','lastrevisiondateend_month',
'lastrevisiondateend_day','lastrevisiondateend_year',
'notes','abstract','mime','language','owner',
- 'custommetadata') {
- $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g;
+ 'custommetadata','customshow') {
+ $ENV{"form.$field"}=~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') {
@@ -497,32 +606,34 @@ sub advancedsearch {
$fillflag++;
}
}
-
unless ($fillflag) {
&output_blank_field_error($r);
return OK;
}
+
+ # Turn the form input into a SQL-based query
my $query='';
my @queries;
- # Go through logical expression AND/OR/NOT phrase fields.
-
+ # Evaluate logical expression AND/OR/NOT phrase fields.
foreach my $field ('title','author','subject','notes','abstract','url',
'keywords','version','owner') {
if ($ENV{'form.'.$field}) {
push @queries,&build_SQL_query($field,$ENV{'form.'.$field});
}
}
+ # Evaluate option lists
if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
- push @queries,"(language like \"\%$ENV{'form.language'}\%\")";
+ push @queries,"(language like \"$ENV{'form.language'}\")";
}
if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') {
- push @queries,"(mime like \"\%$ENV{'form.mime'}\%\")";
+ push @queries,"(mime like \"$ENV{'form.mime'}\")";
}
if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
- push @queries,"(copyright like \"\%$ENV{'form.copyright'}\%\")";
+ push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
}
+ # Evaluate date windows
my $datequery=&build_date_queries(
$ENV{'form.creationdatestart_month'},
$ENV{'form.creationdatestart_day'},
@@ -537,6 +648,7 @@ sub advancedsearch {
$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;
@@ -544,184 +656,223 @@ sub advancedsearch {
elsif ($datequery) {
push @queries,$datequery;
}
- my $customquery;
+
+ # 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=&Apache::lonnet::metadata_query($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);
}
- else {
- &output_results('Advanced',$r,$envhash,$query);
- }
- return OK;
-}
-
-# ---------------------------------------------------- see if a field is filled
-sub filled {
- my ($field)=@_;
- if ($field=~/\S/) {
- return 1;
- }
- else {
- return 0;
+ elsif ($customquery) {
+ my $reply; # reply hash reference
+ $reply=&Apache::lonnet::metadata_query('',
+ $customquery,$customshow);
+ &output_results('Advanced',$r,$envhash,$customquery,$reply);
}
+ # should not get to this point
+ return 'Error. Should not have gone to this point.';
}
# --------------------------------------------------- Performing a basic search
sub basicsearch {
my ($r,$envhash)=@_;
my %ENV=%{$envhash};
-
# Clean up fields for safety
for my $field ('basicexp') {
$ENV{"form.$field"}=~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'));
+ $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)
+ my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query);
+
+ # Output search results
- $query="select * from metadata where concat($concatarg) like '\%$ENV{'form.basicexp'}\%'";
- my $reply=&Apache::lonnet::metadata_query($query);
&output_results('Basic',$r,$envhash,$query,$reply);
+
return OK;
}
-# ---------------- Message to output when there are not enough fields filled in
-sub output_blank_field_error {
- my ($r)=@_;
- # make query information persistent to allow for subsequent revision
- my $persistent=&make_persistent();
+# ------------------------------------------------------------- build_SQL_query
+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;
+}
- $r->print(<<BEGINNING);
-<html>
-<head>
-<title>The LearningOnline Network with CAPA</title>
-BEGINNING
- $r->print(<<RESULTS);
-</head>
-<body bgcolor="#ffffff">
-<img align=right src=/adm/lonIcons/lonlogos.gif>
-<h1>Search Catalog</h1>
-<form method="post" action="/adm/searchcat">
-$persistent
-<input type='button' value='Revise search request'
-onClick='this.form.submit();'>
-$closebutton
-<hr>
-<h3>Helpful Message</h3>
-<p>
-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.
-</p>
-</body>
-</html>
-RESULTS
+# ------------------------------------------------- build custom metadata query
+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
+ my $oldmatchexp=$matchexp;
+ $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g;
+ return $matchexp;
+}
+
+# - Recursively parse a reverse notation expression into a SQL query expression
+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);
+}
+
+# ------------------------------------------------------------ Build date query
+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 '';
}
# ----------------------------- 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.)
sub output_results {
- my ($mode,$r,$envhash,$query,@replylist)=@_;
+ my $fnum; # search result counter
+ my ($mode,$r,$envhash,$query,$replyref)=@_;
my %ENV=%{$envhash};
+ my %rhash=%{$replyref};
my $compiledresult='';
+ my $timeremain=300;
+ my $elapsetime=0;
+ my $resultflag=0;
+ my $tflag=1;
- foreach my $reply (@replylist) {
-
- my @results;
-
- my $replyfile='';
- $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting
- $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
- $reply=~/(.*?)\_/;
- my $hostname=$1;
- sleep 3; # temporary fix, need to check for completion and status
- {
- 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>;
- }
-
- foreach my $result (@results) {
- my @fields=map
- {&Apache::lonnet::unescape($_)}
- (split(/\,/,$result));
- my ($title,$author,$subject,$url,$keywords,$version,
- $notes,$abstract,$mime,$lang,
- $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
- my $shortabstract=$abstract;
- $shortabstract=substr($abstract,0,200) if length($abstract)>200;
- $fields[7]=$shortabstract;
- $compiledresult.=<<END;
-<p>
-END
- $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'interactive';
-<font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
-onClick="javascript:select_data('$title','$url')">
-</font>
-<br>
-END
- my $httphost=$ENV{'HTTP_HOST'};
-
- my $viewselect;
- if ($mode eq 'Basic') {
- $viewselect=$ENV{'form.basicviewselect'};
- }
- elsif ($mode eq 'Advanced') {
- $viewselect=$ENV{'form.advancedviewselect'};
- }
-
- if ($viewselect eq 'Detailed Citation View') {
- $compiledresult.=&detailed_citation_view(@fields,
- $hostname,$httphost);
- }
- elsif ($viewselect eq 'Summary View') {
- $compiledresult.=&summary_view(@fields,$hostname,$httphost);
- }
- elsif ($viewselect eq 'Fielded Format') {
- $compiledresult.=&fielded_format_view(@fields,$hostname,
- $httphost);
- }
- elsif ($viewselect eq 'XML/SGML') {
- $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost);
- }
-
- }
-
- unless ($compiledresult) {
- $compiledresult="There were no results that matched your query";
- }
-
- # make query information persistent to allow for subsequent revision
- my $persistent=&make_persistent();
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+ # output beginning of search page
$r->print(<<BEGINNING);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
BEGINNING
+
+ # conditional output of script functions dependent on the mode in
+ # which the search was invoked
$r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'interactive';
-<script>
+<script type="text/javascript">
function select_data(title,url) {
changeTitle(title);
changeURL(url);
+ self.close();
}
function changeTitle(val) {
if (opener.inf.document.forms.resinfo.elements.t) {
@@ -735,19 +886,62 @@ BEGINNING
}
</script>
SCRIPT
- $r->print(<<RESULTS);
+ $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'groupsearch';
+<script type="text/javascript">
+ function select_data(title,url) {
+// alert('DEBUG: Should be storing '+title+' and '+url);
+ }
+ function queue(val) {
+ if (eval("document.forms.results.returnvalues["+val+"].checked")) {
+ document.forms.results.acts.value+='1a'+val+'b';
+ }
+ else {
+ document.forms.results.acts.value+='0a'+val+'b';
+ }
+ }
+ function select_group() {
+ window.location="/adm/groupsort?catalogmode=groupsearch&acts="+
+ document.forms.results.acts.value;
+ }
+</script>
+SCRIPT
+ $r->print(<<SCRIPT);
+<script type="text/javascript">
+ 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) {
+ openhelpwin=open('/adm/help/searchcat.html','helpscreen',
+ 'scrollbars=1,width=400,height=300');
+ openhelpwin.focus();
+ }
+</script>
+SCRIPT
+ $r->rflush();
+
+ # begin showing the cataloged results
+ $r->print(<<CATALOGBEGIN);
</head>
<body bgcolor="#ffffff">
<img align=right src=/adm/lonIcons/lonlogos.gif>
<h1>Search Catalog</h1>
-<form method="post" action="/adm/searchcat">
+CATALOGBEGIN
+ $r->print(<<CATALOGCONTROLS);
+<form name='results' method="post" action="/adm/searchcat">
+<input type='hidden' name='acts' value='' />
<input type='button' value='Revise search request'
-onClick='this.form.submit();'>
+onClick='this.form.submit();' />
+$importbutton
$closebutton
$persistent
-<hr>
+<hr />
<h3>Search Query</h3>
-RESULTS
+CATALOGCONTROLS
if ($mode eq 'Basic') {
$r->print(<<RESULTS);
<p>
@@ -763,68 +957,354 @@ $query
</p>
RESULTS
}
- $r->print(<<RESULTS);
-<h3>Search Results</h3>
-$compiledresult
-</body>
-</html>
-RESULTS
- }
-}
-
-# ------------------------------------------------------------- build_SQL_query
-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;
-}
+ $r->print('<h3>Search Results</h3>');
+ $r->rflush();
+ my $servernum=(keys %rhash)+0;
+
+ # define server grid (shows status of multiple machines)
+ my $hcinit;
+ my $grid="'<br />'+";
+ $grid.="\n";
+ my $sn=1;
+ for my $sk (sort keys %rhash) {
+ # '<a href="
+ $grid.="'<a href=\"";
+ # javascript:displayinfo('+
+ $grid.="javascript:opener.displayinfo('+";
+ # "'"+'key
+ $grid.="\"'\"+'";
+ $grid.=$sk;
+ my $hc;
+ if ($rhash{$sk} eq 'con_lost') {
+ $hc="!!!BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR!!!";
+ }
+ else {
+ $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'";
+ $hcinit.="hc[\"$sk\"]=\"not yet connected...\";";
+ }
+ $grid.=" hitcount=".$hc;
+ $grid.=" domain=".$hostdomains{$sk};
+ $grid.=" IP=".$hostips{$sk};
+ # '+"'"+'">'+
+ $grid.="'+\"'\"+')\">'+";
+ $grid.="\n";
+ $grid.="'<img border=\"0\" name=\"img".$sn."\"".
+ " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" /></a>'+\n";
+ $grid.="'<br />'+\n" unless $sn%10;
+ $sn++;
+ }
+ $r->print(<<ENDPOP);
+<script type="text/javascript">
+ popwin=open('','popwin','scrollbars=1,width=400,height=200');
+ 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"/><i>PLEASE BE PATIENT</i>'+
+ '<'+'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="25" name="sdetails"'+
+ ' value="" />'+
+ '<'+'br />'+
+ ' <'+'input type="button" name="button"'+
+ ' value="abort search and view current results" '+
+ ' onClick="javascript:opener.abortsearch()" />'+
+ ' <'+'input type="button" name="button"'+
+ ' value="help" onClick="javascript:opener.openhelp()" />'+
+ '<'+'/tt>'+
+ '<'+'/form>'+
+ '<'+'/body><'+'/html>');
+ popwin.document.close();
+</script>
+ENDPOP
+ $r->rflush();
-# ------------------------------------------------- build custom metadata query
-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
- my $oldmatchexp=$matchexp;
-# $matchexp=~s/\(\?\:([^\)]*)\\\=([^\)]*)\)/\(\?\:\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>)/g;
- return $oldmatchexp;
-}
+ my $servercount=0;
+ my $hitcountsum=0;
+ my $bloop=$servernum;
+ my %orkey;
+ BLOOP: while(1) {
+ my $sn=0;
+ last BLOOP unless $bloop;
+ last BLOOP unless $timeremain;
+ RLOOP: foreach my $rkey (sort keys %rhash) {
+ $sn++;
+ next RLOOP if $orkey{$rkey};
+ $servercount++;
+ $tflag=1;
+ $compiledresult='';
+ my $hostname=$rkey;
+ my $reply=$rhash{$rkey};
+ my @results;
+
+ my $replyfile='';
-# - Recursively parse a reverse notation expression into a SQL query expression
-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\%\")";
+ if ($reply eq 'con_lost') {
+ $r->print('<script type="text/javascript">popwin.document.img'.
+ $sn.'.'.
+ 'src="/adm/lonIcons/srvbad.gif";</script>'.
+ "\n");
+ $r->rflush();
+ $bloop--;
+ $orkey{$rkey}=1;
}
- elsif ($key eq 'and') {
- $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
- $replacement="($1 AND $2)";
+ else {
+ $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting
+ $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
+ $reply=~/(.*?)\_/;
+ {
+ my $temp=0;
+ WLOOP: while (1) {
+ if (-e $replyfile && $tflag) {
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.img'.$sn.'.'.
+ 'src="/adm/lonIcons/srvhalf.gif";</script>'.
+ "\n");
+ $r->rflush();
+ $r->print('<script type="text/javascript">'.
+ 'popwin.hc["'.$rkey.'"]='.
+ '"still transferring..."'.';</script>'.
+ "\n");
+ $r->rflush();
+ $tflag=0;
+ }
+ if (-e "$replyfile.end") {
+ $bloop--;
+ $orkey{$rkey}=1;
+ if (-s $replyfile) {
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.img'.$sn.'.'.
+ 'src="/adm/lonIcons/srvgood.gif";'.
+ '</script>'."\n");
+ $r->rflush();
+ my $fh=Apache::File->new($replyfile) or
+ ($r->print('ERROR: file '.
+ $replyfile.' cannot be opened') and
+ return OK);
+ @results=<$fh> if $fh;
+ $hitcount{$rkey}=@results+0;
+ $r->print('<script type="text/javascript">'.
+ 'popwin.hc["'.$rkey.'"]='.
+ $hitcount{$rkey}.';</script>'.
+ "\n");
+ $r->rflush();
+ $hitcountsum+=$hitcount{$rkey};
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.forms.popremain.'.
+ 'numhits.value='.$hitcountsum.
+ ';</script>'.
+ "\n");
+ $r->rflush();
+ }
+ else {
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.img'.$sn.'.'.
+ 'src="/adm/lonIcons/srvempty.gif";'.
+ '</script>'.
+ "\n");
+ $r->rflush();
+ $r->print('<script type="text/javascript">'.
+ 'popwin.hc["'.$rkey.'"]=0'.
+ ';</script>'.
+ "\n");
+ $r->rflush();
+ }
+ last WLOOP;
+ }
+ if ($temp>1) {
+ sleep 1;
+ $timeremain--;
+ $elapsetime++;
+ last WLOOP;
+ }
+ last WLOOP unless $timeremain;
+ sleep 1;
+ $timeremain--;
+ $elapsetime++;
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.popremain.elapsetime.'.
+ 'value="'.$elapsetime.'";</script>'."\n");
+ $r->rflush();
+ $temp++;
+ }
+ }
+ $r->print('<script type="text/javascript">'.
+ 'popwin.document.whirly.'.
+ 'src="'.'/adm/lonIcons/lonanimend.gif'.
+ '";</script>'."\n");
+ $r->rflush();
}
- elsif ($key eq 'or') {
- $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
- $replacement="($1 OR $2)";
+ my $customshow='';
+ my $extrashow='';
+ my @customfields;
+ if ($ENV{'form.customshow'}) {
+ $customshow=$ENV{'form.customshow'};
+ $customshow=~s/[^\w\s]//g;
+ my @fields=map {"<font color=\"#008000\">$_:</font><!-- $_ -->"}
+ split(/\s+/,$customshow);
+ @customfields=split(/\s+/,$customshow);
+ if ($customshow) {
+ $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
+ }
}
- substr($pattern,
- index($pattern,$match),
- length($match),
- $replacement
- );
+ 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;
+ }
+ }
+ if (keys %hash) {
+ untie %hash;
+ }
+ if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
+ if ($ENV{'form.launch'} eq '1') {
+ &start_fresh_session();
+ }
+ foreach my $result (@results) {
+ next if $result=~/^custom\=/;
+ chomp $result;
+ next unless $result;
+ my @fields=map
+ {&Apache::lonnet::unescape($_)}
+ (split(/\,/,$result));
+ my ($title,$author,$subject,$url,$keywords,$version,
+ $notes,$abstract,$mime,$lang,
+ $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
+
+ unless ($ENV{'user.adv'}) {
+ $keywords='<i>- not displayed -</i>';
+ $fields[4]=$keywords;
+ $notes='<i>- not displayed -</i>';
+ $fields[6]=$notes;
+ $abstract='<i>- not displayed -</i>';
+ $fields[7]=$abstract;
+ $subject='<i>- not displayed -</i>';
+ $fields[2]=$subject;
+ }
+
+ my $shortabstract=$abstract;
+ $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200;
+ $fields[7]=$shortabstract;
+ my $shortkeywords=$keywords;
+ $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200;
+ $fields[4]=$shortkeywords;
+
+ my $extrashow2=$extrashow;
+ if ($extrashow) {
+ foreach my $field (@customfields) {
+ my $value='';
+ if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) {
+ $value=$1;
+ }
+ $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g;
+ }
+ }
+
+ $compiledresult.=<<END if $compiledresult or $servercount!=$servernum;
+<hr align='left' width='200' noshade />
+END
+ $compiledresult.=<<END;
+<p>
+END
+ $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'interactive';
+<font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
+onClick="javascript:select_data('$title','$url')">
+</font>
+<br />
+END
+ if ($ENV{'form.catalogmode'} eq 'groupsearch') {
+ $fnum+=0;
+ $hash{"pre_${fnum}_link"}=$url;
+ $hash{"pre_${fnum}_title"}=$title;
+ $compiledresult.=<<END;
+<font size='-1'><input type="checkbox" name="returnvalues" value="SELECT"
+onClick="javascript:queue($fnum)" />
+</font>
+<br />
+END
+# <input type="hidden" name="title$fnum" value="$title" />
+# <input type="hidden" name="url$fnum" value="$url" />
+ $fnum++;
+ }
+ my $httphost=$ENV{'HTTP_HOST'};
+
+ my $viewselect;
+ if ($mode eq 'Basic') {
+ $viewselect=$ENV{'form.basicviewselect'};
+ }
+ elsif ($mode eq 'Advanced') {
+ $viewselect=$ENV{'form.advancedviewselect'};
+ }
+
+ if ($viewselect eq 'Detailed Citation View') {
+ $compiledresult.=&detailed_citation_view(@fields,
+ $hostname,$httphost,
+ $extrashow2);
+ }
+ elsif ($viewselect eq 'Summary View') {
+ $compiledresult.=&summary_view(@fields,$hostname,$httphost,
+ $extrashow2);
+ }
+ elsif ($viewselect eq 'Fielded Format') {
+ $compiledresult.=&fielded_format_view(@fields,$hostname,
+ $httphost,$extrashow2);
+ }
+ elsif ($viewselect eq 'XML/SGML') {
+ $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost,
+ $extrashow2);
+ }
+
+ }
+
+ untie %hash;
+ }
+ else {
+ $r->print('<html><head></head><body>Unable to tie hash to db '.
+ 'file</body></html>');
+ }
+ if ($compiledresult) {
+ $resultflag=1;
+ }
+
+ $r->print(<<RESULTS);
+$compiledresult
+RESULTS
+ my $percent=sprintf('%3.0f',($servercount/$servernum*100));
}
- &recursive_SQL_query_build($dkey,$pattern);
+ }
+ unless ($resultflag) {
+ $r->print("\nThere were no results that matched your query\n");
+ }
+# $r->print('<script type="text/javascript">'.'popwin.close()</script>'."\n"); $r->rflush();
+ $r->print(<<RESULTS);
+</body>
+</html>
+RESULTS
}
# ------------------------------------------------------ Detailed Citation View
@@ -832,19 +1312,34 @@ sub detailed_citation_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
$creationdate,$lastrevisiondate,$owner,$copyright,
- $hostname,$httphost)=@_;
+ $hostname,$httphost,$extrashow)=@_;
my $result=<<END;
<i>$owner</i>, last revised $lastrevisiondate
<h3><A HREF="http://$httphost$url" TARGET='search_preview'>$title</A></h3>
<h3>$author</h3>
</p>
<p>
-<b>Subject:</b> $subject<br>
-<b>Keyword(s):</b> $keywords<br>
-<b>Notes:</b> $notes<br>
-<b>MIME Type:</b> $mimetag{$mime}<br>
-<b>Language:</b> $language{$lang}<br>
-<b>Copyright/Distribution:</b> $cprtag{$copyright}<br>
+<b>Subject:</b> $subject<br />
+<b>Keyword(s):</b> $keywords<br />
+<b>Notes:</b> $notes<br />
+<b>MIME Type:</b>
+END
+ $result.=&Apache::loncommon::filedescription($mime);
+ $result.=<<END;
+<br />
+<b>Language:</b>
+END
+ $result.=&Apache::loncommon::languagedescription($lang);
+ $result.=<<END;
+<br />
+<b>Copyright/Distribution:</b>
+END
+ $result.=&Apache::loncommon::copyrightdescription($copyright);
+ $result.=<<END;
+<br />
+</p>
+$extrashow
+<p>
$shortabstract
</p>
END
@@ -856,12 +1351,14 @@ sub summary_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
$creationdate,$lastrevisiondate,$owner,$copyright,
- $hostname,$httphost)=@_;
+ $hostname,$httphost,$extrashow)=@_;
+ my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
my $result=<<END;
<a href="http://$httphost$url" TARGET='search_preview'>$author</a><br />
$title<br />
$owner -- $lastrevisiondate<br />
-$cprtag{$copyright}<br />
+$cprtag<br />
+$extrashow
</p>
END
return $result;
@@ -872,7 +1369,10 @@ sub fielded_format_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
$creationdate,$lastrevisiondate,$owner,$copyright,
- $hostname,$httphost)=@_;
+ $hostname,$httphost,$extrashow)=@_;
+ my $mimetag=&Apache::loncommon::filedescription($mime);
+ my $language=&Apache::loncommon::languagedescription($lang);
+ my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
my $result=<<END;
<b>URL: </b> <A HREF="http://$httphost$url" TARGET='search_preview'>$url</A>
<br />
@@ -881,14 +1381,15 @@ sub fielded_format_view {
<b>Subject:</b> $subject<br />
<b>Keyword(s):</b> $keywords<br />
<b>Notes:</b> $notes<br />
-<b>MIME Type:</b> $mimetag{$mime}<br />
-<b>Language:</b> $language{$lang}<br />
+<b>MIME Type:</b> $mimetag<br />
+<b>Language:</b> $language<br />
<b>Creation Date:</b> $creationdate<br />
<b>Last Revision Date:</b> $lastrevisiondate<br />
<b>Publisher/Owner:</b> $owner<br />
-<b>Copyright/Distribution:</b> $cprtag{$copyright}<br />
+<b>Copyright/Distribution:</b> $cprtag<br />
<b>Repository Location:</b> $hostname<br />
<b>Abstract:</b> $shortabstract<br />
+$extrashow
</p>
END
return $result;
@@ -899,7 +1400,10 @@ sub xml_sgml_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
$creationdate,$lastrevisiondate,$owner,$copyright,
- $hostname,$httphost)=@_;
+ $hostname,$httphost,$extrashow)=@_;
+ my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
+ my $mimetag=&Apache::loncommon::filedescription($mime);
+ my $language=&Apache::loncommon::languagedescription($lang);
my $result=<<END;
<pre>
<LonCapaResource>
@@ -911,75 +1415,74 @@ sub xml_sgml_view {
<notes>$notes</notes>
<mimeInfo>
<mime>$mime</mime>
-<mimetag>$mimetag{$mime}</mimetag>
+<mimetag>$mimetag</mimetag>
</mimeInfo>
<languageInfo>
<language>$lang</language>
-<languagetag>$language{$lang}</languagetag>
+<languagetag>$language</languagetag>
</languageInfo>
<creationdate>$creationdate</creationdate>
<lastrevisiondate>$lastrevisiondate</lastrevisiondate>
<owner>$owner</owner>
<copyrightInfo>
<copyright>$copyright</copyright>
-<copyrighttag>$cprtag{$copyright}</copyrighttag>
+<copyrighttag>$cprtag</copyrighttag>
</copyrightInfo>
<repositoryLocation>$hostname</repositoryLocation>
<shortabstract>$shortabstract</shortabstract>
</LonCapaResource>
</pre>
+$extrashow
END
return $result;
}
-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;
+# ---------------------------------------------------- see if a field is filled
+sub filled {
+ my ($field)=@_;
+ if ($field=~/\S/ && $field ne 'any') {
+ return 1;
}
- if (@queries) {
- return join(" AND ",@queries);
+ else {
+ return 0;
}
- return '';
}
+# ---------------- Message to output when there are not enough fields filled in
+sub output_blank_field_error {
+ my ($r)=@_;
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+
+ $r->print(<<BEGINNING);
+<html>
+<head>
+<title>The LearningOnline Network with CAPA</title>
+BEGINNING
+ $r->print(<<RESULTS);
+</head>
+<body bgcolor="#ffffff">
+<img align='right' src='/adm/lonIcons/lonlogos.gif' />
+<h1>Search Catalog</h1>
+<form method="post" action="/adm/searchcat">
+$persistent
+<input type='button' value='Revise search request'
+onClick='this.form.submit();' />
+$closebutton
+<hr />
+<h3>Helpful Message</h3>
+<p>
+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.
+</p>
+</body>
+</html>
+RESULTS
+}
+
+# ----------------------------------------------------------- Output date error
sub output_date_error {
my ($r,$message)=@_;
# make query information persistent to allow for subsequent revision
@@ -993,14 +1496,14 @@ BEGINNING
$r->print(<<RESULTS);
</head>
<body bgcolor="#ffffff">
-<img align=right src=/adm/lonIcons/lonlogos.gif>
+<img align='right' src='/adm/lonIcons/lonlogos.gif' />
<h1>Search Catalog</h1>
<form method="post" action="/adm/searchcat">
$persistent
<input type='button' value='Revise search request'
-onClick='this.form.submit();'>
+onClick='this.form.submit();' />
$closebutton
-<hr>
+<hr />
<h3>Helpful Message</h3>
<p>
$message
@@ -1010,21 +1513,261 @@ $message
RESULTS
}
-sub make_persistent {
- my $persistent='';
-
- map {
- if (/^form\./ && !/submit/) {
- my $name=$_;
- my $key=$name;
- $ENV{$key}=~s/\'//g; # do not mess with html field syntax
- $name=~s/^form\.//;
- $persistent.=<<END;
-<input type='hidden' name='$name' value='$ENV{$key}' />
-END
+# --------- settings whenever the user causes the search window to be launched
+sub start_fresh_session {
+ delete $hash{'mode_catalog'};
+ foreach (keys %hash) {
+ if ($_ =~ /^pre_/) {
+ delete $hash{$_};
}
- } (keys %ENV);
- return $persistent;
+ if ($_ =~ /^store/) {
+ delete $hash{$_};
+ }
+ }
}
+
1;
+
__END__
+
+=head1 NAME
+
+Apache::lonsearchcat - mod_perl module for handling a searchable catalog
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+ <Location /adm/searchcat>
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonsearchcat
+ ErrorDocument 403 /adm/login
+ ErrorDocument 500 /adm/errorhandler
+ </Location>
+
+=head1 INTRODUCTION
+
+This module enables searching for a distributed browseable catalog.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 BEGIN SUBROUTINE
+
+This routine is only run once after compilation.
+
+=over 4
+
+=item *
+
+Initializes %language hash table.
+
+=item *
+
+Initializes %cprtag hash table (for copyright.tab).
+
+=item *
+
+Initializes %mimetag hash table (for filetypes.tab).
+
+=item *
+
+Initializes %hostdomains and hostips hash table (for hosts.tab).
+
+=back
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+configure dynamic components of interface
+
+=item *
+
+determine current user
+
+=item *
+
+see if a search invocation should be done
+
+=item *
+
+else, begin building search interface to output
+
+=item *
+
+compute date selection boxes
+
+=item *
+
+compute customized metadata field
+
+=item *
+
+print screen
+
+=back
+
+=head1 OTHER SUBROUTINES
+
+=over 4
+
+=item *
+
+get_unprocessed_cgi() : reads in critical name/value pairs that may have not
+been processed and passed into %ENV by the web server
+
+=item *
+
+make_persistent() : makes a set of hidden HTML fields to make
+SQL search interface information to be persistent
+
+=back
+
+WEB INTERFACE COMPONENT FUNCTIONS
+
+=over 4
+
+=item *
+
+simpletextfield(name,value) : returns HTML formatted string for simple text
+field
+
+=item *
+
+simplecheckbox(name,value) : returns HTML formatted string for simple
+checkbox
+
+=item *
+
+searchphrasefield(title,name,value) : returns HTML formatted string for
+a search expression phrase field
+
+=item *
+
+dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML
+formatted string for a calendar date
+
+=item *
+
+selectbox(title,name,value,%HASH=options) : returns HTML formatted string for
+a selection box field
+
+=back
+
+SEARCH FUNCTIONS
+
+=over 4
+
+=item *
+
+advancedsearch(server reference, environment reference) : perform a complex
+multi-field logical query
+
+=item *
+
+basicsearch(server reference, environment reference) : perform a simple
+single-field logical query
+
+=item *
+
+build_SQL_query(field name, logic) : builds a SQL query string from a
+logical expression with AND/OR keywords
+
+=item *
+
+build_custommetadata_query(field_name, logic_statement) : builds a perl
+regular expression from a logical expression with AND/OR keywords
+
+=item *
+
+recursive_SQL_query_build(field name, reverse notation expression) :
+builds a SQL query string from a reverse notation expression
+logical expression with AND/OR keywords
+
+=item *
+
+build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2,
+lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) :
+Builds a SQL logic query to check time/date entries.
+
+=back
+
+OUTPUTTING RESULTS FUNCTION
+
+=over 4
+
+=item *
+
+output_results(output mode, server reference, environment reference,
+reply list reference) : outputs results from search
+
+=back
+
+DIFFERENT WAYS TO VIEW METADATA RECORDS
+
+=over 4
+
+=item *
+
+detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+see metadata viewing notes below
+
+=item *
+
+summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+see metadata viewing notes below
+
+=item *
+
+fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+see metadata viewing notes below
+
+=item *
+
+xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+see metadata viewing notes below
+
+=back
+
+ _____________________________________________________________________
+ | * Metadata viewing notes |
+ | Output is a HTML-ified string. |
+ | Input arguments are title, author, subject, url, keywords, version, |
+ | notes, short abstract, mime, language, creation date, |
+ | last revision date, owner, copyright, hostname, httphost, and |
+ | extra custom metadata to show. |
+ ---------------------------------------------------------------------
+
+TEST CONDITIONAL FUNCTIONS
+
+=over 4
+
+=item *
+
+filled(field) : determines whether a given field has been filled
+
+=back
+
+ERROR FUNCTIONS
+
+=over 4
+
+=item *
+
+output_blank_field_error(server reference) : outputs a message saying that
+more fields need to be filled in
+
+=item *
+
+output_date_error(server reference, error message) : outputs
+an error message specific to bad date format.
+
+=back
+
+=cut