--- loncom/interface/lonsearchcat.pm 2004/05/10 13:06:29 1.226 +++ loncom/interface/lonsearchcat.pm 2005/04/01 19:57:23 1.242 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.226 2004/05/10 13:06:29 matthew Exp $ +# $Id: lonsearchcat.pm,v 1.242 2005/04/01 19:57:23 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -75,6 +75,8 @@ use Apache::lonhtmlcommon; use Apache::lonlocal; use LONCAPA::lonmetadata(); use HTML::Entities(); +use Parse::RecDescent; +use Apache::lonnavmaps; ###################################################################### ###################################################################### @@ -174,6 +176,7 @@ sub handler { '&launch='.$ENV{'form.launch'}. '&mode='.$ENV{'form.mode'}, text=>"Course and Catalog Search", + target=>'_top', bug=>'Searching',}); } else { &Apache::lonhtmlcommon::add_breadcrumb @@ -182,6 +185,7 @@ sub handler { '&launch='.$ENV{'form.launch'}. '&mode='.$ENV{'form.mode'}, text=>"Catalog Search", + target=>'_top', bug=>'Searching',}); } # @@ -191,9 +195,11 @@ sub handler { &Apache::lonnet::logthis('lonsearchcat:'. 'Unable to recover data from '. $persistent_db_file); - $r->print(< -LON-CAPA Search Error + my $html=&Apache::lonxml::xmlbegin(); + $r->print(< +LON-CAPA Search Error $bodytag We were unable to retrieve data describing your search. This is a serious error and has been logged. Please alert your LON-CAPA administrator. @@ -220,7 +226,8 @@ END } else { # This is a stupid error to give to the user. # It really tells them nothing. - $r->print(''.$bodytag. + my $html=&Apache::lonxml::xmlbegin(); + $r->print($html.''.$bodytag. 'Unable to tie hash to db file'); return OK; } @@ -335,14 +342,40 @@ END &course_search($r); } elsif(($ENV{'form.phase'} eq 'basic_search') || ($ENV{'form.phase'} eq 'adv_search')) { + # + # We are running a search, try to parse it + my ($query,$customquery,$customshow,$libraries) = + (undef,undef,undef,undef); + my $pretty_string; + if ($ENV{'form.phase'} eq 'basic_search') { + ($query,$pretty_string,$libraries) = + &parse_basic_search($r,$closebutton,$hidden_fields); + return OK if (! defined($query)); + &make_persistent({ basicexp => $ENV{'form.basicexp'}}, + $persistent_db_file); + } else { # Advanced search + ($query,$customquery,$customshow,$libraries,$pretty_string) + = &parse_advanced_search($r,$closebutton,$hidden_fields); + return OK if (! defined($query)); + } + &make_persistent({ query => $query, + customquery => $customquery, + customshow => $customshow, + libraries => $libraries, + pretty_string => $pretty_string }, + $persistent_db_file); + # # Set up table if (! defined(&create_results_table())) { my $errorstring=&Apache::lonmysql::get_error(); &Apache::lonnet::logthis('lonsearchcat.pm: Unable to create '. 'needed table. lonmysql error:'. $errorstring); + my $html=&Apache::lonxml::xmlbegin(); $r->print(<Search Error +$html + +Search Error $bodytag Unable to create table in which to store search results. The search has been aborted. @@ -353,8 +386,11 @@ END } delete($ENV{'form.launch'}); if (! &make_form_data_persistent($r,$persistent_db_file)) { - $r->print(<Search Error + my $html=&Apache::lonxml::xmlbegin(); + $r->print(< +Search Error $bodytag Unable to properly store search information. The search has been aborted. @@ -362,29 +398,12 @@ Unable to properly store search informat END return OK; } - # - # We are running a search - my ($query,$customquery,$customshow,$libraries) = - (undef,undef,undef,undef); - my $pretty_string; - if ($ENV{'form.phase'} eq 'basic_search') { - ($query,$pretty_string,$libraries) = - &parse_basic_search($r,$closebutton,$hidden_fields); - } else { # Advanced search - ($query,$customquery,$customshow,$libraries,$pretty_string) - = &parse_advanced_search($r,$closebutton,$hidden_fields); - return OK if (! defined($query)); - } - &make_persistent({ query => $query, - customquery => $customquery, - customshow => $customshow, - libraries => $libraries, - pretty_string => $pretty_string }, - $persistent_db_file); ## ## Print out the frames interface ## - &print_frames_interface($r); + if (defined($query)) { + &print_frames_interface($r); + } } return OK; } @@ -439,12 +458,22 @@ my %alreadyseen; my %hash; my $totalfound; +sub make_symb { + my ($id)=@_; + my ($mapid,$resid)=split(/\./,$id); + my $map=$hash{'map_id_'.$mapid}; + my $res=$hash{'src_'.$id}; + my $symb=&Apache::lonnet::encode_symb($map,$resid,$res); + return $symb; +} + sub course_search { my $r=shift; my $bodytag=&Apache::loncommon::bodytag('Course Search'); my $pretty_search_string = ''.$ENV{'form.courseexp'}.''; my $search_string = $ENV{'form.courseexp'}; my @New_Words; + undef(%alreadyseen); if ($ENV{'form.crsrelated'}) { ($search_string,@New_Words) = &related_version($ENV{'form.courseexp'}); if (@New_Words) { @@ -454,29 +483,108 @@ sub course_search { } } my $fulltext=$ENV{'form.crsfulltext'}; + my $discuss=$ENV{'form.crsdiscuss'}; my @allwords=($search_string,@New_Words); $totalfound=0; - $r->print('LON-CAPA Course Search'. - $bodytag.'
'.$pretty_search_string.'

