--- loncom/interface/lonsearchcat.pm 2001/08/16 02:20:01 1.97 +++ loncom/interface/lonsearchcat.pm 2002/06/20 14:31:31 1.124 @@ -1,213 +1,426 @@ -# 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 +# $Id: lonsearchcat.pm,v 1.124 2002/06/20 14:31:31 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 # -# Functions +# http://www.lon-capa.org/ # -# 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 -# build_custommetadata_query(field_name, logic_statement) : builds a perl -# regular expression from a logical expression with AND/OR -# keywords -# detailed_citation_view, summary_view, fielded_format_view, xml_sgml_view: -# four different ways to view metadata records. Outputs 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. -# 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. -# output_date_error(server reference, error message) : outputs -# an error message specific to bad date format. -# make_persistent() : makes a set of hidden HTML fields to make -# SQL search interface information to be persistent +# 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 -my %language; -my $scrout; -my %metadatafields; -my %cprtag; -my %mimetag; -my $closebutton; -# ------ form selection elements that allow for choosing different output views -# Detailed Citation View ---> sub detailed_citationview +###################################################################### +###################################################################### + +=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 -my $basicviewselect=< - - - - - -END -my $advancedviewselect=< - - - - - -END -# ----------------------------- Handling routine called via Apache and mod_perl +#------------------------------------------------------------- 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 + +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=''; + 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') { + # 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; +} -# ------------------------------------------------ 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>; - } - - %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>; - } +=pod -# ----------------------------------- See if a search invocation should be done - if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - return &basicsearch($r,\%ENV); - } - elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - return &advancedsearch($r,\%ENV); +=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

+
+$hidden +

Basic Search

+

+Enter terms or phrases separated by AND, OR, or NOT then press SEARCH below. +

+

+ +
+ENDDOCUMENT + $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40). + ' '; +# $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'}); +# $scrout.='Search historic archives'; + $scrout.=<Advanced Search
+

+

+   +$closebutton + + + + +

+
+ + +ENDDOCUMENT + return $scrout; +} +###################################################################### +###################################################################### + +=pod + +=item &advanced_search_form() + +Returns a scalar which holds html for the advanced search form. + +=cut + +###################################################################### +###################################################################### -# ----------------------------- Else, begin building search interface to output - $scrout=''; # building a part of screen output +sub advanced_search_form{ + my ($closebutton,$hidden) = @_; + my $scrout=<<"ENDHEADER"; + + +The LearningOnline Network with CAPA + + + + +

Search Catalog

+
+$hidden +
+

Advanced Search

+ENDHEADER $scrout.=&searchphrasefield('Limit by title','title', $ENV{'form.title'}); - $scrout.=&searchphrasefield('Limit by author','author', $ENV{'form.author'}); - $scrout.=&searchphrasefield('Limit by subject','subject', $ENV{'form.subject'}); - $scrout.=&searchphrasefield('Limit by keywords','keywords', $ENV{'form.keywords'}); - $scrout.=&searchphrasefield('Limit by URL','url', $ENV{'form.url'}); - # $scrout.=&searchphrasefield('Limit by version','version', # $ENV{'form.version'}); - $scrout.=&searchphrasefield('Limit by notes','notes', $ENV{'form.notes'}); - $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, @@ -215,21 +428,18 @@ CREATIONDATESTART $ENV{'form.creationdatestart_day'}, $ENV{'form.creationdatestart_year'}, ); - $scrout.=< LIMIT BY LAST REVISION DATE RANGE: -
between: +
between: LASTREVISIONDATESTART $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, $ENV{'form.lastrevisiondatestart_month'}, @@ -245,277 +455,235 @@ LASTREVISIONDATEEND $ENV{'form.lastrevisiondateend_year'}, ); $scrout.='

'; - $scrout.=&searchphrasefield('Limit by publisher/owner','owner', $ENV{'form.owner'}); -# $metadatafields{'owner'}); - $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); $scrout.=&selectbox('Limit by copyright/distribution','copyright', - $ENV{'form.copyright'},%cprtag); - + $ENV{'form.copyright'}, + 'any','Any copyright/distribution', + \&{Apache::loncommon::copyrightdescription}, + (&Apache::loncommon::copyrightids), + ); # ------------------------------------------- Compute customized metadata field $scrout.=< LIMIT BY SPECIAL METADATA FIELDS: For resource-specific metadata, enter in an expression in the form of -key=value separated by operators such as AND or OR.
+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.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); $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

