--- loncom/interface/lonsearchcat.pm 2001/03/08 16:45:22 1.3 +++ loncom/interface/lonsearchcat.pm 2001/03/22 13:22:36 1.65 @@ -2,36 +2,112 @@ # 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=< + + + + + +END +my $advancedviewselect=< + + + + + +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\-]+)/; + $_=~/(\w+)\s+([\w\s\-]+)/; chomp; $language{$1}=$2; } <$fh>; } @@ -41,7 +117,7 @@ sub handler { { 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>; } @@ -51,565 +127,117 @@ sub handler { { 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>; } - $scrout=""; + 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', - 'notxxx',%mimetag); + $ENV{'form.mime'},%mimetag); + + $ENV{'form.language'}='any' unless length($ENV{'form.language'}); $scrout.=&selectbox('Limit by language','language', - 'any',%language); + $ENV{'form.language'},%language); - $scrout.=< LIMIT BY CREATION DATE RANGE:
-between: - - -and: - - -

+between: +CREATIONDATESTART + $scrout.=&dateboxes('creationdatestart',1,1,1976, + $ENV{'form.creationdatestart_month'}, + $ENV{'form.creationdatestart_day'}, + $ENV{'form.creationdatestart_year'}, + ); + $scrout.=< LIMIT BY LAST REVISION DATE RANGE: -
between: - - -and: - - -

+
between: +LASTREVISIONDATESTART + $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, + $ENV{'form.lastrevisiondatestart_month'}, + $ENV{'form.lastrevisiondatestart_day'}, + $ENV{'form.lastrevisiondatestart_year'}, + ); + $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(<The LearningOnline Network with CAPA +

Search Catalog

+$hidden

Basic Search

@@ -628,17 +258,28 @@ such as AND or OR then press SEARCH belo to the title, author, subject, notes, or abstract information associated with a resource.
- - -Title only +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'})); + $r->print(<Search historic archives
+ +$closebutton +$basicviewselect

Advanced Search

$scrout

+ +$closebutton +$advancedviewselect

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

$title:
". - ''; +sub simpletextfield { + my ($name,$value)=@_; + return ''; +} + +sub simplecheckbox { + my ($name,$value)=@_; + my $checked=''; + $checked="CHECKED" if $value eq 'on'; + return ''; } sub searchphrasefield { @@ -663,10 +310,154 @@ as AND or OR. END my $uctitle=uc($title); return "\n

$uctitle:". - ": $instruction
". + " $instruction
". ''; } +sub dateboxes { + my ($name,$defaultmonth,$defaultday,$defaultyear, + $currentmonth,$currentday,$currentyear)=@_; + ($defaultmonth,$defaultday,$defaultyear)=('','',''); + my $month=< + + + + + + + + + + + + + + +END + $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); + my $day=< + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +END + $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); + my $year=< + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +END + $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); + return "$month$day$year"; +} + sub selectbox { my ($title,$name,$value,%options)=@_; my $uctitle=uc($title); @@ -680,5 +471,555 @@ sub selectbox { 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

+
+$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 ($mode,$r,$envhash,$query,@replylist)=@_; + my %ENV=%{$envhash}; + my $compiledresult=''; + + foreach my $reply (@replylist) { + + my @results; + + my $replyfile=''; + $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting + $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; + sleep 1; + } + # 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('file cannot be opened') and return OK); + @results=<$fh>; + } + + 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)=@fields; + my $shortabstract=$abstract; + $shortabstract=substr($abstract,0,200) if length($abstract)>200; + $fields[7]=$shortabstract; + $compiledresult.=< +END + $compiledresult.=< + +
+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) { + $compiledresult="There were no results that matched your query"; + } + + # make query information persistent to allow for subsequent revision + my $persistent=&make_persistent(); + + $r->print(< + +The LearningOnline Network with CAPA +BEGINNING + $r->print(< + function select_data(title,url) { + changeTitle(title); + changeURL(url); + } + function changeTitle(val) { + if (opener.inf.document.forms.resinfo.elements.t) { + opener.inf.document.forms.resinfo.elements.t.value=val; + } + } + function changeURL(val) { + if (opener.inf.document.forms.resinfo.elements.u) { + opener.inf.document.forms.resinfo.elements.u.value=val; + } + } + +SCRIPT + $r->print(< + + +

Search Catalog

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

$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/) { + $ENV{$key}=~s/\"/\\\"/g; + my $name=$_; + my $key=$name; + $name=~s/^form\.//; + $persistent.=< +END + } + } (keys %ENV); + return $persistent; +} 1; __END__