--- loncom/interface/lonsearchcat.pm 2001/03/08 13:32:04 1.2
+++ loncom/interface/lonsearchcat.pm 2001/10/17 03:31:34 1.102
@@ -1,64 +1,1572 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
+#
# Search Catalog
#
+# YEAR=2001
# 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, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001
+# Scott Harrison: 04/02/2001, 08/15/2001, 08/24/2001, 08/25/2001
+# 10/12,10/14,10/15,10/16 Scott Harrison
+###############################################################################
+## ##
+## ORGANIZATION OF THIS PERL MODULE ##
+## ##
+## 1. Description of functions ##
+## 2. Modules used by this module ##
+## 3. Choices for different output views (detailed, summary, xml, etc) ##
+## 4. BEGIN block (to be run once after compilation) ##
+## 5. Handling routine called via Apache and mod_perl ##
+## 6. Other subroutines ##
+## ##
+###############################################################################
+
+# ---------------------------------------------------- Description of functions
+#
+#
+# === WEB HANDLER FUNCTIONS
+# BEGIN() : run once after compilation to initialize values
+# handler(server reference) : interacts with the Apache server layer
+# (for /adm/searchcat URLs)
+# get_unprocessed_cgi() : reads in critical name/value pairs that may have not
+# been processed and passed into %ENV by the web server
+# make_persistent() : makes a set of hidden HTML fields to make
+# SQL search interface information to be persistent
+#
+#
+# === WEB INTERFACE COMPONENT FUNCTIONS
+# 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
+#
+#
+# === SEARCH FUNCTIONS
+# advancedsearch(server reference, environment reference) : perform a complex
+# multi-field logical query
+# basicsearch(server reference, environment reference) : perform a simple
+# single-field logical query
+# build_SQL_query(field name, logic) : builds a SQL query string from a
+# logical expression with AND/OR keywords
+# build_custommetadata_query(field_name, logic_statement) : builds a perl
+# regular expression 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
+# 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.
#
+#
+# === OUTPUTTING RESULTS FUNCTION
+# output_results(output mode,
+# server reference,
+# environment reference,
+# reply list reference) : outputs results from search
+#
+#
+# === DIFFERENT WAYS TO VIEW METADATA RECORDS
+# detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+# see metadata viewing notes below
+# summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+# see metadata viewing notes below
+# fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+# see metadata viewing notes below
+# xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
+# see metadata viewing notes below
+# ___________________________________________________________________________
+# | * 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
+# filled(field) : determines whether a given field has been filled
+#
+#
+# === ERROR FUNCTIONS
+# output_blank_field_error(server reference) : outputs a message saying that
+# more fields need to be filled in
+# output_date_error(server reference, error message) : outputs
+# an error message specific to bad date format.
+
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;
+# ---------------------------------------- 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=< $uctitle:".
+ "
+between:
+CREATIONDATESTART
+ $scrout.=&dateboxes('creationdatestart',1,1,1976,
+ $ENV{'form.creationdatestart_month'},
+ $ENV{'form.creationdatestart_day'},
+ $ENV{'form.creationdatestart_year'},
+ );
+ $scrout.=<
between:
+LASTREVISIONDATESTART
+ $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
+ $ENV{'form.lastrevisiondatestart_month'},
+ $ENV{'form.lastrevisiondatestart_day'},
+ $ENV{'form.lastrevisiondatestart_year'},
+ );
+ $scrout.=<
+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.=<
+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(<Search Catalog
-
ENDDOCUMENT
return OK;
}
+# ----------- grab unprocessed CGI variables that may have been appended to URL
+sub get_unprocessed_cgi {
+ 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' or $name eq 'launch' or $name eq 'acts') {
+ $ENV{'form.'.$name}=$value;
+ }
+ } (split(/&/,$ENV{'QUERY_STRING'}));
+}
+
+# ------------------------------------------------------------- make persistent
+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.=<
".
+ '';
+}
+
+sub dateboxes {
+ my ($name,$defaultmonth,$defaultday,$defaultyear,
+ $currentmonth,$currentday,$currentyear)=@_;
+ ($defaultmonth,$defaultday,$defaultyear)=('','','');
+ my $month=<
".'';
+}
+
+# ----------------------------------------------- Performing an advanced search
+sub advancedsearch {
+ my ($r,$envhash)=@_;
+ 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;
+ }
+
+ # Check to see if enough information was filled in
+ for my $field ('title','author','subject','keywords','url','version',
+ 'notes','abstract','mime','language','owner',
+ 'custommetadata') {
+ if (&filled($ENV{"form.$field"})) {
+ $fillflag++;
+ }
+ }
+ unless ($fillflag) {
+ &output_blank_field_error($r);
+ return OK;
+ }
+
+
+ # Turn the form input into a SQL-based query
+ my $query='';
+
+ my @queries;
+ # 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'}\")";
+ }
+ 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);
+ }
+ 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
+
+ &output_results('Basic',$r,$envhash,$query,$reply);
+
+ return OK;
+}
+
+# ------------------------------------------------------------- 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;
+}
+
+# ------------------------------------------------- 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 $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(<Search Catalog
+CATALOGBEGIN
+ $r->print(<
+Search Query
+CATALOGCONTROLS
+ if ($mode eq 'Basic') {
+ $r->print(<
+Subject: $subject
+Keyword(s): $keywords
+Notes: $notes
+MIME Type: $mimetag{$mime}
+Language: $language{$lang}
+Copyright/Distribution: $cprtag{$copyright}
+
+$shortabstract +
+END + return $result; +} + +# ---------------------------------------------------------------- Summary View +sub summary_view { + my ($title,$author,$subject,$url,$keywords,$version, + $notes,$shortabstract,$mime,$lang, + $creationdate,$lastrevisiondate,$owner,$copyright, + $hostname,$httphost,$extrashow)=@_; + my $result=<