- -$hidden -
-

Basic Search

-

-Enter terms or phrases separated by search operators -such as AND or OR then press SEARCH below. Terms should be specific -to the title, author, subject, notes, or abstract information associated -with a resource. -
-ENDDOCUMENT - $r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'})); - $r->print(' '); - $r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'})); - $r->print('Title only '); -# $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'})); -# Search historic archives - $r->print(< - - -$closebutton -$basicviewselect -

-
-

Advanced Search

-$scrout + $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); + $scrout.=< $closebutton -$advancedviewselect + + + +

ENDDOCUMENT - return OK; -} + return $scrout; +} + +###################################################################### +###################################################################### + +=pod + +=item &make_persistent() + +Returns a scalar which holds the current ENV{'form.*'} values in +a 'hidden' html input tag. + +=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() -# --------------------------------------------------------- Various form fields +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() + +=item &selectbox() + +=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

$uctitle:". - "
".''; + foreach ($anyvalue,@idlist) { + $selout.=''; + } + else {$selout.='>'.&{$functionref}($_).'';} + } return $selout.''; } -# ----------------------------------------------- Performing an advanced search +###################################################################### +###################################################################### + +=pod + +=item &advancedsearch() + +=cut + +###################################################################### +###################################################################### sub advancedsearch { - my ($r,$envhash)=@_; + my ($r,$envhash,$hidden)=@_; my %ENV=%{$envhash}; - my $fillflag=0; # Clean up fields for safety for my $field ('title','author','subject','keywords','url','version', @@ -527,9 +695,14 @@ sub advancedsearch { 'lastrevisiondateend_day','lastrevisiondateend_year', 'notes','abstract','mime','language','owner', 'custommetadata','customshow') { - $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g; + $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g; + } + foreach ('mode','form','element') { + # is this required? Hmmm. + next unless (exists($ENV{"form.$_"})); + $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); + $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; } - # Check to see if enough information was filled in for my $field ('title','author','subject','keywords','url','version', 'notes','abstract','mime','language','owner', @@ -542,11 +715,8 @@ sub advancedsearch { &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', @@ -588,7 +758,6 @@ sub advancedsearch { elsif ($datequery) { push @queries,$datequery; } - # Process form information for custom metadata querying my $customquery=''; if ($ENV{'form.custommetadata'}) { @@ -616,38 +785,42 @@ sub advancedsearch { $reply=&Apache::lonnet::metadata_query($query, $customquery,$customshow); } - &output_results('Advanced',$r,$envhash,$customquery,$reply); + &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden); } elsif ($customquery) { my $reply; # reply hash reference $reply=&Apache::lonnet::metadata_query('', $customquery,$customshow); - &output_results('Advanced',$r,$envhash,$customquery,$reply); + &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden); } # should not get to this point return 'Error. Should not have gone to this point.'; } -# ---------------------------------------------------- see if a field is filled -sub filled { - my ($field)=@_; - if ($field=~/\S/ && $field ne 'any') { - return 1; - } - else { - return 0; - } -} +###################################################################### +###################################################################### + +=pod -# --------------------------------------------------- Performing a basic search +=item &basicsearch() + +=cut + +###################################################################### +###################################################################### sub basicsearch { - my ($r,$envhash)=@_; + my ($r,$envhash,$hidden)=@_; my %ENV=%{$envhash}; - # Clean up fields for safety for my $field ('basicexp') { $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g; } + foreach ('mode','form','element') { + # is this required? Hmmm. + next unless (exists($ENV{"form.$_"})); + $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); + $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; + } # Check to see if enough is filled in unless (&filled($ENV{'form.basicexp'})) { @@ -658,62 +831,206 @@ sub basicsearch { # Build SQL query string based on form page my $query=''; my $concatarg=join('," ",', - ('title', 'author', 'subject', 'notes', 'abstract')); + ('title', 'author', 'subject', 'notes', 'abstract', + 'keywords')); $concatarg='title' if $ENV{'form.titleonly'}; $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); - # Get reply (either a hash reference to filehandles or bad connection) my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query); # Output search results - &output_results('Basic',$r,$envhash,$query,$reply); + + &output_results('Basic',$r,$envhash,$query,$reply,$hidden); 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(); - $r->print(< - -The LearningOnline Network with CAPA -BEGINNING - $r->print(< - - -

