--- loncom/interface/lonsearchcat.pm 2001/03/15 18:23:54 1.17
+++ loncom/interface/lonsearchcat.pm 2002/06/24 15:09:52 1.126
@@ -1,126 +1,426 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Search Catalog
#
-# 03/08/2001 Scott Harrison
+# $Id: lonsearchcat.pm,v 1.126 2002/06/24 15:09:52 matthew Exp $
#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+# YEAR=2001
+# 3/8, 3/12, 3/13, 3/14, 3/15, 3/19 Scott Harrison
+# 3/20, 3/21, 3/22, 3/26, 3/27, 4/2, 8/15, 8/24, 8/25 Scott Harrison
+# 10/12,10/14,10/15,10/16,11/28,11/29,12/10,12/12,12/16 Scott Harrison
+# YEAR=2002
+# 1/17 Scott Harrison
+# 6/17 Matthew Hall
+#
+###############################################################################
+###############################################################################
+
+=pod
+
+=head1 NAME
+
+lonsearchcat
+
+=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. 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();
+
+# ---------------------------------------- variables used throughout the module
+
+######################################################################
+######################################################################
+
+=pod
+
+=item Global variables
+
+=over 4
+
+=item %hostdomains
+
+matches host name to host domain
+
+=item %hostips
+
+matches host name to host ip
+
+=item %hitcount
+
+stores number of hits per host
+
+=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
+
+=cut
+
+######################################################################
+######################################################################
+
+# -- information holders
+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 $yourself; # allows for quickly limiting to oneself
+my %hash; # database 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
+
+#------------------------------------------------------------- global variables
+my $diropendb = "";
+my $domain = "";
+
+# ----------------------------------------------------------------------- BEGIN
+
+=pod
+
+=item BEGIN block
+
+Load %hostdomains and %hostips with data from lonnet.pm. Only library
+servers are considered.
+
+=cut
+
+BEGIN {
+ foreach (keys (%Apache::lonnet::libserv)) {
+ $hostdomains{$_}=$Apache::lonnet::hostdom{$_};
+ $hostips{$_}=$Apache::lonnet::hostip{$_};
+ }
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &handler() - main handler invoked by httpd child
+
+=item Variables
+
+=over 4
+
+=item $hidden
-my %language;
-my $scrout;
-my %metadatafields;
-my %cprtag;
-my %mimetag;
+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;
+ }
}
-
+ ##
+ ## 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
+ }
+ $hidden .= <
+
+
+
+END
+ ##
+ ## What are we doing?
+ ##
if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
- return &basicsearch($r,$ENV{'form.basicexp'});
+ # 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;
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &basic_search_form()
+
+Returns a scalar which holds html for the basic search form.
+
+=cut
+
+######################################################################
+######################################################################
+
+sub basic_search_form{
+ my ($closebutton,$hidden) = @_;
+ my $scrout=<<"ENDDOCUMENT";
+
+
+The LearningOnline Network with CAPA
+
+
+
+
+
Search Catalog
+
+
+
+$closebutton
+
+
+
+
+
+
+
+
+ENDDOCUMENT
+ return $scrout;
+}
+######################################################################
+######################################################################
+
+=pod
+
+=item &advanced_search_form()
- $scrout=''; # building a part of screen output
+Returns a scalar which holds html for the advanced search form.
+
+=cut
+
+######################################################################
+######################################################################
+
+sub advanced_search_form{
+ my ($closebutton,$hidden) = @_;
+ my $scrout=<<"ENDHEADER";
+
+
+The LearningOnline Network with CAPA
+
+
+
+
+
Search Catalog
+
ENDDOCUMENT
- return OK;
-}
+ return $scrout;
+}
-# --------------------------------------------------------- Various form fields
+######################################################################
+######################################################################
-sub textfield {
- my ($title,$name,$value)=@_;
- return "\n
$title: ".
- '';
+=pod
+
+=item &make_persistent()
+
+Returns a scalar which holds the current ENV{'form.*'} values in
+a 'hidden' html input tag. This allows search interface information
+to be somewhat persistent.
+
+=cut
+
+######################################################################
+######################################################################
+
+sub make_persistent {
+ my $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()
+
+Returns html selection form.
+
+=back
+
+=cut
+
+######################################################################
+######################################################################
+
sub simpletextfield {
- my ($name,$value)=@_;
- return '';
+ my ($name,$value,$size)=@_;
+ $size = 20 if (! defined($size));
+ return '';
}
sub simplecheckbox {
my ($name,$value)=@_;
my $checked='';
$checked="CHECKED" if $value eq 'on';
- return '';
+ return '';
}
sub searchphrasefield {
my ($title,$name,$value)=@_;
my $instruction=<$uctitle:".
- " $instruction ".
- '';
+ return "\n".
+ '
'.$uctitle.':'.
+ " $instruction ".&simpletextfield($name,$value,80);
}
sub dateboxes {
my ($name,$defaultmonth,$defaultday,$defaultyear,
$currentmonth,$currentday,$currentyear)=@_;
($defaultmonth,$defaultday,$defaultyear)=('','','');
- my $month=<
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-END
- $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
+ #
+ # Day
my $day=<
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
END
+ for (my $i = 1; $i<=31; $i++) {
+ $day.="\n";
+ }
+ $day.="\n";
$day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
+ #
+ # Month
+ my $month=<
+
+END
+ my $i = 1;
+ foreach (qw/January February March April May June
+ July August September October November December /){
+ $month .="\n";
+ $i++;
+ }
+ $month.="\n";
+ $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
+ #
+ # Year (obviously)
my $year=<
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
END
+ my $maxyear = 2051;
+ for (my $i = 1976; $i<=$maxyear; $i++) {
+ $year.="\n";
+ }
+ $year.="\n";
$year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
return "$month$day$year";
}
sub selectbox {
- my ($title,$name,$value,%options)=@_;
+ my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_;
my $uctitle=uc($title);
- my $selout="\n
+Incorrect search query due to blank entry fields.
+You need to fill in the relevant
+fields on the search page in order for a query to be
+processed.
+
+
+
+RESULTS
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &output_date_error()
+
+Output a full html page with an error message.
+
+=cut
+
+######################################################################
+######################################################################
+sub output_date_error {
+ my ($r,$message)=@_;
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+
+ $r->print(<
+
+The LearningOnline Network with CAPA
+
+
+
+
Search Catalog
+
$persistent
-
-
Search Query
+
+$closebutton
+
+
Helpful Message
-Basic search: $expression
+$message
-
Search Results
-$compiledresult
RESULTS
+}
- return OK;
+######################################################################
+######################################################################
+
+=pod
+
+=item &start_fresh_session()
+
+Cleans the global %hash by removing all fields which begin with
+'pre_' or 'store'.
+
+=cut
+
+######################################################################
+######################################################################
+sub start_fresh_session {
+ delete $hash{'mode_catalog'};
+ foreach (keys %hash) {
+ if ($_ =~ /^pre_/) {
+ delete $hash{$_};
+ }
+ if ($_ =~ /^store/) {
+ delete $hash{$_};
+ }
+ }
}
+######################################################################
+######################################################################
+
+=pod
+
+=item &popwin_js() send javascript to popwin
+
+=cut
+
+######################################################################
+######################################################################
+sub popwin_js {
+ # Print javascript out to popwin, but make sure we dont generate
+ # any javascript errors in doing so.
+ my ($r,$text) = @_;
+ $r->print(<<"END");
+
+END
+ $r->rflush();
+}
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &popwin_imgupdate()
+
+Send a given image (and its location) out to the browser. Takes as
+input $r, loncapa server id, and an icon URL.
+
+=cut
+
+######################################################################
+######################################################################
+sub popwin_imgupdate {
+ my ($r,$server,$icon) = @_;
+ &popwin_js($r,'popwin.document.img_'.$hostdomains{$server}.'_'.$server.'.'.
+ 'src="/adm/lonIcons/'.$icon.'";');
+}
+
1;
+
__END__
+
+=pod
+
+=back
+
+=cut