--- loncom/interface/lonsearchcat.pm 2001/03/15 18:49:45 1.19 +++ loncom/interface/lonsearchcat.pm 2001/03/22 14:13:53 1.72 @@ -2,7 +2,41 @@ # 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; @@ -10,12 +44,30 @@ 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=< + + + + + +END +my $advancedviewselect=< + + + + + +END sub handler { my $r = shift; @@ -41,6 +93,10 @@ sub handler { END + $closebutton=< +END + # ------------------------------------------------ First, check out environment $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; @@ -51,7 +107,7 @@ END { my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab'); map { - $_=~/(\w+)\s+([\w\s\-]+)/; + $_=~/(\w+)\s+([\w\s\-]+)/; chomp; $language{$1}=$2; } <$fh>; } @@ -61,7 +117,7 @@ END { my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab'); map { - $_=~/(\w+)\s+([\w\s\-]+)/; + $_=~/(\w+)\s+([\w\s\-]+)/; chomp; $cprtag{$1}=$2; } <$fh>; } @@ -71,7 +127,7 @@ END { my $fh=Apache::File->new($r->dir_config('lonTabDir').'/filetypes.tab'); map { - $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; + $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; chomp; $mimetag{$1}=".$1 $3"; } <$fh>; } @@ -211,17 +267,19 @@ ENDDOCUMENT $r->print(<Search historic archives
- - - + + +$closebutton +$basicviewselect

Advanced Search

$scrout

- - - + + +$closebutton +$advancedviewselect

@@ -232,22 +290,17 @@ ENDDOCUMENT # --------------------------------------------------------- Various form fields -sub textfield { - my ($title,$name,$value)=@_; - return "\n

$title:
". - ''; -} - sub simpletextfield { my ($name,$value)=@_; - return ''; + return ''; } sub simplecheckbox { my ($name,$value)=@_; my $checked=''; $checked="CHECKED" if $value eq 'on'; - return ''; + return ''; } sub searchphrasefield { @@ -259,7 +312,7 @@ END my $uctitle=uc($title); return "\n

$uctitle:". " $instruction
". - ''; + ''; } sub dateboxes { @@ -412,18 +465,111 @@ sub selectbox { my $selout="\n

$uctitle:". "
".''; } -# ------------------------------------------------ Performing a advanced search +# ----------------------------------------------- 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 @@ -431,17 +577,66 @@ sub basicsearch { my ($r,$envhash)=@_; my %ENV=%{$envhash}; - my $query=$ENV{'form.basicexp'}; - $query="select * from metadata where concat(title,\" \",author) like '\%$ENV{'form.basicexp'}\%'"; + # 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($r,$envhash,$reply); + &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

+
+$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 +} + # ----------------------------- format and output results based on a reply list sub output_results { - my ($r,$envhash,@replylist)=@_; + my ($mode,$r,$envhash,$query,@replylist)=@_; my %ENV=%{$envhash}; + my $compiledresult=''; + foreach my $reply (@replylist) { my @results; @@ -451,7 +646,7 @@ sub output_results { $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; $reply=~/(.*?)\_/; my $hostname=$1; - + sleep 3; # temporary fix, need to check for completion and status { while (1) { last if -e $replyfile; @@ -464,15 +659,16 @@ sub output_results { @results=<$fh>; } - my $compiledresult=''; - foreach my $result (@results) { + my @fields=map + {&Apache::lonnet::unescape($_)} + (split(/\,/,$result)); my ($title,$author,$subject,$url,$keywords,$version, $notes,$abstract,$mime,$lang, - $creationdate,$lastrevisiondate,$owner,$copyright - )=map {&Apache::lonnet::unescape($_)} (split(/\,/,$result)); + $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; my $shortabstract=$abstract; $shortabstract=substr($abstract,0,200) if length($abstract)>200; + $fields[7]=$shortabstract; $compiledresult.=< END @@ -482,24 +678,31 @@ onClick="javascript:select_data('$title'
END - $compiledresult.=<URL: $url -
-Title: $title
-Author(s): $author
-Subject: $subject
-Keyword(s): $keywords
-Notes: $notes
-Abstract: $shortabstract
-MIME Type: $mimetag{$mime}
-Language: $language{$lang}
-Creation Date: $creationdate
-Last Revision Date: $lastrevisiondate
-Publisher/Owner: $owner
-Copyright/Distribution: $copyright
-Repository Location: $hostname -

-END + my $httphost=$ENV{'HTTP_HOST'}; + + 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, + $hostname,$httphost); + } + elsif ($viewselect eq 'Summary View') { + $compiledresult.=&summary_view(@fields,$hostname,$httphost); + } + elsif ($viewselect eq 'Fielded Format') { + $compiledresult.=&fielded_format_view(@fields,$hostname, + $httphost); + } + elsif ($viewselect eq 'XML/SGML') { + $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost); + } + } unless ($compiledresult) { @@ -507,17 +710,7 @@ END } # make query information persistent to allow for subsequent revision - my $persistent=''; - map { - if (/^form\./ && !/submit/) { - my $name=$_; - my $key=$name; - $name=~s/^form\.//; - $persistent.=< -END - } - } (keys %ENV); + my $persistent=&make_persistent(); $r->print(< @@ -550,14 +743,27 @@ SCRIPT - +$closebutton $persistent

Search Query

+RESULTS + if ($mode eq 'Basic') { + $r->print(< Basic search: $ENV{'form.basicexp'}

+RESULTS + } + elsif ($mode eq 'Advanced') { + $r->print(< +Advanced search +$query +

+RESULTS + } + $r->print(<Search Results $compiledresult @@ -566,5 +772,259 @@ 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 + my $oldmatchexp=$matchexp; +# $matchexp=~s/\(\?\:([^\)]*)\\\=([^\)]*)\)/\(\?\:\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>)/g; + return $oldmatchexp; +} + +# - 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 +

$title

+

$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; + $ENV{$key}=~s/\'//g; # do not mess with html field syntax + $name=~s/^form\.//; + $persistent.=< +END + } + } (keys %ENV); + return $persistent; +} 1; __END__