Search Catalog

-
-$persistent - -$closebutton -
-

Helpful Message

-

-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 &build_SQL_query() + +=cut + +###################################################################### +###################################################################### +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; +} + +###################################################################### +###################################################################### + +=pod + +=item &build_custommetadata_query() + +=cut + +###################################################################### +###################################################################### +sub build_custommetadata_query { + my ($field_name,$logic_statement)=@_; + &Apache::lonnet::logthis("Entered build_custommetadata_query:". + $field_name.':'.$logic_statement); + my $q=new Text::Query('abc', + -parse => 'Text::Query::ParseAdvanced', + -build => 'Text::Query::BuildAdvancedString'); + $q->prepare($logic_statement); + my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; + # quick fix to change literal into xml tag-matching + # will eventually have to write a separate builder module + # wordone=wordtwo becomes\[^\<] *wordtwo[^\<]*\<\/wordone\> + $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to + /\\<$1\\>?# \ + \[\^\\<\]?# [^\<] + \*$2\[\^\\<\]?# *wordtwo[^\<] + \*\\<\\\/$1\\>?# *\<\/wordone\> + /g; + &Apache::lonnet::logthis("match expression: ".$matchexp); + return $matchexp; +} + +###################################################################### +###################################################################### + +=pod + +=item &recursive_SQL_query_build() + +=cut + +###################################################################### +###################################################################### +sub recursive_SQL_query_build { + my ($dkey,$pattern)=@_; + my @matches=($pattern=~/(\[[^\]|\[]*\])/g); + return $pattern unless @matches; + foreach my $match (@matches) { + $match=~/\[ (\w+)\s(.*) \]/; + my ($key,$value)=($1,$2); + my $replacement=''; + if ($key eq 'literal') { + $replacement="($dkey like \"\%$value\%\")"; + } + elsif ($key eq 'not') { + $value=~s/like/not like/; +# $replacement="($dkey not like $value)"; + $replacement="$value"; + } + elsif ($key eq 'and') { + $value=~/(.*[\"|\)]) ([|\(|\^].*)/; + $replacement="($1 AND $2)"; + } + elsif ($key eq 'or') { + $value=~/(.*[\"|\)]) ([|\(|\^].*)/; + $replacement="($1 OR $2)"; + } + substr($pattern, + index($pattern,$match), + length($match), + $replacement + ); + } + &recursive_SQL_query_build($dkey,$pattern); +} + +###################################################################### +###################################################################### + +=pod + +=item &build_date_queries() + +=cut + +###################################################################### +###################################################################### +sub build_date_queries { + my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, + $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; + my @queries; + if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) { + unless ($cmonth1 and $cday1 and $cyear1 and + $cmonth2 and $cday2 and $cyear2) { + return "Incorrect entry for the creation date. You must specify ". + "a starting month, day, and year and an ending month, ". + "day, and year."; + } + my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1); + $cnumeric1+=0; + my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2); + $cnumeric2+=0; + if ($cnumeric1>$cnumeric2) { + return "Incorrect entry for the creation date. The starting ". + "date must occur before the ending date."; + } + my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '". + "$cyear2-$cmonth2-$cday2 23:59:59')"; + push @queries,$cquery; + } + if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) { + unless ($lmonth1 and $lday1 and $lyear1 and + $lmonth2 and $lday2 and $lyear2) { + return "Incorrect entry for the last revision date. You must ". + "specify a starting month, day, and year and an ending ". + "month, day, and year."; + } + my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1); + $lnumeric1+=0; + my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2); + $lnumeric2+=0; + if ($lnumeric1>$lnumeric2) { + return "Incorrect entry for the last revision date. The ". + "starting date must occur before the ending date."; + } + my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '". + "$lyear2-$lmonth2-$lday2 23:59:59')"; + push @queries,$lquery; + } + if (@queries) { + return join(" AND ",@queries); + } + return ''; } -# ----------------------------- format and output results based on a reply list +###################################################################### +###################################################################### + +=pod + +=item &output_results() + +Format and output results based on a reply list. +There are two windows that this function writes to. The main search +window ("srch") has a listing of the results. A secondary window ("popwin") +gives the status of the network search (time elapsed, number of machines +contacted, etc.) + +=cut + +###################################################################### +###################################################################### sub output_results { - my ($mode,$r,$envhash,$query,$replyref)=@_; + my $fnum; # search result counter + my ($mode,$r,$envhash,$query,$replyref,$hidden)=@_; my %ENV=%{$envhash}; my %rhash=%{$replyref}; my $compiledresult=''; - my $timeremain=30; + my $timeremain=300; + my $elapsetime=0; my $resultflag=0; my $tflag=1; @@ -726,8 +1043,13 @@ sub output_results { The LearningOnline Network with CAPA BEGINNING - $r->print(< + + # conditional output of script functions dependent on the mode in + # which the search was invoked + if ($ENV{'form.catalogmode'} eq 'interactive'){ + if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { + $r->print(< function select_data(title,url) { changeTitle(title); changeURL(url); @@ -745,21 +1067,85 @@ BEGINNING } SCRIPT + } elsif ($ENV{'form.mode'} eq 'edit') { + my $form = $ENV{'form.form'}; + my $element = $ENV{'form.element'}; + $r->print(< +function select_data(title,url) { + changeURL(url); + self.close(); +} +function changeTitle(val) { +} +function changeURL(val) { + if (window.opener.document) { + window.opener.document.forms["$form"].elements["$element"].value=val; + } else { + var url = 'forms[\"$form\"].elements[\"$element\"].value'; + alert("Unable to transfer data to "+url); + } +} + +SCRIPT + } + } + $r->print(< + 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?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ + document.forms.results.acts.value; + } + +SCRIPT + $r->print(< + 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) { + popwin.close(); + } + +SCRIPT + $r->rflush(); + + # begin showing the cataloged results $r->print(<

