--- loncom/interface/lonsearchcat.pm 2001/03/19 16:45:38 1.41
+++ loncom/interface/lonsearchcat.pm 2002/01/17 13:53:45 1.115
@@ -1,113 +1,183 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Search Catalog
#
-# 03/08/2001 Scott Harrison
+# $Id: lonsearchcat.pm,v 1.115 2002/01/17 13:53:45 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() :
-# 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
+#
+###
+
+###############################################################################
+## ##
+## 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
+
+# -- 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 $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
+my $advancedviewselect=<
+
+
+
+
+
+END
-my %language;
-my $scrout;
-my %metadatafields;
-my %cprtag;
-my %mimetag;
+# ----------------------------------------------------------------------- BEGIN
+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');
- my $hidden='';
- $hidden=<
-END
+ $diropendb= "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db";
-# ------------------------------------------------ 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>;
+ 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;
+ }
}
- %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>;
+# ----------------------------------- configure dynamic components of interface
+ my $hidden='';
+ if ($ENV{'form.catalogmode'} eq 'interactive') {
+ $hidden="".
+ "\n";
+ $closebutton=""."\n";
}
-
- %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>;
+ elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
+ $hidden=<
+END
+ $closebutton=<
+END
+ $importbutton=<
+END
}
+# ------------------------------------------------------ Determine current user
+ $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
+
+# --- 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'});
@@ -124,8 +194,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'});
@@ -133,22 +203,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.=<LIMIT BY CREATION DATE RANGE:
-
+
between:
CREATIONDATESTART
$scrout.=&dateboxes('creationdatestart',1,1,1976,
@@ -170,7 +245,7 @@ CREATIONDATEEND
LIMIT BY LAST REVISION DATE RANGE:
- between:
+ between:
LASTREVISIONDATESTART
$scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
$ENV{'form.lastrevisiondatestart_month'},
@@ -189,64 +264,89 @@ 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.=<
-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';
+ $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.=' initial users of this system do not need to worry about this option';
+
# ---------------------------------------------------------------- Print screen
$r->print(<The LearningOnline Network with CAPA
+
-
+
Search Catalog
-
-
-
-
+
+
+
+$closebutton
+$basicviewselect
+
-
+
Advanced Search
$scrout
-
-
-
+
+
+$closebutton
+$advancedviewselect
+
@@ -255,30 +355,61 @@ 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
+ }
+ }
+ return $persistent;
+}
+
# --------------------------------------------------------- Various form fields
sub simpletextfield {
my ($name,$value)=@_;
- return '';
+ 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 ".
- '';
+ " $instruction ".
+ '';
}
sub dateboxes {
@@ -426,24 +557,47 @@ END
}
sub selectbox {
- my ($title,$name,$value,%options)=@_;
+ my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_;
my $uctitle=uc($title);
my $selout="\n
$uctitle:".
- " ".'
-END
- }
+# - 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);
+}
- unless ($compiledresult) {
- $compiledresult="There were no results that matched your query";
+# ------------------------------------------------------------ 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 '';
+}
- # 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);
+# ----------------------------- 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 $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;
+
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+ # output beginning of search page
$r->print(<The LearningOnline Network with CAPA
BEGINNING
+
+ # conditional output of script functions dependent on the mode in
+ # which the search was invoked
$r->print(<
SCRIPT
- $r->print(<print(<
+SCRIPT
+ $r->print(<
+SCRIPT
+ $r->rflush();
+
+ # begin showing the cataloged results
+ $r->print(<