--- loncom/interface/lonsearchcat.pm 2001/03/21 01:19:37 1.49 +++ loncom/interface/lonsearchcat.pm 2001/04/16 17:11:57 1.95 @@ -3,7 +3,8 @@ # # 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 +# Scott Harrison: 03/20/2001, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001 +# Scott Harrison: 04/02/2001 # # Functions # @@ -36,6 +37,21 @@ # 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 package Apache::lonsearchcat; @@ -46,19 +62,37 @@ use Apache::File(); use CGI qw(:standard); use Text::Query; +# ---------------------------------------- variables used throughout the module my %language; my $scrout; my %metadatafields; my %cprtag; my %mimetag; my $closebutton; -my $viewselect=< - - + +# ------ form selection elements that allow for choosing different output views +# Detailed Citation View ---> sub detailed_citationview +# 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 sub handler { my $r = shift; @@ -79,13 +113,14 @@ sub handler { %metadatafields=(); my $hidden=''; - $hidden=< END - - $closebutton=< + $closebutton=< END + } # ------------------------------------------------ First, check out environment $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; @@ -97,7 +132,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>; } @@ -107,7 +142,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>; } @@ -117,11 +152,12 @@ 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>; } +# ----------------------------------- See if a search invocation should be done if ($ENV{'form.basicsubmit'} eq 'SEARCH') { return &basicsearch($r,\%ENV); } @@ -129,6 +165,7 @@ END return &advancedsearch($r,\%ENV); } +# ----------------------------- Else, begin building search interface to output $scrout=''; # building a part of screen output $scrout.=&searchphrasefield('Limit by title','title', $ENV{'form.title'}); @@ -219,9 +256,9 @@ LASTREVISIONDATEEND # ------------------------------------------- Compute customized metadata field $scrout.=< -LIMIT BY OTHER METADATA FIELDS: +LIMIT BY SPECIAL METADATA FIELDS: -For author-specific metadata, enter in an expression in the form of +For resource-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
@@ -229,6 +266,17 @@ CUSTOMMETADATA $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); $scrout.=' initial users of this system do not need to worry about this option'; + $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(< @@ -257,19 +305,19 @@ ENDDOCUMENT $r->print(<Search historic archives
- - + + $closebutton -$viewselect +$basicviewselect

Advanced Search

$scrout

- - + + $closebutton -$viewselect +$advancedviewselect

@@ -282,14 +330,15 @@ ENDDOCUMENT sub simpletextfield { my ($name,$value)=@_; - return ''; + return ''; } sub simplecheckbox { my ($name,$value)=@_; my $checked=''; $checked="CHECKED" if $value eq 'on'; - return ''; + return ''; } sub searchphrasefield { @@ -301,7 +350,7 @@ END my $uctitle=uc($title); return "\n

$uctitle:". " $instruction
". - ''; + ''; } sub dateboxes { @@ -454,7 +503,7 @@ sub selectbox { my $selout="\n

$uctitle:". "
".' - -
-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 - } - - unless ($compiledresult) { - $compiledresult="There were no results that matched your query"; - } - - # 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); + # make query information persistent to allow for subsequent revision + my $persistent=&make_persistent(); + # output beginning of search page $r->print(< @@ -680,11 +743,13 @@ BEGINNING } SCRIPT - $r->print(<print(<

Search Catalog

+CATALOGBEGIN + $r->print(< @@ -708,13 +773,185 @@ $query

RESULTS } + $r->print('

Search Results

'); + $r->rflush(); + $r->print(< + popwin=open('','popwin','width=400,height=200'); + popwin.document.writeln(''+ + '

Search Results Progress

'+ + '
'+ + '
Server space '+ + '
Status '+ + '
Maximum remaining time '+ + '
'+ + ''); + popwin.document.close(); + +ENDPOP + $r->rflush(); + + my $servernum=(keys %rhash)+0; + $r->print(''); + $r->rflush(); + my $servercount=0; + foreach my $rkey (keys %rhash) { + $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(''); + } + 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 $customshow=''; + my $extrashow=''; + my @customfields; + if ($ENV{'form.customshow'}) { + $customshow=$ENV{'form.customshow'}; + $customshow=~s/[^\w\s]//g; + my @fields=map {"$_:"} + split(/\s+/,$customshow); + @customfields=split(/\s+/,$customshow); + if ($customshow) { + $extrashow="
  • ".join("
  • ",@fields)."
\n"; + } + } + my $customdata=''; + my %customhash; + foreach my $result (@results) { + if ($result=~/^(custom\=.*)$/) { # grab all custom metadata + my $tmp=$result; + $tmp=~s/^custom\=//; + my ($k,$v)=map {&Apache::lonnet::unescape($_); + } split(/\,/,$tmp); + $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; + } + } + + $compiledresult.=< +END + $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, + $extrashow2); + } + elsif ($viewselect eq 'Summary View') { + $compiledresult.=&summary_view(@fields,$hostname,$httphost, + $extrashow2); + } + 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, + $extrashow2); + } + + } + + if ($compiledresult) { + $resultflag=1; + } + $r->print(<Search Results $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(< RESULTS - } } # ------------------------------------------------------------- build_SQL_query @@ -729,6 +966,21 @@ sub build_SQL_query { return $sql_query; } +# ------------------------------------------------- build custom metadata query +sub build_custommetadata_query { + my ($field_name,$logic_statement)=@_; + my $q=new Text::Query('abc', + -parse => 'Text::Query::ParseAdvanced', + -build => 'Text::Query::BuildAdvancedString'); + $q->prepare($logic_statement); + my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; + # quick fix to change literal into xml tag-matching + # will eventually have to write a separate builder module + my $oldmatchexp=$matchexp; + $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g; + return $matchexp; +} + # - Recursively parse a reverse notation expression into a SQL query expression sub recursive_SQL_query_build { my ($dkey,$pattern)=@_; @@ -741,6 +993,11 @@ sub recursive_SQL_query_build { 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)"; @@ -758,5 +1015,210 @@ sub recursive_SQL_query_build { &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,$extrashow)=@_; + 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}
+

+$extrashow +

+$shortabstract +

+END + return $result; +} + +# ---------------------------------------------------------------- Summary View +sub summary_view { + my ($title,$author,$subject,$url,$keywords,$version, + $notes,$shortabstract,$mime,$lang, + $creationdate,$lastrevisiondate,$owner,$copyright, + $hostname,$httphost,$extrashow)=@_; + my $result=<$author
+$title
+$owner -- $lastrevisiondate
+$cprtag{$copyright}
+$extrashow +

+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,$extrashow)=@_; + 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
+$extrashow +

+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,$extrashow)=@_; + 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> + +$extrashow +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__