'); + my $html=&Apache::lonxml::xmlbegin(); + $r->print($html.'LON-CAPA Course Search'. + $bodytag.'
'.$pretty_search_string.'

'.&mt('Course content').':
'); $r->rflush(); # ======================================================= Go through the course - undef %alreadyseen; - %alreadyseen=(); my $c=$r->connection; if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.".db", &GDBM_READER(),0640)) { - foreach (keys %hash) { + foreach (sort(keys(%hash))) { if ($c->aborted()) { last; } - if (($_=~/^src\_(.+)$/) && (!$alreadyseen{$hash{$_}})) { - &checkonthis($r,$hash{$_},0,$hash{'title_'.$1},$fulltext, - @allwords); + if (($_=~/^src\_(.+)$/)) { + if ($hash{'randomout_'.$1} & !$ENV{'request.role.adv'}) { + next; + } + my $symb=&make_symb($1); + &checkonthis($r,$1,$hash{$_},0,&Apache::lonnet::gettitle($symb), + $fulltext,$symb,@allwords); } } untie(%hash); } unless ($totalfound) { - $r->print('

'.&mt('No resources found').'.

'); + $r->print('

'.&mt('No matches found in resources').'.

'); + } + +# Check discussions if requested + if ($discuss) { + my $totaldiscussions = 0; + $r->print('

