--- loncom/interface/lonsearchcat.pm 2001/03/08 13:32:04 1.2
+++ loncom/interface/lonsearchcat.pm 2001/03/22 13:40:07 1.68
@@ -2,18 +2,243 @@
# Search Catalog
#
# 03/08/2001 Scott Harrison
+# Scott Harrison: 03/12/2001, 03/13/2001, 03/14/2001, 03/15/2001, 03/19/2001
+# Scott Harrison: 03/20/2001
#
+# Functions
+#
+# 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
+
package Apache::lonsearchcat;
use strict;
use Apache::Constants qw(:common);
+use Apache::lonnet();
+use Apache::File();
+use CGI qw(:standard);
+use Text::Query;
+
+my %language;
+my $scrout;
+my %metadatafields;
+my %cprtag;
+my %mimetag;
+my $closebutton;
+my $basicviewselect=<
+Detailed Citation View
+Summary View
+Fielded Format
+XML/SGML
+
+END
+my $advancedviewselect=<
+Detailed Citation View
+Summary View
+Fielded Format
+XML/SGML
+
+END
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'}));
+
$r->content_type('text/html');
$r->send_http_header;
return OK if $r->header_only;
+ %metadatafields=();
+
+ my $hidden='';
+ $hidden=<
+END
+
+ $closebutton=<
+END
+
+# ------------------------------------------------ First, check out environment
+ $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
+
+# --------------------------------- Compute various listings of metadata values
+
+ %language=();
+ $language{'any'}='Any language';
+ {
+ my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
+ map {
+ $_=~/(\w+)\s+([\w\s\-]+)/; chomp;
+ $language{$1}=$2;
+ } <$fh>;
+ }
+
+ %cprtag=();
+ $cprtag{'any'}='Any copyright/distribution';
+ {
+ my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
+ map {
+ $_=~/(\w+)\s+([\w\s\-]+)/; chomp;
+ $cprtag{$1}=$2;
+ } <$fh>;
+ }
+
+ %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>;
+ }
+
+ if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
+ return &basicsearch($r,\%ENV);
+ }
+ elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
+ return &advancedsearch($r,\%ENV);
+ }
+
+ $scrout=''; # building a part of screen output
+ $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'});
+ $scrout.=&selectbox('Limit by MIME type','mime',
+ $ENV{'form.mime'},%mimetag);
+
+ $ENV{'form.language'}='any' unless length($ENV{'form.language'});
+
+ $scrout.=&selectbox('Limit by language','language',
+ $ENV{'form.language'},%language);
+
+
+# ------------------------------------------------ Compute date selection boxes
+ $scrout.=<
+LIMIT BY CREATION DATE RANGE:
+
+
+between:
+CREATIONDATESTART
+ $scrout.=&dateboxes('creationdatestart',1,1,1976,
+ $ENV{'form.creationdatestart_month'},
+ $ENV{'form.creationdatestart_day'},
+ $ENV{'form.creationdatestart_year'},
+ );
+ $scrout.=<";
+
+ $scrout.=<
+LIMIT BY LAST REVISION DATE RANGE:
+
+ between:
+LASTREVISIONDATESTART
+ $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
+ $ENV{'form.lastrevisiondatestart_month'},
+ $ENV{'form.lastrevisiondatestart_day'},
+ $ENV{'form.lastrevisiondatestart_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);
+
+# ------------------------------------------- Compute customized metadata field
+ $scrout.=<
+LIMIT BY OTHER METADATA FIELDS:
+
+For author-specific metadata, enter in an expression in the form of
+key =value separated by operators such as AND or OR.
+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 ';
+
# ---------------------------------------------------------------- Print screen
$r->print(<
@@ -21,44 +246,781 @@ sub handler {
The LearningOnline Network with CAPA
+
Search Catalog
-
ENDDOCUMENT
return OK;
}
+# --------------------------------------------------------- Various form fields
+
+sub simpletextfield {
+ my ($name,$value)=@_;
+ return ' ';
+}
+
+sub simplecheckbox {
+ my ($name,$value)=@_;
+ my $checked='';
+ $checked="CHECKED" if $value eq 'on';
+ return ' ';
+}
+
+sub searchphrasefield {
+ my ($title,$name,$value)=@_;
+ my $instruction=<$uctitle: ".
+ " $instruction ".
+ ' ';
+}
+
+sub dateboxes {
+ my ($name,$defaultmonth,$defaultday,$defaultyear,
+ $currentmonth,$currentday,$currentyear)=@_;
+ ($defaultmonth,$defaultday,$defaultyear)=('','','');
+ my $month=<
+
+January
+February
+March
+April
+May
+June
+July
+August
+September
+October
+November
+December
+
+END
+ $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
+ my $day=<
+
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+12
+13
+14
+15
+16
+17
+18
+19
+20
+21
+22
+23
+24
+25
+26
+27
+28
+29
+30
+31
+
+END
+ $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
+ my $year=<
+
+1976
+1977
+1978
+1979
+1980
+1981
+1982
+1983
+1984
+1985
+1986
+1987
+1988
+1989
+1990
+1991
+1992
+1993
+1994
+1995
+1996
+1997
+1998
+1999
+2000
+2001
+2002
+2003
+2004
+2005
+2006
+2007
+2008
+2009
+2010
+2011
+2012
+2013
+2014
+2015
+2016
+2017
+2018
+2019
+2020
+2021
+2022
+2023
+2024
+2025
+2026
+2027
+2028
+2029
+2030
+2031
+2032
+2033
+2034
+2035
+2036
+2037
+2038
+2039
+2040
+2041
+2042
+2043
+2044
+2045
+2046
+2047
+2048
+2049
+2050
+2051
+
+END
+ $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
+ return "$month$day$year";
+}
+
+sub selectbox {
+ my ($title,$name,$value,%options)=@_;
+ my $uctitle=uc($title);
+ my $selout="\n$uctitle:".
+ " ".'';
+ map {
+ $selout.=''.$options{$_}.' ';
+ } sort keys %options;
+ return $selout.' ';
+}
+
+# ----------------------------------------------- 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') {
+ $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g;
+ }
+ 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;
+ }
+
+ my $query='';
+
+ my @queries;
+ # Go through 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});
+ }
+ }
+ 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'}\%\")";
+ }
+ 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'},
+ );
+ if ($datequery=~/^Incorrect/) {
+ &output_date_error($r,$datequery);
+ return OK;
+ }
+ elsif ($datequery) {
+ push @queries,$datequery;
+ }
+ my $customquery;
+ if ($ENV{'form.custommetadata'}) {
+ $customquery=&build_custommetadata_query('custommetadata',
+ $ENV{'form.custommetadata'});
+ }
+ if (@queries) {
+ $query=join(" AND ",@queries);
+ $query="select * from metadata where $query";
+ my $reply=&Apache::lonnet::metadata_query($query);
+ &output_results('Advanced',$r,$envhash,$customquery,$reply);
+ }
+ else {
+ &output_results('Advanced',$r,$envhash,$query);
+ }
+ return OK;
+}
+
+# ---------------------------------------------------- see if a field is filled
+sub filled {
+ my ($field)=@_;
+ if ($field=~/\S/) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+# --------------------------------------------------- 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;
+ }
+
+ unless (&filled($ENV{'form.basicexp'})) {
+ &output_blank_field_error($r);
+ return OK;
+ }
+
+ my $query='';
+ my $concatarg=join('," ",',
+ ('title', 'author', 'subject', 'notes', 'abstract'));
+
+ $query="select * from metadata where concat($concatarg) like '\%$ENV{'form.basicexp'}\%'";
+ my $reply=&Apache::lonnet::metadata_query($query);
+ &output_results('Basic',$r,$envhash,$query,$reply);
+ return OK;
+}
+
+# ---------------- Message to output when there are not enough fields filled in
+sub output_blank_field_error {
+ my ($r)=@_;
+ # make query information persistent to allow for subsequent revision
+ my $persistent=&make_persistent();
+
+ $r->print(<
+
+The LearningOnline Network with CAPA
+BEGINNING
+ $r->print(<
+
+
+Search Catalog
+
+RESULTS
+ }
+ elsif ($mode eq 'Advanced') {
+ $r->print(<
+Advanced search
+$query
+
+RESULTS
+ }
+ $r->print(<Search Results
+$compiledresult
+
+
+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'};
+ 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 '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);
+}
+
+# ------------------------------------------------------ Detailed Citation View
+sub detailed_citation_view {
+ my ($title,$author,$subject,$url,$keywords,$version,
+ $notes,$shortabstract,$mime,$lang,
+ $creationdate,$lastrevisiondate,$owner,$copyright,
+ $hostname,$httphost)=@_;
+ my $result=<$owner, last revised $lastrevisiondate
+
+$author
+
+
+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)=@_;
+ my $result=<$author
+$title
+$owner -- $lastrevisiondate
+$cprtag{$copyright}
+
+END
+ return $result;
+}
+
+# -------------------------------------------------------------- Fielded Format
+sub fielded_format_view {
+ my ($title,$author,$subject,$url,$keywords,$version,
+ $notes,$shortabstract,$mime,$lang,
+ $creationdate,$lastrevisiondate,$owner,$copyright,
+ $hostname,$httphost)=@_;
+ my $result=<URL: $url
+
+Title: $title
+Author(s): $author
+Subject: $subject
+Keyword(s): $keywords
+Notes: $notes
+MIME Type: $mimetag{$mime}
+Language: $language{$lang}
+Creation Date: $creationdate
+Last Revision Date: $lastrevisiondate
+Publisher/Owner: $owner
+Copyright/Distribution: $cprtag{$copyright}
+Repository Location: $hostname
+Abstract: $shortabstract
+
+END
+ return $result;
+}
+
+# -------------------------------------------------------------------- XML/SGML
+sub xml_sgml_view {
+ my ($title,$author,$subject,$url,$keywords,$version,
+ $notes,$shortabstract,$mime,$lang,
+ $creationdate,$lastrevisiondate,$owner,$copyright,
+ $hostname,$httphost)=@_;
+ my $result=<
+<LonCapaResource>
+<url>$url</url>
+<title>$title</title>
+<author>$author</author>
+<subject>$subject</subject>
+<keywords>$keywords</keywords>
+<notes>$notes</notes>
+<mimeInfo>
+<mime>$mime</mime>
+<mimetag>$mimetag{$mime}</mimetag>
+</mimeInfo>
+<languageInfo>
+<language>$lang</language>
+<languagetag>$language{$lang}</languagetag>
+</languageInfo>
+<creationdate>$creationdate</creationdate>
+<lastrevisiondate>$lastrevisiondate</lastrevisiondate>
+<owner>$owner</owner>
+<copyrightInfo>
+<copyright>$copyright</copyright>
+<copyrighttag>$cprtag{$copyright}</copyrighttag>
+</copyrightInfo>
+<repositoryLocation>$hostname</repositoryLocation>
+<shortabstract>$shortabstract</shortabstract>
+</LonCapaResource>
+
+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;
+ }
+ if (@queries) {
+ return join(" AND ",@queries);
+ }
+ return '';
+}
+
+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
+BEGINNING
+ $r->print(<
+
+
+Search Catalog
+
+$persistent
+
+$closebutton
+
+Helpful Message
+
+$message
+
+
+
+RESULTS
+}
+
+sub make_persistent {
+ my $persistent='';
+
+ map {
+ if (/^form\./ && !/submit/) {
+ my $name=$_;
+ my $key=$name;
+ $name=~s/^form\.//;
+ $persistent.=<
+END
+ }
+ } (keys %ENV);
+ return $persistent;
+}
1;
__END__