Search Catalog

CATALOGBEGIN - $r->print(< + $r->print(< +$hidden + +onClick='this.form.submit();' /> +$importbutton $closebutton $persistent -
+

Search Query

-RESULTS +CATALOGCONTROLS if ($mode eq 'Basic') { $r->print(< @@ -777,72 +1163,164 @@ RESULTS } $r->print('

Search Results

'); $r->rflush(); + my $servernum=(keys %rhash)+0; + + # define server grid (shows status of multiple machines) + my $hcinit; + my $grid="'
'+"; + $grid.="\n"; + my $sn=1; + for my $sk (sort keys %rhash) { + # ''+ + $grid.="'+\"'\"+')\">'+"; + $grid.="\n"; + $grid.="'\"".$sk."\"'+\n"; + $grid.="'
'+\n" unless $sn%10; + $sn++; + } $r->print(< - popwin=open('','popwin','width=400,height=200'); - popwin.document.writeln(''+ - '

Search Results Progress

'+ - ''+ - '
Server space '+ - '
Status '+ - '
Maximum remaining time '+ - ''+ - ''); + ENDPOP $r->rflush(); - my $servernum=(keys %rhash)+0; - $r->print(''); - $r->rflush(); my $servercount=0; - foreach my $rkey (keys %rhash) { + 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; - $r->print(''); - $r->rflush(); my $reply=$rhash{$rkey}; my @results; my $replyfile=''; if ($reply eq 'con_lost') { - my $percent=sprintf('%3.0f',($servercount/$servernum*100)); - $r->print(''); + &popwin_imgupdate($r,$sn,"srvbad.gif"); + $bloop--; + $orkey{$rkey}=1; } else { $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; $reply=~/(.*?)\_/; { - while (1) { - if (-e $replyfile && $tflag) { - $r->print(''); - $r->rflush(); - $tflag=0; - } - last if -e "$replyfile.end"; - last unless $timeremain; - sleep 1; - $timeremain--; - $r->print(''); - $r->rflush(); - } - # 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('ERROR: file cannot be opened') and return OK); - @results=<$fh>; + my $temp=0; + WLOOP: while (1) { + if (-e $replyfile && $tflag) { + &popwin_imgupdate($r,$sn,"srvhalf.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + '"still transferring..."'.';'); + $tflag=0; + } + if (-e "$replyfile.end") { + $bloop--; + $orkey{$rkey}=1; + if (-s $replyfile) { + &popwin_imgupdate($r,$sn,"srvgood.gif"); + 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; + &popwin_js($r,'popwin.hc["'.$rkey.'"]='. + $hitcount{$rkey}.';'); + $hitcountsum+=$hitcount{$rkey}; + &popwin_js($r,'popwin.document.forms.popremain.'. + 'numhits.value='.$hitcountsum.';'); + } + else { + &popwin_imgupdate($r,$sn,"srvempty.gif"); + &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); + } + last WLOOP; + } + if ($temp>1) { + sleep 1; + $timeremain--; + $elapsetime++; + last WLOOP; + } + last WLOOP unless $timeremain; + sleep 1; + $timeremain--; + $elapsetime++; + &popwin_js($r,"popwin.document.popremain.". + "elapsetime.value=$elapsetime;"); + $temp++; + } } + &popwin_js($r,'popwin.document.whirly.'. + 'src="/adm/lonIcons/lonanimend.gif";'); } my $customshow=''; my $extrashow=''; @@ -868,72 +1346,121 @@ ENDPOP $customhash{$k}=$v; } } - 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; - my $shortabstract=$abstract; - $shortabstract=substr($abstract,0,200) if length($abstract)>200; - $fields[7]=$shortabstract; - my $extrashow2=$extrashow; - if ($extrashow) { - foreach my $field (@customfields) { - my $value=''; - if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) { - $value=$1; - } - $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g; - } - } + 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 ($title =~ /^\s*$/ ) { $title='Untitled'; } + unless ($ENV{'user.adv'}) { + $keywords='- not displayed -'; + $fields[4]=$keywords; + $notes='- not displayed -'; + $fields[6]=$notes; + $abstract='- not displayed -'; + $fields[7]=$abstract; + $subject='- not displayed -'; + $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 - $compiledresult.=< END - $compiledresult.=< +onClick="javascript:select_data('$titleesc','$url')"> -
+
+END + } + if ($ENV{'form.catalogmode'} eq 'groupsearch') { + $fnum+=0; + $hash{"pre_${fnum}_link"}=$url; + $hash{"pre_${fnum}_title"}=$title; + $compiledresult.=< + + +
END - my $httphost=$ENV{'HTTP_HOST'}; +# +# + $fnum++; + } + my $httphost=$ENV{'HTTP_HOST'}; - my $viewselect; - if ($mode eq 'Basic') { - $viewselect=$ENV{'form.basicviewselect'}; - } - elsif ($mode eq 'Advanced') { - $viewselect=$ENV{'form.advancedviewselect'}; - } + 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, + 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, + } + elsif ($viewselect eq 'Summary View') { + $compiledresult.=&summary_view(@fields,$hostname,$httphost, $extrashow2); - } - elsif ($viewselect eq 'Fielded Format') { - $compiledresult.=&fielded_format_view(@fields,$hostname, + } + 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, + } + elsif ($viewselect eq 'XML/SGML') { + $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost, $extrashow2); - } + } - } + } + untie %hash; + } + else { + $r->print('Unable to tie hash to db '. + 'file'); + } if ($compiledresult) { $resultflag=1; } @@ -942,82 +1469,39 @@ END $compiledresult RESULTS my $percent=sprintf('%3.0f',($servercount/$servernum*100)); - $r->print(''); } + } unless ($resultflag) { $r->print("\nThere were no results that matched your query\n"); } - $r->print(''); $r->rflush(); +# $r->print(''."\n"); $r->rflush(); $r->print(< 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; -} +###################################################################### +###################################################################### -# ------------------------------------------------- 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; -} +=pod -# - 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); -} +=item Metadata Viewing Functions + +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. + +=over 4 + +=item &detailed_citation_view() -# ------------------------------------------------------ Detailed Citation View +=cut + +###################################################################### +###################################################################### sub detailed_citation_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, @@ -1029,12 +1513,24 @@ sub detailed_citation_view {

$author

-Subject: $subject
-Keyword(s): $keywords
-Notes: $notes
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
-Copyright/Distribution: $cprtag{$copyright}
+Subject: $subject
+Keyword(s): $keywords
+Notes: $notes
+MIME Type: +END + $result.=&Apache::loncommon::filedescription($mime); + $result.=< +Language: +END + $result.=&Apache::loncommon::languagedescription($lang); + $result.=< +Copyright/Distribution: +END + $result.=&Apache::loncommon::copyrightdescription($copyright); + $result.=<

$extrashow

@@ -1044,29 +1540,53 @@ END return $result; } -# ---------------------------------------------------------------- Summary View +###################################################################### +###################################################################### + +=pod + +=item &summary_view() + +=cut + +###################################################################### +###################################################################### sub summary_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); my $result=<$author
$title
$owner -- $lastrevisiondate
-$cprtag{$copyright}
+$cprtag
$extrashow

END return $result; } -# -------------------------------------------------------------- Fielded Format +###################################################################### +###################################################################### + +=pod + +=item &fielded_format_view() + +=cut + +###################################################################### +###################################################################### sub fielded_format_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $mimetag=&Apache::loncommon::filedescription($mime); + my $language=&Apache::loncommon::languagedescription($lang); + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); my $result=<URL: $url
@@ -1075,12 +1595,12 @@ sub fielded_format_view { Subject: $subject
Keyword(s): $keywords
Notes: $notes
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
+MIME Type: $mimetag
+Language: $language
Creation Date: $creationdate
Last Revision Date: $lastrevisiondate
Publisher/Owner: $owner
-Copyright/Distribution: $cprtag{$copyright}
+Copyright/Distribution: $cprtag
Repository Location: $hostname
Abstract: $shortabstract
$extrashow @@ -1089,12 +1609,27 @@ END return $result; } -# -------------------------------------------------------------------- XML/SGML +###################################################################### +###################################################################### + +=pod + +=item &xml_sgml_view() + +=back + +=cut + +###################################################################### +###################################################################### sub xml_sgml_view { my ($title,$author,$subject,$url,$keywords,$version, $notes,$shortabstract,$mime,$lang, $creationdate,$lastrevisiondate,$owner,$copyright, $hostname,$httphost,$extrashow)=@_; + my $cprtag=&Apache::loncommon::copyrightdescription($copyright); + my $mimetag=&Apache::loncommon::filedescription($mime); + my $language=&Apache::loncommon::languagedescription($lang); my $result=< <LonCapaResource> @@ -1106,18 +1641,18 @@ 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> @@ -1128,56 +1663,40 @@ 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; +###################################################################### +###################################################################### + +=pod + +=item &filled() see if field is filled. + +=cut + +###################################################################### +###################################################################### +sub filled { + my ($field)=@_; + if ($field=~/\S/ && $field ne 'any') { + return 1; } - if (@queries) { - return join(" AND ",@queries); + else { + return 0; } - return ''; } -sub output_date_error { - my ($r,$message)=@_; +###################################################################### +###################################################################### + +=pod + +=item &output_blank_field_error() + +=cut + +###################################################################### +###################################################################### +sub output_blank_field_error { + my ($r)=@_; # make query information persistent to allow for subsequent revision my $persistent=&make_persistent(); @@ -1189,14 +1708,58 @@ BEGINNING $r->print(< - +

Search Catalog

$persistent +onClick='this.form.submit();' /> $closebutton -
+
+

Helpful Message

+

+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 + +$closebutton +

Helpful Message

$message @@ -1206,21 +1769,275 @@ $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 +###################################################################### +###################################################################### + +=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{$_}; } - } (keys %ENV); - return $persistent; + 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() + +=cut + +###################################################################### +###################################################################### +sub popwin_imgupdate { + my ($r,$imgnum,$icon) = @_; + &popwin_js($r,'popwin.document.img'.$imgnum.'.'. + 'src="/adm/lonIcons/'.$icon.'";'); +} + 1; + __END__ + +=pod + +=back + +=over 4 + +=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) : + + +=back + +=cut