'.&mt('Discussion postings').':
'); + my $navmap = Apache::lonnavmaps::navmap->new(); + my @allres=$navmap->retrieveResources(); + my %discussiontime = &Apache::lonnet::dump('discussiontimes', + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + foreach my $resource (@allres) { + my $result = ''; + my $applies = 0; + my $symb = $resource->symb(); + my $ressymb = $symb; + if ($symb =~ m#(___adm/\w+/\w+)/(\d+)/bulletinboard$#) { + $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard'; + unless ($ressymb =~ m#bulletin___\d+___adm/wrapper#) { + $ressymb=~s#(bulletin___\d+___)#$1adm/wrapper/#; + } + } + if (defined($discussiontime{$ressymb})) { + my %contrib = &Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + if ($contrib{'version'}) { + for (my $id=1;$id<=$contrib{'version'};$id++) { + unless (($contrib{'hidden'}=~/\.$id\./) || ($contrib{'deleted'}=~/\.$id\./)) { + if ($contrib{$id.':subject'}) { + $result .= $contrib{$id.':subject'}; + } + if ($contrib{$id.':message'}) { + $result .= $contrib{$id.':message'}; + } + if ($contrib{$id,':attachmenturl'}) { + if ($contrib{$id,':attachmenturl'} =~ m-/([^/]+)$-) { + $result .= $1; + } + } + $applies = &checkwords($result,$applies,@allwords); + } + } + } + } +# Does this discussion apply? + if ($applies) { + my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ressymb); + my $disctype = &mt('resource'); + if ($url =~ m#/bulletinboard$#) { + if ($url =~m#^adm/wrapper/adm/.*/bulletinboard$#) { + $url =~s#^adm/wrapper##; + } + $disctype = &mt('bulletin board'); + } else { + $url = '/res/'.$url; + } + if ($url =~ /\?/) { + $url .= '&symb='; + } else { + $url .= '?symb='; + } + $url .= &Apache::lonnet::escape($resource->symb()); + my $title = $resource->compTitle(); + $r->print('
'. + ($title?$title:$url).'  - '.$disctype.'
'); + $totaldiscussions++; + } else { + $r->print(' .'); + } + } + unless ($totaldiscussions) { + $r->print('

'.&mt('No matches found in postings').'.

'); + } } + # =================================================== Done going through course $r->print(''); } @@ -484,33 +592,41 @@ sub course_search { # =============================== This pulls up a resource and its dependencies sub checkonthis { - my ($r,$url,$level,$title,$fulltext,@allwords)=@_; - $alreadyseen{$url}=1; + my ($r,$id,$url,$level,$title,$fulltext,$symb,@allwords)=@_; + $alreadyseen{$id}=1; + if (&Apache::loncommon::connection_aborted($r)) { return; } $r->rflush(); - my $result=&Apache::lonnet::metadata($url,'title').' '. - &Apache::lonnet::metadata($url,'subject').' '. - &Apache::lonnet::metadata($url,'abstract').' '. - &Apache::lonnet::metadata($url,'keywords'); - if (($url) && ($fulltext)) { - $result.=&Apache::lonnet::ssi_body($url); + + my $result=$title.' '; + if ($ENV{'request.role.adv'} || !$hash{'encrypted_'.$id}) { + $result.=&Apache::lonnet::metadata($url,'title').' '. + &Apache::lonnet::metadata($url,'subject').' '. + &Apache::lonnet::metadata($url,'abstract').' '. + &Apache::lonnet::metadata($url,'keywords'); + } + my ($extension)=($url=~/\.(\w+)$/); + if (&Apache::loncommon::fileembstyle($extension) eq 'ssi' && + ($url) && ($fulltext)) { + $result.=&Apache::lonnet::ssi_body($url.'?symb='.&Apache::lonnet::escape($symb)); } $result=~s/\s+/ /gs; - my $applies=0; - foreach (@allwords) { - if ($_=~/\w/) { - if ($result=~/$_/si) { - $applies++; - } - } - } + my $applies = 0; + $applies = &checkwords($result,$applies,@allwords); # Does this resource apply? if ($applies) { $r->print('
'); for (my $i=0;$i<=$level*5;$i++) { $r->print(' '); } - $r->print(''. - ($title?$title:$url).'
'); + my $href=$url; + if ($hash{'encrypted_'.$id} && !$ENV{'request.role.adv'}) { + $href=&Apache::lonenc::encrypted($href) + .'?symb='.&Apache::lonenc::encrypted($symb); + } else { + $href.='?symb='.&Apache::lonnet::escape($symb); + } + $r->print(''.($title?$title:$url). + '
'); $totalfound++; } elsif ($fulltext) { $r->print(' .'); @@ -520,12 +636,24 @@ sub checkonthis { my $dependencies= &Apache::lonnet::metadata($url,'dependencies'); foreach (split(/\,/,$dependencies)) { - if (($_=~/^\/res\//) && (!$alreadyseen{$_})) { - &checkonthis($r,$_,$level+1,'',$fulltext,@allwords); + if (($_=~/^\/res\//) && (!$alreadyseen{$id})) { + &checkonthis($r,$id,$_,$level+1,'',$fulltext,undef,@allwords); } } } +sub checkwords { + my ($result,$applies,@allwords) = @_; + foreach (@allwords) { + if ($_=~/\w/) { + if ($result=~/$_/si) { + $applies++; + } + } + } + return $applies; +} + sub untiehash { if (tied(%hash)) { untie(%hash); @@ -535,8 +663,9 @@ sub untiehash { } # End of course search scoping sub search_html_header { + my $html=&Apache::lonxml::xmlbegin(); my $Str = < +$html The LearningOnline Network with CAPA @@ -559,24 +688,26 @@ Prints the form for the basic search. S ###################################################################### sub print_basic_search_form { my ($r,$closebutton,$hidden_fields) = @_; + my $result = ($ENV{'form.catalogmode'} ne 'groupsearch'); my $bodytag=&Apache::loncommon::bodytag('Search'). - &Apache::lonhtmlcommon::breadcrumbs(undef,'Searching','Searching', - undef,undef,! $ENV{'form.launch'}); + &Apache::lonhtmlcommon::breadcrumbs(undef,'Searching','Search_Basic', + undef,undef, + $ENV{'form.catalogmode'} ne 'groupsearch'); my $scrout = &search_html_header().$bodytag; if (&Apache::lonnet::allowed('bre',$ENV{'request.role.domain'})) { # Define interface components - my $userelatedwords= + my $userelatedwords= ''; + my $onlysearchdomain=''; my $adv_search_link = ''. - &Apache::lonhtmlcommon::textbox('basicexp', - $ENV{'form.basicexp'},50).'
'. + &Apache::lonhtmlcommon::textbox + ('basicexp', + &HTML::Entities::encode($ENV{'form.basicexp'},'<>&"'),50 + ). + '
'. ''.&searchhelp().''.''. ''. ''.(' 'x3).$adv_search_link.''.'
'. @@ -609,12 +743,6 @@ sub print_basic_search_form { '
'. ''.$/; # -# $scrout .= ''. -# ''. -# $userelatedwords.(' 'x3). -# $onlysearchdomain.(' 'x2).$adv_search_link. -# ''. -# ''.$/; $scrout .= ''. ''. ' 'Course Search', 'note' => 'Enter terms or phrases, then press "Search" below', 'use' => 'use related words', - 'full' =>'fulltext search (time consuming)' + 'full' =>'fulltext search (time consuming)', + 'disc' => 'search discussion postings (resources and bulletin boards)', ); $scrout.=(< @@ -655,10 +784,14 @@ ENDCOURSESEARCH my $relcheckbox = &Apache::lonhtmlcommon::checkbox('crsrelated', $ENV{'form.crsrelated'}); + my $discheckbox = + &Apache::lonhtmlcommon::checkbox('crsdiscuss', + $ENV{'form.crsrelated'}); $scrout.=(< -$relcheckbox $lt{'use'} -$crscheckbox $lt{'full'} + + +

 

@@ -690,10 +823,9 @@ sub print_advanced_search_form{ my ($r,$closebutton,$hidden_fields) = @_; my $bodytag=&Apache::loncommon::bodytag('Advanced Catalog Search'). &Apache::lonhtmlcommon::breadcrumbs(undef,'Searching', - 'Searching', + 'Search_Advanced', undef,undef, - ! $ENV{'form.launch'}); - + $ENV{'form.catalogmode'} ne 'groupsearch'); my %lt=&Apache::lonlocal::texthash('srch' => 'Search', 'reset' => 'Reset', 'help' => 'Help'); @@ -774,7 +906,7 @@ ENDHEADER $scrout.=''. &titlefield(&mt('Copyright/Distribution')).''. &Apache::lonmeta::selectbox('copyright', - '',, + $ENV{'form.copyright'}, \&Apache::loncommon::copyrightdescription, ( undef, &Apache::loncommon::copyrightids) @@ -782,7 +914,7 @@ ENDHEADER $scrout.=''. &titlefield(&mt('Language')).''. &Apache::lonmeta::selectbox('language', - 'notset',, + $ENV{'form.language'}, \&Apache::loncommon::languagedescription, ('any',&Apache::loncommon::languageids) ).''; @@ -997,7 +1129,7 @@ Outputs: return little blurb on how to e ###################################################################### ###################################################################### sub searchhelp { - return &mt('Enter terms or phrases separated by AND, OR, or NOT'); + return &mt('Enter words and quoted phrases'); } ###################################################################### @@ -1188,13 +1320,13 @@ Parse advanced search form and return th sub parse_advanced_search { my ($r,$closebutton,$hidden_fields)=@_; my @BasicFields = ('title','author','subject','keywords','url','version', - 'notes','abstract','extension','owner', + 'notes','abstract','extension','owner','authorspace', # 'custommetadata','customshow', 'modifyinguser','standards','mime'); my @StatsFields = &statfields(); my @EvalFields = &evalfields(); my $fillflag=0; - my $pretty_search_string = "
\n"; + my $pretty_search_string = ""; # Clean up fields for safety for my $field (@BasicFields, 'creationdatestart_month','creationdatestart_day', @@ -1204,7 +1336,6 @@ sub parse_advanced_search { 'lastrevisiondatestart_year','lastrevisiondateend_month', 'lastrevisiondateend_day','lastrevisiondateend_year') { $ENV{'form.'.$field}=~s/[^\w\/\s\(\)\=\-\"\']//g; - $ENV{'form.'.$field}=~s/(not\s*$|^\s*(and|or)|)//gi; } foreach ('mode','form','element') { # is this required? Hmmm. @@ -1249,21 +1380,29 @@ sub parse_advanced_search { # Evaluate logical expression AND/OR/NOT phrase fields. foreach my $field (@BasicFields) { next if (!defined($ENV{'form.'.$field}) || $ENV{'form.'.$field} eq ''); - foreach my $searchphrase(&process_phrase_input($ENV{'form.'.$field})){ - $pretty_search_string .= $font."$field
contains ". - $searchphrase.""; + my ($error,$SQLQuery) = + &process_phrase_input($ENV{'form.'.$field}, + $ENV{'form.'.$field.'_related'},$field); + if (defined($error)) { + &output_unparsed_phrase_error($r,$closebutton,'phase=disp_adv', + $hidden_fields,$field); + return; + } else { + $pretty_search_string .= + $font.$field.': '.$ENV{'form.'.$field}; if ($ENV{'form.'.$field.'_related'}) { - my @New_Words; - ($searchphrase,@New_Words) = &related_version($searchphrase); - if (@New_Words) { - $pretty_search_string .= " with related words: ". - "@New_Words."; + my @Words = + &Apache::loncommon::get_related_words + ($ENV{'form.'.$field}); + if (@Words) { + $pretty_search_string.= ' with related words: '. + join(', ',@Words[0..4]); } else { - $pretty_search_string .= " with no related words."; + $pretty_search_string.= ' with related words.'; } } - $pretty_search_string .= "
\n"; - push @queries,&build_SQL_query($field,$searchphrase); + $pretty_search_string .= '
'; + push (@queries,$SQLQuery); } } # @@ -1280,7 +1419,8 @@ sub parse_advanced_search { } } if (defined($searchphrase)) { - push @queries,&build_SQL_query('mime',$searchphrase); + my ($error,$SQLsearch) = &process_phrase_input($searchphrase,0,'mime'); + push @queries,$SQLsearch; $pretty_search_string .=$font.'mime contains '. $searchphrase.'
'; } @@ -1312,7 +1452,7 @@ sub parse_advanced_search { push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; $pretty_search_string.=$font."copyright = ". &Apache::loncommon::copyrightdescription($ENV{'form.copyright'}). - "
\n"; + "
\n"; } # # Statistics @@ -1395,16 +1535,17 @@ sub parse_advanced_search { ## ## Deal with restrictions to given domains ## - my ($libraries_to_query,$pretty_domains_string) = + my ($libraries_to_query,$pretty_domains_string,$domain_sql_restriction) = &parse_domain_restrictions(); + push(@queries,$domain_sql_restriction); $pretty_search_string .= $pretty_domains_string."
\n"; # if (@queries) { - $query="SELECT * FROM metadata WHERE ".join(" AND ",@queries); + $query="SELECT * FROM metadata WHERE (".join(") AND (",@queries).')'; } elsif ($customquery) { $query = ''; } -# &Apache::lonnet::logthis('query = '.$/.$query); + #&Apache::lonnet::logthis('advanced query = '.$/.$query); return ($query,$customquery,$customshow,$libraries_to_query, $pretty_search_string); } @@ -1414,7 +1555,7 @@ sub parse_domain_restrictions { # $ENV{'form.domains'} can be either a scalar or an array reference. # We need an array. if (! exists($ENV{'form.domains'}) || $ENV{'form.domains'} eq '') { - return (undef,''); + return (undef,'',undef); } my @allowed_domains; if (ref($ENV{'form.domains'})) { @@ -1425,17 +1566,21 @@ sub parse_domain_restrictions { # my %domain_hash = (); my $pretty_domains_string; + my $domain_sql_restriction; foreach (@allowed_domains) { $domain_hash{$_}++; } if ($domain_hash{'any'}) { $pretty_domains_string = "In all LON-CAPA domains."; + $domain_sql_restriction = undef; } else { if (@allowed_domains > 1) { $pretty_domains_string = "In LON-CAPA domains:"; } else { $pretty_domains_string = "In LON-CAPA domain "; } + $domain_sql_restriction = + '(domain="'.join('" OR domain="',@allowed_domains).'")'; foreach (sort @allowed_domains) { $pretty_domains_string .= "".$_." "; } @@ -1445,7 +1590,9 @@ sub parse_domain_restrictions { } } } - return ($libraries_to_query,$pretty_domains_string); + return ($libraries_to_query, + $pretty_domains_string, + $domain_sql_restriction); } ###################################################################### @@ -1466,7 +1613,7 @@ sub parse_basic_search { # # Clean up fields for safety for my $field ('basicexp') { - $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g; + $ENV{"form.$field"}=~s/[^\w\s\'\"\!\(\)\-]//g; } foreach ('mode','form','element') { # is this required? Hmmm. @@ -1474,41 +1621,36 @@ sub parse_basic_search { $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; } - my ($libraries_to_query,$pretty_domains_string) = + my ($libraries_to_query,$pretty_domains_string,$domain_sql_restriction) = &parse_domain_restrictions(); # # Check to see if enough of a query is filled in my $search_string = $ENV{'form.basicexp'}; - $search_string =~ s/(not\s*$|^\s*(and|or)|)//gi; if (! &filled($search_string)) { &output_blank_field_error($r,$closebutton,'phase=disp_basic'); return OK; } - my $pretty_search_string=''; + my $pretty_search_string=$search_string; my @Queries; - my $concatarg=join(',', - ('title', 'author', 'subject', 'notes', 'abstract', - 'keywords')); - foreach my $search (&process_phrase_input($search_string)){ - if ($ENV{'form.related'}) { - $pretty_search_string .= ' and
' if ($pretty_search_string ne ''); - $pretty_search_string .= ''.$search.''; - my @New_Words; - ($search,@New_Words) = &related_version($search); - next if (! $search); - if (@New_Words) { - $pretty_search_string .= - " with related words: @New_Words"; - } - } else { - $pretty_search_string .= ' and ' if ($pretty_search_string ne ''); - $pretty_search_string .= ''.$search.''; - } - # - # Build SQL query string based on form page - push(@Queries, - &build_SQL_query('concat_ws(" ",'.$concatarg.')',$search)); + my $searchfield = 'concat_ws(" ",'.join(',', + ('title','author','subject', + 'notes','abstract','keywords') + ).')'; + my ($error,$SQLQuery) = &process_phrase_input($search_string, + $ENV{'form.related'}, + $searchfield); + if ($error) { + &output_unparsed_phrase_error($r,$closebutton,'phase=disp_basic', + '','basicexp'); + return; + } + push(@Queries,$SQLQuery); + if (defined($domain_sql_restriction) && $domain_sql_restriction ne '') { + push(@Queries,$domain_sql_restriction); } + #foreach my $q (@Queries) { + # &Apache::lonnet::logthis(' '.$q); + #} my $final_query = 'SELECT * FROM metadata WHERE '.join(" AND ",@Queries); # if (defined($pretty_domains_string) && $pretty_domains_string ne '') { @@ -1516,40 +1658,189 @@ sub parse_basic_search { } $pretty_search_string .= "
\n"; $pretty_search_string =~ s:^
and ::; -# &Apache::lonnet::logthis($final_query); + #&Apache::lonnet::logthis('simple search final query = '.$/.$final_query); return ($final_query,$pretty_search_string, $libraries_to_query); } + +############################################################### +############################################################### + +my @Phrases; + +sub concat { + my ($item) = @_; + my $results = ''; + foreach (@$item) { + if (ref($_) eq 'ARRAY') { + $results .= join(' ',@$_); + } + } + return $results; +} + sub process_phrase_input { - my ($phrase)=@_; - my @Phrases; - # &Apache::lonnet::logthis('phrase = :'.$phrase.':'); - my $in_quotes = 0; - my @Words = split(/\s+/,$phrase); - foreach my $word (@Words) { - $word =~ s/(\w+)\"(\w+)/$1$2/g; - if ($in_quotes) { - if ($word =~ s/(\")$//) { - $in_quotes = 0; + my ($phrase,$related,$field)=@_; + #&Apache::lonnet::logthis('phrase = :'.$phrase.':'); + my $grammar = <<'ENDGRAMMAR'; + searchphrase: + expression /^\Z/ { + # &Apache::lonsearchcat::print_item(\@item,0); + [@item]; + } + expression: + phrase(s) { + [@item]; + } + phrase: + orword { + [@item]; + } + | andword { + [@item]; + } + | minusword { + unshift(@::Phrases,$item[1]->[0]); + unshift(@::Phrases,$item[1]->[1]); + [@item]; + } + | word { + unshift(@::Phrases,$item[1]); + [@item]; + } + # + orword: + word 'OR' phrase { + unshift(@::Phrases,'OR'); + unshift(@::Phrases,$item[1]); + [@item]; + } + | word 'or' phrase { + unshift(@::Phrases,'OR'); + unshift(@::Phrases,$item[1]); + [@item]; + } + | minusword 'OR' phrase { + unshift(@::Phrases,'OR'); + unshift(@::Phrases,$item[1]->[0]); + unshift(@::Phrases,$item[1]->[1]); + [@item]; + } + | minusword 'or' phrase { + unshift(@::Phrases,'OR'); + unshift(@::Phrases,$item[1]->[0]); + unshift(@::Phrases,$item[1]->[1]); + [@item]; + } + andword: + word phrase { + unshift(@::Phrases,'AND'); + unshift(@::Phrases,$item[1]); + [@item]; + } + | minusword phrase { + unshift(@::Phrases,'AND'); + unshift(@::Phrases,$item[1]->[0]); + unshift(@::Phrases,$item[1]->[1]); + [@item]; + } + # + minusword: + '-' word { + [$item[2],'NOT']; + } + word: + "'" term(s) "'" { + &Apache::lonsearchcat::concat(\@item); + } + | '"' term(s) '"' { + &Apache::lonsearchcat::concat(\@item); + } + | term { + $item[1]; + } + term: + /[\w\Q:!@#$%^&*()+_=|{}<>,.;\\\/?\E]+/ { + $item[1]; + } +ENDGRAMMAR + # + # The end result of parsing the phrase with the grammar is an array + # @::Phrases. + # $phrase = "gene splicing" or cat -> "gene splicing","OR","cat" + # $phrase = "genetic engineering" -dna -> + # "genetic engineering","AND","NOT","dna" + # $phrase = cat or dog -poodle -> "cat","OR","dog","AND","NOT","poodle" + undef(@::Phrases); + my $p = new Parse::RecDescent($grammar); + if (! defined($p->searchphrase($phrase))) { + &Apache::lonnet::logthis('lonsearchcat:unable to process:'.$phrase); + return 'Unable to process phrase '.$phrase; + } + # + # Go through the phrases and make sense of them. + # Apply modifiers NOT OR and AND to the phrases. + my @NewPhrases; + while(@::Phrases) { + my $phrase = shift(@::Phrases); + # &Apache::lonnet::logthis('phrase = '.$phrase); + my $phrasedata; + if ($phrase =~ /^(NOT|OR|AND)$/) { + if ($phrase eq 'OR') { + $phrasedata->{'or'}++; + if (! @::Phrases) { $phrasedata = undef; last; } + $phrase = shift(@::Phrases); + } elsif ($phrase eq 'AND') { + $phrasedata->{'and'}++; + if (! @::Phrases) { $phrasedata = undef; last; } + $phrase = shift(@::Phrases); } - if ($Phrases[-1] ne '') { - $Phrases[-1] .= ' '; + if ($phrase eq 'NOT') { + $phrasedata->{'negate'}++; + if (! @::Phrases) { $phrasedata = undef; last; } + $phrase = shift(@::Phrases); } - $Phrases[-1] .= $word; + } + $phrasedata->{'phrase'} = $phrase; + if ($related) { + my @NewWords; + (undef,@NewWords) = &related_version($phrasedata->{'phrase'}); + $phrasedata->{'related_words'} = \@NewWords; + } + push(@NewPhrases,$phrasedata); + } + # + # Actually build the sql query from the phrases + my $SQLQuery; + foreach my $phrase (@NewPhrases) { + my $query; + if ($phrase->{'negate'}) { + $query .= $field.' NOT LIKE "%'.$phrase->{'phrase'}.'%"'; } else { - if ($word =~ s/^(\")//) { - $in_quotes=1; + $query .= $field.' LIKE "%'.$phrase->{'phrase'}.'%"'; + } + foreach my $related (@{$phrase->{'related_words'}}) { + if ($phrase->{'negate'}) { + $query .= ' AND '.$field.' NOT LIKE "%'.$related.'%"'; + } else { + $query .= ' OR '.$field.' LIKE "%'.$related.'%"'; + } + } + if ($SQLQuery) { + if ($phrase->{'or'}) { + $SQLQuery .= ' OR ('.$query.')'; + } else { + $SQLQuery .= ' AND ('.$query.')'; } - push(@Phrases,$word); + } else { + $SQLQuery = '('.$query.')'; } } # - #foreach my $p (@Phrases) { - # &Apache::lonnet::logthis(' subphrase = '.$p); - #} + # &Apache::lonnet::logthis("SQLQuery = $SQLQuery"); # - return @Phrases; + return undef,$SQLQuery; } ###################################################################### @@ -1579,30 +1870,6 @@ sub related_version { return $result,sort(@Words); } -###################################################################### -###################################################################### - -=pod - -=item &build_SQL_query() - -Builds a SQL query string from a logical expression with AND/OR keywords -using Text::Query and &recursive_SQL_query_builder() - -=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; -} ###################################################################### ###################################################################### @@ -1637,47 +1904,6 @@ sub build_custommetadata_query { return $matchexp; } -###################################################################### -###################################################################### - -=pod - -=item &recursive_SQL_query_build() - -Recursively constructs an SQL query. Takes as input $dkey and $pattern. - -=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 (lc($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); -} ###################################################################### ###################################################################### @@ -1873,7 +2099,7 @@ sub print_sort_form { my $bodytag=&Apache::loncommon::bodytag(undef,undef,undef,1). &Apache::lonhtmlcommon::breadcrumbs (undef,'Searching','Searching',undef,undef, - ! ($ENV{'form.catalogmode'} eq 'groupsearch')); + $ENV{'form.catalogmode'} ne 'groupsearch'); ## my %SortableFields=&Apache::lonlocal::texthash( @@ -1906,8 +2132,9 @@ sub print_sort_form { return; } my $result; + my $html=&Apache::lonxml::xmlbegin(); $result.=< +$html