--- loncom/interface/lonsearchcat.pm 2002/06/18 21:36:38 1.121 +++ loncom/interface/lonsearchcat.pm 2010/05/04 17:16:34 1.323 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Search Catalog # -# $Id: lonsearchcat.pm,v 1.121 2002/06/18 21:36:38 matthew Exp $ +# $Id: lonsearchcat.pm,v 1.323 2010/05/04 17:16:34 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,14 +25,6 @@ # # http://www.lon-capa.org/ # -# YEAR=2001 -# 3/8, 3/12, 3/13, 3/14, 3/15, 3/19 Scott Harrison -# 3/20, 3/21, 3/22, 3/26, 3/27, 4/2, 8/15, 8/24, 8/25 Scott Harrison -# 10/12,10/14,10/15,10/16,11/28,11/29,12/10,12/12,12/16 Scott Harrison -# YEAR=2002 -# 1/17 Scott Harrison -# 6/17 Matthew Hall -# ############################################################################### ############################################################################### @@ -40,7 +32,7 @@ =head1 NAME -lonsearchcat +lonsearchcat - LONCAPA Search Interface =head1 SYNOPSIS @@ -56,7 +48,7 @@ described at http://www.lon-capa.org. lonsearchcat presents the user with an interface to search the LON-CAPA digital library. lonsearchcat also initiates the execution of a search by sending the search parameters to LON-CAPA servers. The progress of -search (on a server basis) is displayed to the user in a seperate window. +search (on a server basis) is displayed to the user in a separate window. =head1 Internals @@ -67,152 +59,1137 @@ search (on a server basis) is displayed ############################################################################### ############################################################################### -## ## -## ORGANIZATION OF THIS PERL MODULE ## -## ## -## 1. Modules used by this module ## -## 2. Choices for different output views (detailed, summary, xml, etc) ## -## 3. BEGIN block (to be run once after compilation) ## -## 4. Handling routine called via Apache and mod_perl ## -## 5. Other subroutines ## -## ## -############################################################################### - package Apache::lonsearchcat; -# ------------------------------------------------- modules used by this module use strict; -use Apache::Constants qw(:common); -use Apache::lonnet(); +use Apache::Constants qw(:common :http); +use Apache::lonnet; use Apache::File(); use CGI qw(:standard); use Text::Query; use GDBM_File; use Apache::loncommon(); +use Apache::lonmysql(); +use Apache::lonmeta; +use Apache::lonhtmlcommon; +use Apache::lonlocal; +use LONCAPA::lonmetadata(); +use HTML::Entities(); +use Parse::RecDescent; +use Apache::lonnavmaps; +use Apache::lonindexer(); +use LONCAPA; -# ---------------------------------------- variables used throughout the module +###################################################################### +###################################################################### +## +## Global variables +## +###################################################################### +###################################################################### +my %groupsearch_db; # Database hash used to save values for the + # groupsearch RAT interface. +my %persistent_db; # gdbm hash which holds data which is supposed to + # persist across calls to lonsearchcat.pm + +# The different view modes and associated functions + +my %Views = ("detailed" => \&detailed_citation_view, + "detailedpreview" => \&detailed_citation_preview, + "summary" => \&summary_view, + "summarypreview" => \&summary_preview, + "fielded" => \&fielded_format_view, + "xml" => \&xml_sgml_view, + "compact" => \&compact_view); ###################################################################### ###################################################################### +sub handler { + my $r = shift; +# &set_defaults(); + # + # set form defaults + # + my $hidden_fields;# Hold all the hidden fields used to keep track + # of the search system state + my $importbutton; # button to take the selected results and go to group + # sorting + my $diropendb; # The full path to the (temporary) search database file. + # This is set and used in &handler() and is also used in + # &output_results(). -=pod + # + my $closebutton; # button that closes the search window + # This button is different for the RAT compared to + # normal invocation. + # + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK if $r->header_only; + ## + ## Prevent caching of the search interface window. Hopefully this means + ## we will get the launch=1 passed in a little more. + &Apache::loncommon::no_cache($r); + ## + ## Pick up form fields passed in the links. + ## + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['catalogmode','launch','acts','mode','form','element','pause', + 'phase','persistent_db_id','table','start','show', + 'cleargroupsort','titleelement','area','inhibitmenu']); + ## + ## The following is a trick - we wait a few seconds if asked to so + ## the daemon running the search can get ahead of the daemon + ## printing the results. We only need (theoretically) to do + ## this once, so the pause indicator is deleted + ## + if (exists($env{'form.pause'})) { + sleep(1); + delete($env{'form.pause'}); + } + ## + ## Initialize global variables + ## + my $domain = $r->dir_config('lonDefDomain'); + $diropendb= "/home/httpd/perl/tmp/". + "$env{'user.domain'}_$env{'user.name'}_sel_res.db"; + # + # set the name of the persistent database + # $env{'form.persistent_db_id'} can only have digits in it. + if (! exists($env{'form.persistent_db_id'}) || + ($env{'form.persistent_db_id'} =~ /\D/) || + ($env{'form.launch'} eq '1')) { + $env{'form.persistent_db_id'} = time; + } + + my $persistent_db_file = "/home/httpd/perl/tmp/". + &escape($domain). + '_'.&escape($env{'user.name'}). + '_'.$env{'form.persistent_db_id'}.'_persistent_search.db'; + ## + &Apache::lonhtmlcommon::clear_breadcrumbs(); + + my @allowed_searches = ('portfolio'); + if (&Apache::lonnet::allowed('bre',$env{'request.role.domain'})) { + push(@allowed_searches,'res'); + } + if (exists($env{'request.course.id'}) && $env{'request.course.id'} ne '') { + push(@allowed_searches,'course'); + } + my $crumb_text = 'Portfolio Search'; + if (@allowed_searches == 3) { + $crumb_text = 'Course, Portfolio and Catalog Search'; + } elsif (@allowed_searches ==2) { + if (grep(/^res$/,@allowed_searches)) { + $crumb_text = 'Portfolio and Catalog Search'; + } elsif (grep(/^course$/,@allowed_searches)) { + $crumb_text = 'Portfolio and Course Search'; + } + } + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'/adm/searchcat?'. + &Apache::loncommon::inhibit_menu_check(). + '&catalogmode='.$env{'form.catalogmode'}. + '&launch='.$env{'form.launch'}. + '&mode='.$env{'form.mode'}, + text=>"$crumb_text", + target=>'_top', + bug=>'Searching',}); + # + if ($env{'form.phase'} !~ m/(basic|adv|course)_search/) { + if (! &get_persistent_form_data($persistent_db_file)) { + if ($env{'form.phase'} =~ /(run_search|results)/) { + &Apache::lonnet::logthis('lonsearchcat:'. + 'Unable to recover data from '. + $persistent_db_file); + my $msg = + 'We were unable to retrieve data describing your search. '. + 'This is a serious error and has been logged. '. + 'Please alert your LON-CAPA administrator.'; + &Apache::loncommon::simple_error_page($r,'Search Error', + $msg); + return OK; + } + } + } else { + &clean_up_environment(); + } + ## + ## Clear out old values from groupsearch database + ## + untie %groupsearch_db if (tied(%groupsearch_db)); + if (($env{'form.cleargroupsort'} eq '1') || + (($env{'form.launch'} eq '1') && + ($env{'form.catalogmode'} eq 'import'))) { + if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) { + &start_fresh_session(); + untie %groupsearch_db; + delete($env{'form.cleargroupsort'}); + } else { + # This is a stupid error to give to the user. + # It really tells them nothing. + my $msg = 'Unable to tie hash to db file.'; + &Apache::loncommon::simple_error_page($r,'Search Error', + $msg); + return OK; + } + } + ## + ## Configure hidden fields + ## + $hidden_fields = ''."\n"; + if (exists($env{'form.catalogmode'})) { + $hidden_fields .= &hidden_field('catalogmode'); + } + if (exists($env{'form.form'})) { + $hidden_fields .= &hidden_field('form'); + } + if (exists($env{'form.element'})) { + $hidden_fields .= &hidden_field('element'); + } + if (exists($env{'form.titleelement'})) { + $hidden_fields .= &hidden_field('titleelement'); + } + if (exists($env{'form.mode'})) { + $hidden_fields .= &hidden_field('mode'); + } + if (exists($env{'form.area'})) { + $hidden_fields .= &hidden_field('area'); + } + if (exists($env{'form.inhibitmenu'})) { + $hidden_fields .= &hidden_field('inhibitmenu'); + } + ## + ## Configure dynamic components of interface + ## + if ($env{'form.catalogmode'} eq 'interactive') { + $closebutton=" +END + } else { + $closebutton = ''; + $importbutton = ''; + } + ## + ## Sanity checks on form elements + ## + if (!defined($env{'form.viewselect'})) { + $env{'form.viewselect'} ="summary"; + } + $env{'form.phase'} = 'disp_basic' if (! exists($env{'form.phase'})); + $env{'form.show'} = 20 if (! exists($env{'form.show'})); + # + $env{'form.searchmode'} = 'basic' if (! exists($env{'form.searchmode'})); + if ($env{'form.phase'} eq 'adv_search' || + $env{'form.phase'} eq 'disp_adv') { + $env{'form.searchmode'} = 'advanced'; + } elsif ($env{'form.phase'} eq 'course_search') { + $env{'form.searchmode'} = 'course_search'; + } + # + if ($env{'form.searchmode'} eq 'advanced') { + my $srchtype = 'Catalog'; + if ($env{'form.area'} eq 'portfolio') { + $srchtype = 'Portfolio'; + } + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'/adm/searchcat?'.&Apache::loncommon::inhibit_menu_check(). + '&phase=disp_adv'. + '&catalogmode='.$env{'form.catalogmode'}. + '&launch='.$env{'form.launch'}. + '&mode='.$env{'form.mode'}, + text=>"Advanced $srchtype Search", + bug=>'Searching',}); + } elsif ($env{'form.searchmode'} eq 'course search') { + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'/adm/searchcat?'.&Apache::loncommon::inhibit_menu_check(). + '&phase=disp_adv'. + '&catalogmode='.$env{'form.catalogmode'}. + '&launch='.$env{'form.launch'}. + '&mode='.$env{'form.mode'}, + text=>"Course Search", + bug=>'Searching',}); + } + ## + ## Switch on the phase + ## + if ($env{'form.phase'} eq 'disp_basic') { + &print_basic_search_form($r,$closebutton,$hidden_fields); + } elsif ($env{'form.phase'} eq 'disp_adv') { + &print_advanced_search_form($r,$closebutton,$hidden_fields); + } elsif ($env{'form.phase'} eq 'results') { + &display_results($r,$importbutton,$closebutton,$diropendb, + $env{'form.area'}); + } elsif ($env{'form.phase'} =~ /^(sort|run_search)$/) { + my ($query,$customquery,$customshow,$libraries,$pretty_string) = + &get_persistent_data($persistent_db_file, + ['query','customquery','customshow', + 'libraries','pretty_string']); + if ($env{'form.phase'} eq 'sort') { + &print_sort_form($r,$pretty_string); + } elsif ($env{'form.phase'} eq 'run_search') { + &run_search($r,$query,$customquery,$customshow, + $libraries,$pretty_string,$env{'form.area'}); + } + } elsif ($env{'form.phase'} eq 'course_search') { + &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($env{'form.area'}))) { + my $errorstring=&Apache::lonmysql::get_error(); + &Apache::lonnet::logthis('lonsearchcat.pm: Unable to create '. + 'needed table. lonmysql error:'. + $errorstring); + + my $msg = + 'Unable to create table in which to save search results. '. + 'The search has been aborted.'; + &Apache::loncommon::simple_error_page($r,'Search Error', + $msg); + return OK; + } + delete($env{'form.launch'}); + if (! &make_form_data_persistent($r,$persistent_db_file)) { + my $msg= + 'Unable to properly save search information. '. + 'The search has been aborted.'; + &Apache::loncommon::simple_error_page($r,'Search Error', + $msg); + return OK; + } + ## + ## Print out the frames interface + ## + if (defined($query)) { + &print_frames_interface($r); + } + } + return OK; +} -=item Global variables +# +# The mechanism used to store values away and retrieve them does not +# handle the case of missing environment variables being significant. +# +# This routine sets non existant checkbox form elements to ''. +# +sub clean_up_environment { + if ($env{'form.phase'} eq 'basic_search') { + if (! exists($env{'form.related'})) { + $env{'form.related'} = ''; + } + if (! exists($env{'form.domains'})) { + $env{'form.domains'} = ''; + } + } elsif ($env{'form.phase'} eq 'adv_search') { + foreach my $field ('title','keywords','notes', + 'abstract','standards','mime') { + if (! exists($env{'form.'.$field.'_related'})) { + $env{'form.'.$field.'_related'} = ''; + } + } + } elsif ($env{'form.phase'} eq 'course_search') { + if (! exists($env{'form.crsrelated'})) { + $env{'form.crsrelated'} = ''; + } + } +} -=over 4 +sub hidden_field { + my ($name,$value) = @_; + if (! defined($value)) { + $value = $env{'form.'.$name}; + } + return ''.$/; +} -=item %hostdomains +###################################################################### +###################################################################### +## +## Course Search +## +###################################################################### +###################################################################### +{ # Scope the course search to avoid global variables +# +# Variables For course search +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 $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) { + $pretty_search_string .= ' '.&mt("with related words").": @New_Words."; + } else { + $pretty_search_string .= ' '.&mt('with no related words')."."; + } + } + my $fulltext=$env{'form.crsfulltext'}; + my $discuss=$env{'form.crsdiscuss'}; + my @allwords=($search_string,@New_Words); + $totalfound=0; + + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'/adm/searchcat?'.&Apache::loncommon::inhibit_menu_check(). + '&phase=disp_adv'. + '&catalogmode='.$env{'form.catalogmode'}. + '&launch='.$env{'form.launch'}. + '&mode='.$env{'form.mode'}, + text=>"Course Search", + bug=>'Searching',}); + $r->print(&Apache::loncommon::start_page('Course Search')); + $r->print(&Apache::lonhtmlcommon::breadcrumbs('Searching','Searching', + $env{'form.catalogmode'} ne 'import')); + + $r->print( + '
'. + $pretty_search_string.'
'. + '
'.&mt('Course content').':
'); + $r->rflush(); +# ======================================================= Go through the course + my $c=$r->connection; + if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.".db", + &GDBM_READER(),0640)) { + foreach (sort(keys(%hash))) { + if ($c->aborted()) { last; } + 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 matches found in resources.').'

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

'.&mt('Discussion postings').':
'); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (defined($navmap)) { + 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/$LONCAPA::domain_re/$LONCAPA::username_re)/(\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('discussion board'); + } else { + $url = '/res/'.$url; + } + if ($url =~ /\?/) { + $url .= '&symb='; + } else { + $url .= '?symb='; + } + $url .= &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.').'

'); + } + } else { + $r->print('
'.&mt('An error occurred retrieving information about resources in the course.').'
'.&mt('It is recommended that you [_1]re-initialize the course[_2] and then try your search again.','','').'
'); + } + } + +# =================================================== Done going through course + $r->print(&Apache::loncommon::end_page()); +} -=item %hostips +# =============================== This pulls up a resource and its dependencies -matches host name to host ip +sub checkonthis { + my ($r,$id,$url,$level,$title,$fulltext,$symb,@allwords)=@_; + $alreadyseen{$id}=1; + if (&Apache::loncommon::connection_aborted($r)) { return; } + $r->rflush(); + + 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='.&escape($symb)); + } + $result=~s/\s+/ /gs; + 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(' '); + } + my $href=$url; + if ($hash{'encrypted_'.$id} && !$env{'request.role.adv'}) { + $href=&Apache::lonenc::encrypted($href) + .'?symb='.&Apache::lonenc::encrypted($symb); + } else { + $href.='?symb='.&escape($symb); + } + $r->print(''.($title?$title:$url). + '
'); + $totalfound++; + } elsif ($fulltext) { + $r->print(' .'); + } + $r->rflush(); +# Check also the dependencies of this one + my $dependencies= + &Apache::lonnet::metadata($url,'dependencies'); + foreach (split(/\,/,$dependencies)) { + if (($_=~/^\/res\//) && (!$alreadyseen{$id})) { + &checkonthis($r,$id,$_,$level+1,'',$fulltext,undef,@allwords); + } + } +} -=item %hitcount +sub checkwords { + my ($result,$applies,@allwords) = @_; + foreach (@allwords) { + if ($_=~/\w/) { + if ($result=~/$_/si) { + $applies++; + } + } + } + return $applies; +} -stores number of hits per host +sub untiehash { + if (tied(%hash)) { + untie(%hash); + } +} -=item $closebutton +} # End of course search scoping -button that closes the search window -=item $importbutton +###################################################################### +###################################################################### -button to take the selecte results and go to group sorting +=pod -=item $hidden +=item &print_basic_search_form() -holds 'hidden' html forms +Prints the form for the basic search. Sorry the name is so cryptic. -=item $scrout +=cut -string that holds portions of the screen output +###################################################################### +###################################################################### +sub print_basic_search_form { + my ($r,$closebutton,$hidden_fields) = @_; + my $result = ($env{'form.catalogmode'} ne 'import'); + my $bread_crumb = + &Apache::lonhtmlcommon::breadcrumbs('Searching','Search_Basic', + $env{'form.catalogmode'} ne 'import'); + my $scrout = &Apache::loncommon::start_page('Content Library').$bread_crumb; +# Search form for resource space + if (&Apache::lonnet::allowed('bre',$env{'request.role.domain'})) { + $scrout .= &setup_basic_search($r,'res',$hidden_fields,$closebutton); + $scrout .= '

'; + } +# Search form for accessible portfolio files + $scrout.= &setup_basic_search($r,'portfolio',$hidden_fields,$closebutton); + if ($env{'request.course.id'}) { + my %lt=&Apache::lonlocal::texthash('srch' => 'Search', + 'header' => 'Course Search', + 'note' => 'Enter terms or phrases, then press "Search" below', + 'use' => 'use related words', + 'full' =>'fulltext search (time consuming)', + 'disc' => 'search discussion postings (resources and discussion boards)', + ); + $scrout.=(< +
+
+

$lt{'header'}

+ +$hidden_fields +

+$lt{'note'}. +

+ + + + + +
+ENDCOURSESEARCH + $scrout.=' '. + &Apache::lonhtmlcommon::textbox('courseexp', + $env{'form.courseexp'},40); + my $crscheckbox = + &Apache::lonhtmlcommon::checkbox('crsfulltext', + $env{'form.crsfulltext'}); + my $relcheckbox = + &Apache::lonhtmlcommon::checkbox('crsrelated', + $env{'form.crsrelated'}); + my $discheckbox = + &Apache::lonhtmlcommon::checkbox('crsdiscuss', + $env{'form.crsrelated'}); + $scrout.=(<
+

+ +

+
+ +ENDENDCOURSE + } + $scrout .= &Apache::loncommon::end_page(); + $r->print($scrout); + return; +} + +sub setup_basic_search { + my ($r,$area,$hidden_fields,$closebutton) = @_; + # Define interface components + my %lt = &Apache::lonlocal::texthash ( + res => 'LON-CAPA Catalog Search', + portfolio => 'Portfolio Search', + ); + my ($userelatedwords,$onlysearchdomain,$inclext,$adv_search_link,$scrout); + + $userelatedwords = ''; + + $onlysearchdomain = ''; + + $adv_search_link = ''.&mt('Advanced Search').''; + # + $scrout.='
'. + ''. + $hidden_fields; + if (!exists($env{'form.area'})) { + $scrout .= ''; + } + # + $scrout .= '
'.$/; +# if ($env{'request.course.id'}) { + $scrout .= '

'.$lt{$area}.'

'; +# } else { + # No need to tell them they are searching +# $scrout.= ('
'x2); +# } + $scrout.=''. + ''. + ''. + ''. + '
'. + &Apache::lonhtmlcommon::textbox('basicexp', + $env{'form.basicexp'},50). + '
'. + ''.&searchhelp().''.'		'. + ''.(' 'x3).$adv_search_link.''.'
'. + ''.(' 'x1).$userelatedwords.''.'
'. + ''.(' 'x1).$onlysearchdomain.''.'
'. + ''.(' 'x1).$inclext.''.'
'. + '
'.$/; + # + $scrout .= '

' + .&viewoptions() + .'

' + .'

' + .'' + .' ' + .$closebutton + .'

'; + # + $scrout .= '
'.'
'; + return $scrout; +} -=item $yourself +###################################################################### +###################################################################### -allows for quickly limiting to oneself +=pod -=item %hash +=item &advanced_search_form() -The ubiquitous database hash +Prints the advanced search form. -=item $basicviewselect and $advancedviewselect +=cut -View selection forms. These are not actually global and will be -moved soon. +###################################################################### +###################################################################### +sub print_advanced_search_form{ + my ($r,$closebutton,$hidden_fields) = @_; + my $bread_crumb = + &Apache::lonhtmlcommon::breadcrumbs('Searching','Search_Advanced', + $env{'form.catalogmode'} ne 'import'); + my %lt=&Apache::lonlocal::texthash('srch' => 'Search', + 'reset' => 'Reset', + 'help' => 'Help'); + my $advanced_buttons=<<"END"; +

+ + +$closebutton +

+END + my $srchtype = 'Catalog'; + my $jscript; + if ($env{'form.area'} eq 'portfolio') { + $srchtype = 'Portfolio'; + $jscript = ''; + } + my $scrout= &Apache::loncommon::start_page("Advanced $srchtype Search", + $jscript); + $scrout .= $bread_crumb; + + $scrout .= '
' + .$hidden_fields + .''; + + $scrout .= '
'."\n" + .''.&mt('Display Options').''."\n" + .&viewoptions() + .'
'; + + $scrout .= $advanced_buttons; + + $scrout .= &Apache::lonhtmlcommon::start_pick_box(); + + my %fields=&Apache::lonmeta::fieldnames(); + + # Standard Metadata + $scrout .= &Apache::lonhtmlcommon::row_headline() + .'

'.&mt("Standard $srchtype Metadata").'

' + .&searchhelp() + .&Apache::lonhtmlcommon::row_closure(); + my %related_word_search = + ('title' => 1, + 'author' => 0, + 'owner' => 0, + 'authorspace' => 0, + 'modifyinguser'=> 0, + 'keywords' => 1, + 'notes' => 1, + 'abstract' => 1, + 'standards'=> 1, + 'mime' => 1, + 'subject' => 1, + ); + # + foreach my $field ('title','author','subject','owner','authorspace', + 'modifyinguser','keywords','notes','abstract', + 'standards','mime') { + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield($fields{$field})) + .&Apache::lonmeta::prettyinput($field, + $env{'form.'.$field}, + $field, + 'advsearch', + $related_word_search{$field}, + '', + $env{'form.'.$field.'_related'}, + 50); + if ($related_word_search{$field}) { + $scrout .= &mt('related words'); + } else { + $scrout .= ''; + } + $scrout .= &Apache::lonhtmlcommon::row_closure(); + } + foreach my $field ('lowestgradelevel','highestgradelevel') { + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield($fields{$field})) + .&Apache::lonmeta::prettyinput($field, + $env{'form.'.$field}, + $field, + 'advsearch', + 0) + .&Apache::lonhtmlcommon::row_closure(); + } + + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt('MIME Type Category'))) + .&Apache::loncommon::filecategoryselect('category', + $env{'form.category'}) + .&Apache::lonhtmlcommon::row_closure(); + + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt('Domains'))) + .&Apache::loncommon::domain_select('domains', + $env{'form.domains'},1) + .&Apache::lonhtmlcommon::row_closure(); + + # Misc metadata + if ($env{'form.area'} ne 'portfolio') { + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt('Copyright/Distribution'))) + .&Apache::lonmeta::selectbox('copyright', + $env{'form.copyright'}, + \&Apache::loncommon::copyrightdescription, + ( undef, + &Apache::loncommon::copyrightids) + ) + .&Apache::lonhtmlcommon::row_closure(); + } + + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt('Language'))) + .&Apache::lonmeta::selectbox('language', + $env{'form.language'}, + \&Apache::loncommon::languagedescription, + ('any',&Apache::loncommon::languageids) + ) + .&Apache::lonhtmlcommon::row_closure(); + + # Portfolio Metadata + if ($env{'form.area'} eq 'portfolio') { + # Added fields + my $curnumadd = $env{'form.numaddedfields'}; + if ($curnumadd eq '') { + $curnumadd = 1; + } + $scrout .= &Apache::lonhtmlcommon::row_headline() + .'

'.&mt('Custom Metadata fields').'

' + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title('') + .&mt('Field Name').' | '.&mt('Field Value(s)') + .&Apache::lonhtmlcommon::row_closure(); + + for (my $j=0; $j<$curnumadd; $j++) { + my $num = $j+1; + $scrout .= &Apache::lonhtmlcommon::row_title(&mt('Custom metadata [_1]',$num)) + .'' + .' ' + .'' + .&Apache::lonhtmlcommon::row_closure(); + } + $scrout .= &Apache::lonhtmlcommon::row_title('') + .'' + .'' + .&Apache::lonhtmlcommon::row_closure(); +} else { + # + # Dynamic metadata + $scrout .= &Apache::lonhtmlcommon::row_headline() + .'

'.&mt('Problem Statistics').'

' + .&Apache::lonhtmlcommon::row_closure(); + $scrout .= &Apache::lonhtmlcommon::row_title('') + .&mt('Minimum').' | '.&mt('Maximum') + .&Apache::lonhtmlcommon::row_closure(); + foreach my $statistic + ({ name=>'count', + description=>'Network-wide number of accesses (hits)',}, + { name=>'stdno', + description=> + 'Statistics calculated for number of students',}, + { name => 'avetries', + description=>'Average number of tries till solved',}, + { name => 'difficulty', + description=>'Degree of difficulty',}, + { name => 'disc', + description=>'Degree of discrimination'}) { + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt($statistic->{'description'}))) + .'' + .' ' + .'' + .&Apache::lonhtmlcommon::row_closure(); + } -=item $diropendb + $scrout .= &Apache::lonhtmlcommon::row_headline() + .'

'.&mt('Evaluation Data').'

' + .&Apache::lonhtmlcommon::row_closure(); + $scrout .= &Apache::lonhtmlcommon::row_title('') + .&mt('Minimum').' | '.&mt('Maximum') + .&Apache::lonhtmlcommon::row_closure(); + foreach my $evaluation + ( { name => 'clear', + description => 'Material presented in clear way'}, + { name =>'depth', + description => 'Material covered with sufficient depth'}, + { name => 'helpful', + description => 'Material is helpful'}, + { name => 'correct', + description => 'Material appears to be correct'}, + { name => 'technical', + description => 'Resource is technically correct'}){ + $scrout .= &Apache::lonhtmlcommon::row_title(&titlefield(&mt($evaluation->{'description'}))) + .'' + .' ' + .'' + .&Apache::lonhtmlcommon::row_closure(); + } + } + # + # Creation/Modification date limits + $scrout .= &Apache::lonhtmlcommon::row_headline() + .'

'.&mt('Creation and Modification dates').'

' + .&Apache::lonhtmlcommon::row_closure(); + $scrout .= &Apache::lonhtmlcommon::row_title('') + .&mt('Month[_1]Day[_2]Year',' 'x14,' 'x6) + .&Apache::lonhtmlcommon::row_closure(); + + my $cafter = + &Apache::lonhtmlcommon::date_setter('advsearch', # formname + 'creationdate1', # fieldname + 0, # current value + '', # special + 1, # includeempty + '', # state + 1, # no_hh_mm_ss + ); + my $cbefore = + &Apache::lonhtmlcommon::date_setter('advsearch', # formname + 'creationdate2', # fieldname + 0, # current value + '', # special + 1, # includeempty + '', # state + 1, # no_hh_mm_ss + ); + $scrout .= &Apache::lonhtmlcommon::row_title(&mt('Created between')) + .$cafter + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::row_title(&mt('and')) + .$cbefore + .&Apache::lonhtmlcommon::row_closure(); + + my $lafter = + &Apache::lonhtmlcommon::date_setter('advsearch', + 'revisiondate1', + 0, # current value + '', # special + 1, # includeempty + '', # state + 1, # no_hh_mm_ss + ); + my $lbefore = + &Apache::lonhtmlcommon::date_setter('advsearch', + 'revisiondate2', + 0, # current value + '', # special + 1, # includeempty + '', # state + 1, # no_hh_mm_ss + ); + $scrout .= &Apache::lonhtmlcommon::row_title(&mt('Last modified between')) + .$lafter + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::row_title(&mt('and')) + .$lbefore + .&Apache::lonhtmlcommon::row_closure(1); # Last row of total pick_box + + $scrout .= &Apache::lonhtmlcommon::end_pick_box(); + + $scrout .= $advanced_buttons + .'
'; + + $scrout .= &Apache::loncommon::end_page(); + $r->print($scrout); + return; +} -The full path to the (temporary) search database file. This is set and -used in &handler() and is also used in &output_results(). +###################################################################### +###################################################################### -=back +=pod + +=item &titlefield() + +Inputs: title text + +Outputs: titletext with font wrapper =cut ###################################################################### ###################################################################### +sub titlefield { + my $title=shift; + return $title; +} -# -- information holders -my %hostdomains; # matches host name to host domain -my %hostips; # matches host name to host ip -my %hitcount; # stores number of hits per host - -# -- dynamically rendered interface components -my $closebutton; # button that closes the search window -my $importbutton; # button to take the selected results and go to group sorting -my $hidden; # Holds 'hidden' html forms - -# -- miscellaneous variables -my $scrout; # string that holds portions of the screen output -my $yourself; # allows for quickly limiting to oneself -my %hash; # database hash - -# ------------------------------------------ choices for different output views -# Detailed Citation View ---> sub detailed_citation_view -# Summary View ---> sub summary_view -# Fielded Format ---> sub fielded_format_view -# XML/SGML ---> sub xml_sgml_view -my $basicviewselect=< - - - - - -END -my $advancedviewselect=< - - - - - -END - -#------------------------------------------------------------- global variables -my $diropendb = ""; -my $domain = ""; +###################################################################### +###################################################################### -# ----------------------------------------------------------------------- BEGIN +=pod -=pod +=item viewoptiontext() -=item BEGIN block +Inputs: codename for view option -Load %hostdomains and %hostips with data from lonnet.pm. Only library -servers are considered. +Outputs: displayed text =cut -BEGIN { - foreach (keys (%Apache::lonnet::libserv)) { - $hostdomains{$_}=$Apache::lonnet::hostdom{$_}; - $hostips{$_}=$Apache::lonnet::hostip{$_}; - } +###################################################################### +###################################################################### +sub viewoptiontext { + my $code=shift; + my %desc=&Apache::lonlocal::texthash + ('detailed' => "Detailed Citation View", + 'xml' => 'XML/SGML', + 'compact' => 'Compact View', + 'fielded' => 'Fielded Format', + 'summary' => 'Summary View', + 'summarypreview' => 'Summary Preview', + 'detailedpreview' => 'Detailed Citation Preview'); + return $desc{$code}; } ###################################################################### @@ -220,264 +1197,156 @@ BEGIN { =pod -=item &handler() - main handler invoked by httpd child +=item viewoptions() + +Inputs: none + +Outputs: text for box with view options =cut ###################################################################### ###################################################################### -# ----------------------------- Handling routine called via Apache and mod_perl -sub handler { - my $r = shift; - untie %hash; - - $r->content_type('text/html'); - $r->send_http_header; - return OK if $r->header_only; - - my $domain = $r->dir_config('lonDefDomain'); - $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::unescape($domain). - "\_".&Apache::lonnet::unescape($ENV{'user.name'})."_searchcat.db"; +sub viewoptions { + my $scrout; + if (! defined($env{'form.viewselect'})) { + $env{'form.viewselect'}='detailed'; + } + $scrout .= '' + .&mt('Type:').' ' + .&Apache::lonmeta::selectbox('viewselect', + $env{'form.viewselect'}, + \&viewoptiontext, + sort(keys(%Views))) + .''; + my $countselect = &Apache::lonmeta::selectbox('show', + $env{'form.show'}, + undef, + (10,20,50,100,1000,10000)); + $scrout .= ' ' + .&mt('Records per Page:').' '.$countselect + .''.$/; + return $scrout; +} - &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, - ['catalogmode','launch','acts','mode','form','element']); +###################################################################### +###################################################################### - if ($ENV{'form.launch'} eq '1') { - if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { - &start_fresh_session(); - untie %hash; - } - else { - $r->print('Unable to tie hash to db '. - 'file'); - return OK; - } - } +=pod -# --------------------------- Produce some output, so people know it is working +=item searchhelp() - $r->print("\n"); - $r->rflush; +Inputs: none -# ----------------------------------- configure dynamic components of interface +Outputs: return little blurb on how to enter searches - if ($ENV{'form.catalogmode'} eq 'interactive') { - $hidden="". - "\n"; - $closebutton=""."\n"; - } - elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { - $hidden=< -END - $closebutton=< -END - $importbutton=< -END - } - $hidden .= < - - - -END -# ------------------------------------------------------ Determine current user - $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; +=cut -# --- Now, depending on the interface actions, do one of three things here: -# --- 1. a basic search -# --- 2. an advanced search -# --- 3. output a search interface +###################################################################### +###################################################################### +sub searchhelp { + return &mt('Enter words and quoted phrases'); +} -# ----------------------------------- See if a search invocation should be done - if ($ENV{'form.basicsubmit'} eq 'SEARCH') { - untie %hash; return &basicsearch($r,\%ENV); - } - elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { - untie %hash; 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'}); +=pod - $scrout.=&searchphrasefield('Limit by author','author', - $ENV{'form.author'}); +=item &get_persistent_form_data() - $scrout.=&searchphrasefield('Limit by subject','subject', - $ENV{'form.subject'}); +Inputs: filename of database - $scrout.=&searchphrasefield('Limit by keywords','keywords', - $ENV{'form.keywords'}); +Outputs: returns undef on database errors. - $scrout.=&searchphrasefield('Limit by URL','url', - $ENV{'form.url'}); +This function is the reverse of &make_persistent() for form data. +Retrieve persistent data from %persistent_db. Retrieved items will have their +values unescaped. If a form value already exists in $env, it will not be +overwritten. Form values that are array references may have values appended +to them. -# $scrout.=&searchphrasefield('Limit by version','version', -# $ENV{'form.version'}); +=cut - $scrout.=&searchphrasefield('Limit by notes','notes', - $ENV{'form.notes'}); +###################################################################### +###################################################################### +sub get_persistent_form_data { + my $filename = shift; + return 0 if (! -e $filename); + return undef if (! tie(%persistent_db,'GDBM_File',$filename, + &GDBM_READER(),0640)); + # + # These make sure we do not get array references printed out as 'values'. + my %arrays_allowed = ('form.domains'=>1); + # + # Loop through the keys, looking for 'form.' + foreach my $name (keys(%persistent_db)) { + next if ($name !~ /^form./); + # Kludgification begins! + if ($name eq 'form.domains' && + $env{'form.searchmode'} eq 'basic' && + $env{'form.phase'} ne 'disp_basic') { + next; + } + # End kludge (hopefully) + next if (exists($env{$name})); + my @values = map { + &unescape($_); + } split(',',$persistent_db{$name}); + next if (@values <1); + if ($arrays_allowed{$name}) { + $env{$name} = [@values]; + } else { + $env{$name} = $values[0] if ($values[0]); + } + } + untie (%persistent_db); + return 1; +} - $scrout.=&searchphrasefield('Limit by abstract','abstract', - $ENV{'form.abstract'}); +###################################################################### +###################################################################### - $ENV{'form.mime'}='any' unless length($ENV{'form.mime'}); - $scrout.=&selectbox('Limit by MIME type','mime', - $ENV{'form.mime'}, - 'any','Any type', - \&{Apache::loncommon::filedescriptionex}, - (&Apache::loncommon::fileextensions)); +=pod - $ENV{'form.language'}='any' unless length($ENV{'form.language'}); +=item &get_persistent_data() - $scrout.=&selectbox('Limit by language','language', - $ENV{'form.language'},'any','Any Language', - \&{Apache::loncommon::languagedescription}, - (&Apache::loncommon::languageids), - ); +Inputs: filename of database, ref to array of values to recover. -# ------------------------------------------------ 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.=< -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.=< -LIMIT BY SPECIAL METADATA FIELDS: - -For resource-specific metadata, enter in an expression in the form of -key=value separated by operators such as AND, OR or NOT.
-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'; +=cut - $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(< - -The LearningOnline Network with CAPA - - - - -

Search Catalog

-
-$hidden -
-

Basic Search

-

-Enter terms or phrases separated by search operators -such as AND, OR, or NOT then press SEARCH below. Terms should be specific -to the title, author, subject, notes, or abstract information associated -with a resource. -
-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'})); -# Search historic archives - $r->print(< - - -$closebutton -$basicviewselect - -

-
-

Advanced Search

-$scrout -

- - -$closebutton -$advancedviewselect - -

-
- - -ENDDOCUMENT - return OK; -} + untie (%persistent_db); + return @Values; +} ###################################################################### ###################################################################### @@ -486,295 +1355,689 @@ ENDDOCUMENT =item &make_persistent() -Returns a scalar which holds the current ENV{'form.*'} values in -a 'hidden' html input tag. +Inputs: Hash of values to save, filename of persistent database. + +Store variables away to the %persistent_db. +Values will be escaped. Values that are array pointers will have their +elements escaped and concatenated in a comma separated string. + =cut ###################################################################### ###################################################################### - -# ------------------------------------------------------------- make persistent - sub make_persistent { - my $persistent=''; - - foreach (keys %ENV) { - if (/^form\./ && !/submit/) { - my $name=$_; - my $key=$name; - $ENV{$key}=~s/\'//g; # do not mess with html field syntax - $name=~s/^form\.//; - $persistent.=< -END - } + my %save = %{shift()}; + my $filename = shift; + return undef if (! tie(%persistent_db,'GDBM_File', + $filename,&GDBM_WRCREAT(),0640)); + foreach my $name (keys(%save)) { + my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name})); + # We handle array references, but not recursively. + my $store = join(',', map { &escape($_); } @values ); + $persistent_db{$name} = $store; } - return $persistent; + untie(%persistent_db); + return 1; } -# --------------------------------------------------------- Various form fields +###################################################################### +###################################################################### -sub simpletextfield { - my ($name,$value)=@_; - return ''; -} +=pod -sub simplecheckbox { - my ($name,$value)=@_; - my $checked=''; - $checked="CHECKED" if $value eq 'on'; - return ''; -} +=item &make_form_data_persistent() -sub searchphrasefield { - my ($title,$name,$value)=@_; - my $instruction=<$uctitle:". - " $instruction
". - ''; -} +Inputs: filename of persistent database. -sub dateboxes { - my ($name,$defaultmonth,$defaultday,$defaultyear, - $currentmonth,$currentday,$currentyear)=@_; - ($defaultmonth,$defaultday,$defaultyear)=('','',''); - # - # Day - my $day=< - -END - for (my $i = 1; $i<=31; $i++) { - $day.="\n"; - } - $day.="\n"; - $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); - # - # Month - my $month=< - -END - my $i = 1; - foreach (qw/January February March April May June - July August September October November December /){ - $month .="\n"; - $i++; - } - $month.="\n"; - $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); - # - # Year (obviously) - my $year=< - -END - my $maxyear = 2051; - for (my $i = 1976; $i<=$maxyear; $i++) { - $year.="\n"; - } - $year.="\n"; - $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); - return "$month$day$year"; -} - -sub selectbox { - my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; - my $uctitle=uc($title); - my $selout="\n

$uctitle:". - "
".''; + return &make_persistent(\%save,$filename); } -# ----------------------------------------------- Performing an advanced search -sub advancedsearch { - my ($r,$envhash)=@_; - my %ENV=%{$envhash}; +###################################################################### +###################################################################### + +=pod + +=item &parse_advanced_search() + +Parse advanced search form and return the following: + +=over 4 + +=item $query Scalar containing an SQL query. + +=item $customquery Scalar containing a custom query. + +=item $customshow Scalar containing commands to show custom metadata. +=item $libraries_to_query Reference to array of domains to search. + +=back + +=cut + +###################################################################### +###################################################################### +sub parse_advanced_search { + my ($r,$closebutton,$hidden_fields)=@_; + my @BasicFields = ('title','author','subject','keywords','url','version', + 'notes','abstract','extension','owner','authorspace', +# 'custommetadata','customshow', + 'modifyinguser','standards','mime'); + my @StatsFields = &statfields(); + my @EvalFields = &evalfields(); my $fillflag=0; + my $pretty_search_string = ""; # Clean up fields for safety - for my $field ('title','author','subject','keywords','url','version', - 'creationdatestart_month','creationdatestart_day', + for my $field (@BasicFields, + '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','customshow') { - $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g; + 'lastrevisiondateend_day','lastrevisiondateend_year') { + $env{'form.'.$field}=~s/[^\w\/\s\(\)\=\-\"\'.\*]//g; } foreach ('mode','form','element') { # is this required? Hmmm. - next unless (exists($ENV{"form.$_"})); - $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); - $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; - } + next if (! exists($env{'form.'.$_})); + $env{'form.'.$_}=&unescape($env{'form.'.$_}); + $env{'form.'.$_}=~s/[^\w\/\s\(\)\=\-\"\']//g; + } + # Preprocess the category form element. + $env{'form.category'} = 'any' if (! defined($env{'form.category'}) || + ref($env{'form.category'})); + # # Check to see if enough information was filled in - for my $field ('title','author','subject','keywords','url','version', - 'notes','abstract','mime','language','owner', - 'custommetadata') { - if (&filled($ENV{"form.$field"})) { + foreach my $field (@BasicFields) { + if (&filled($env{'form.'.$field})) { $fillflag++; } } - unless ($fillflag) { - &output_blank_field_error($r); - return OK; + foreach my $field (@StatsFields,@EvalFields) { + if (&filled($env{'form.'.$field.'_max'})) { + $fillflag++; + } + if (&filled($env{'form.'.$field.'_min'})) { + $fillflag++; + } } - + for my $field ('lowestgradelevel','highestgradelevel') { + if ( $env{'form.'.$field} =~ /^\d+$/ && + $env{'form.'.$field} > 0) { + $fillflag++; + } + } + if ($env{'form.area'} eq 'portfolio') { + # Added metadata fields + for (my $i=0; $i<$env{'form.numaddedfields'} ; $i++) { + my $field = $env{'form.addedfield_'.$i}; + $field =~ s/^\s*(\S*)\s*$/$1/; + $field =~ s/\W/_/g; + if ($field ne '') { + $fillflag++; + } + } + } + if (! $fillflag) { + &output_blank_field_error($r,$closebutton, + 'phase=disp_adv',$hidden_fields); + return ; + } # Turn the form input into a SQL-based query my $query=''; - my @queries; + my $font = ''; # Evaluate 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}); - } + foreach my $field (@BasicFields) { + next if (!defined($env{'form.'.$field}) || $env{'form.'.$field} eq ''); + 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 @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 related words.'; + } + } + $pretty_search_string .= '
'; + push (@queries,$SQLQuery); + } } - # Evaluate option lists - if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { - push @queries,"(language like \"$ENV{'form.language'}\")"; + # + # Make the 'mime' from 'form.category' and 'form.extension' + # + my $searchphrase; + if (exists($env{'form.category'}) && + $env{'form.category'} !~ /^\s*$/ && + $env{'form.category'} ne 'any') { + my @extensions = &Apache::loncommon::filecategorytypes + ($env{'form.category'}); + if (scalar(@extensions) > 0) { + $searchphrase = join(' OR ',@extensions); + } } - if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') { - push @queries,"(mime like \"$ENV{'form.mime'}\")"; + if (defined($searchphrase)) { + my ($error,$SQLsearch) = &process_phrase_input($searchphrase,0,'mime'); + push @queries,$SQLsearch; + $pretty_search_string .=$font.'mime contains '. + $searchphrase.'
'; } - if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { - push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; + # + # Evaluate option lists + if ($env{'form.lowestgradelevel'} && + $env{'form.lowestgradelevel'} ne '0' && + $env{'form.lowestgradelevel'} =~ /^\d+$/) { + push(@queries, + '(lowestgradelevel>='.$env{'form.lowestgradelevel'}.')'); + $pretty_search_string.="lowestgradelevel>=". + $env{'form.lowestgradelevel'}."
\n"; + } + if ($env{'form.highestgradelevel'} && + $env{'form.highestgradelevel'} ne '0' && + $env{'form.highestgradelevel'} =~ /^\d+$/) { + push(@queries, + '(highestgradelevel<='.$env{'form.highestgradelevel'}.')'); + $pretty_search_string.="highestgradelevel<=". + $env{'form.highestgradelevel'}."
\n"; + } + if ($env{'form.language'} and $env{'form.language'} ne 'any') { + push @queries,"(language like \"$env{'form.language'}\")"; + $pretty_search_string.=$font."language= ". + &Apache::loncommon::languagedescription($env{'form.language'}). + "
\n"; + } + if ($env{'form.copyright'} and $env{'form.copyright'} ne 'any') { + push @queries,"(copyright like \"$env{'form.copyright'}\")"; + $pretty_search_string.=$font."copyright = ". + &Apache::loncommon::copyrightdescription($env{'form.copyright'}). + "
\n"; + } + if ($env{'form.area'} eq 'portfolio') { + # + # Added metadata fields + for (my $i=0; $i<$env{'form.numaddedfields'} ; $i++) { + my $field = $env{'form.addedfield_'.$i}; + $field =~ s/^\s*(\S*)\s*$/$1/; + $field =~ s/\W/_/g; + $field =~ tr/A-Z/a-z/; + if ($field ne '') { + my $value = $env{'form.addedvalues_'.$i}; + if ($value ne '') { + $value =~ s/'/''/g; #' stupid emacs + my ($error,$query) = + &process_phrase_input($value,0,'pf.value'); + if (!defined($error)) { + push(@queries,"pf.field = '$field' AND $query"); + $pretty_search_string .= + $font.$field.': '. + $env{'form.addedvalues_'.$i}.'
'; + } + } else { + push(@queries,"pf.field = '$field' AND pf.value IS NULL"); + } + } + } + } else { + # + # Statistics + foreach my $field (@StatsFields,@EvalFields) { + my ($min,$max); + if (exists($env{'form.'.$field.'_min'}) && + $env{'form.'.$field.'_min'} ne '') { + $min = $env{'form.'.$field.'_min'}; + } + if (exists($env{'form.'.$field.'_max'}) && + $env{'form.'.$field.'_max'} ne '') { + $max = $env{'form.'.$field.'_max'}; + } + next if (! defined($max) && ! defined($min)); + if (defined($min) && defined($max)) { + ($min,$max) = sort {$a <=>$b} ($min,$max); + } + if (defined($min) && $min =~ /^(\d+\.\d+|\d+|\.\d+)$/) { + push(@queries,'('.$field.'>'.$min.')'); + $pretty_search_string.=$font.$field.'>'.$min.'
'; + } + if (defined($max) && $max =~ /^(\d+\.\d+|\d+|\.\d+)$/) { + push(@queries,'('.$field.'<'.$max.')'); + $pretty_search_string.=$font.$field.'<'.$max.'
'; + } + } } + # # Evaluate date windows - 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'}, - ); - # Test to see if date windows are legitimate - if ($datequery=~/^Incorrect/) { - &output_date_error($r,$datequery); - return OK; - } - elsif ($datequery) { + my $cafter = + &Apache::lonhtmlcommon::get_date_from_form('creationdate1'); + my $cbefore = + &Apache::lonhtmlcommon::get_date_from_form('creationdate2'); + if ($cafter > $cbefore) { + my $tmp = $cafter; + $cafter = $cbefore; + $cbefore = $tmp; + } + my $mafter = + &Apache::lonhtmlcommon::get_date_from_form('revisiondate1'); + my $mbefore = + &Apache::lonhtmlcommon::get_date_from_form('revisiondate2'); + if ($mafter > $mbefore) { + my $tmp = $mafter; + $mafter = $mbefore; + $mbefore = $tmp; + } + my ($datequery,$error,$prettydate)=&build_date_queries($cafter,$cbefore, + $mafter,$mbefore); + if (defined($error)) { + &output_date_error($r,$error,$closebutton,$hidden_fields); + } elsif (defined($datequery)) { + # Here is where you would set up pretty_search_string to output + # date query information. + $pretty_search_string .= '
'.$prettydate.'
'; push @queries,$datequery; } - + # # Process form information for custom metadata querying - my $customquery=''; - if ($ENV{'form.custommetadata'}) { - $customquery=&build_custommetadata_query('custommetadata', - $ENV{'form.custommetadata'}); + my $customquery=undef; + ## + ## The custom metadata search was removed q long time ago mostly + ## because I was unable to figureout exactly how it worked and could + ## not imagine people actually using it. MH + ## + # if ($env{'form.custommetadata'}) { + # $pretty_search_string .=$font."Custom Metadata Search: ". + # $env{'form.custommetadata'}."
\n"; + # $customquery=&build_custommetadata_query('custommetadata', + # $env{'form.custommetadata'}); + # } + my $customshow=undef; + # if ($env{'form.customshow'}) { + # $pretty_search_string .=$font."Custom Metadata Display: ". + # $env{'form.customshow'}."
\n"; + # $customshow=$env{'form.customshow'}; + # $customshow=~s/[^\w\s]//g; + # my @fields=split(/\s+/,$customshow); + # $customshow=join(" ",@fields); + # } + ## + ## Deal with restrictions to given domains + ## + my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions(); + if ($pretty_domains_string) { + $pretty_search_string .= $pretty_domains_string."
\n"; } - my $customshow=''; - if ($ENV{'form.customshow'}) { - $customshow=$ENV{'form.customshow'}; - $customshow=~s/[^\w\s]//g; - my @fields=split(/\s+/,$customshow); - $customshow=join(" ",@fields); - } - # Send query statements over the network to be processed by either the SQL - # database or a recursive scheme of 'grep'-like actions (for custom - # metadata). + # if (@queries) { - $query=join(" AND ",@queries); - $query="select * from metadata where $query"; - my $reply; # reply hash reference - unless ($customquery or $customshow) { - $reply=&Apache::lonnet::metadata_query($query); - } - else { - $reply=&Apache::lonnet::metadata_query($query, - $customquery,$customshow); - } - &output_results('Advanced',$r,$envhash,$customquery,$reply); + if ($env{'form.area'} eq 'portfolio') { + $query ="SELECT pm.*,pa.keynum,pa.scope FROM portfolio_metadata pm, portfolio_access pa, portfolio_addedfields pf WHERE (pm.url = pa.url AND pf.url = pm.url AND (pa.start < UTC_TIMESTAMP() AND (pa.end IS NULL OR pa.end > UTC_TIMESTAMP())) AND (".join(') AND (',@queries).'))'; + } else { + $query="SELECT * FROM metadata WHERE (".join(") AND (",@queries).')'; + } + } elsif ($customquery) { + $query = ''; } - elsif ($customquery) { - my $reply; # reply hash reference - $reply=&Apache::lonnet::metadata_query('', - $customquery,$customshow); - &output_results('Advanced',$r,$envhash,$customquery,$reply); - } - # should not get to this point - return 'Error. Should not have gone to this point.'; -} - -# --------------------------------------------------- Performing a basic search -sub basicsearch { - my ($r,$envhash)=@_; - my %ENV=%{$envhash}; + #&Apache::lonnet::logthis('advanced query = '.$/.$query); + return ($query,$customquery,$customshow,$libraries_to_query, + $pretty_search_string); +} + +sub parse_domain_restrictions { + my $libraries_to_query = undef; + # $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,'',undef); + } + my @allowed_domains = &Apache::loncommon::get_env_multiple('form.domains'); + # + my %domain_hash = (); + my $pretty_domains_string; + foreach (@allowed_domains) { + $domain_hash{$_}++; + } + if ($domain_hash{'any'}) { + $pretty_domains_string = &mt("in all LON-CAPA domains."); + } else { + if (@allowed_domains > 1) { + $pretty_domains_string = &mt("in LON-CAPA domains:"); + } else { + $pretty_domains_string = &mt("in LON-CAPA domain "); + } + foreach (sort @allowed_domains) { + $pretty_domains_string .= "".$_." "; + } + my %servers = &Apache::lonnet::get_unique_servers(\@allowed_domains, + 'library'); + $libraries_to_query = [keys(%servers)]; + } + return ($libraries_to_query, + $pretty_domains_string); +} + +###################################################################### +###################################################################### + +=pod + +=item &parse_basic_search() + +Parse the basic search form and return a scalar containing an sql query. + +=cut + +###################################################################### +###################################################################### +sub parse_basic_search { + my ($r,$closebutton)=@_; + # # 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. - next unless (exists($ENV{"form.$_"})); - $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); - $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; + next unless (exists($env{"form.$_"})); + $env{"form.$_"}=&unescape($env{"form.$_"}); + $env{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g; } - - # Check to see if enough is filled in - unless (&filled($ENV{'form.basicexp'})) { - &output_blank_field_error($r); + my ($libraries_to_query,$pretty_domains_string) = &parse_domain_restrictions(); + # + # Check to see if enough of a query is filled in + my $search_string = $env{'form.basicexp'}; + if (! &filled($search_string)) { + &output_blank_field_error($r,$closebutton,'phase=disp_basic'); return OK; } + my $pretty_search_string=$search_string; + my @Queries; + my @fields = ('title','author','subject','notes','abstract','keywords'); + my $searchfield; + if ($env{'form.area'} eq 'portfolio') { + $searchfield = 'concat_ws(" ",pm.'.join(',pm.',@fields).')'; + } else { + $searchfield = 'concat_ws(" ",'.join(',',@fields).')'; + } + 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); + #foreach my $q (@Queries) { + # &Apache::lonnet::logthis(' '.$q); + #} + my $final_query; + if ($env{'form.area'} eq 'portfolio') { + $final_query = 'SELECT pm.*,pa.keynum,pa.scope FROM portfolio_metadata pm, portfolio_access pa WHERE (pm.url = pa.url AND (pa.start < UTC_TIMESTAMP() AND (pa.end IS NULL OR pa.end > UTC_TIMESTAMP())) AND '.join(" AND ",@Queries).')'; + } else { + $final_query = 'SELECT * FROM metadata WHERE '.join(" AND ",@Queries); + } + # + if ($env{'form.related'}) { + $pretty_search_string.=' '.&mt('(including related words)'); + } + if (defined($pretty_domains_string) && $pretty_domains_string ne '') { + $pretty_search_string .= ' '.$pretty_domains_string; + } + $pretty_search_string .= "
\n"; + $pretty_search_string =~ s:^
and ::; + &Apache::lonnet::logthis('simple search final query = '.$/.$final_query); + return ($final_query,$pretty_search_string, + $libraries_to_query); +} - # Build SQL query string based on form page - my $query=''; - my $concatarg=join('," ",', - ('title', 'author', 'subject', 'notes', 'abstract')); - $concatarg='title' if $ENV{'form.titleonly'}; - - $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); - # Get reply (either a hash reference to filehandles or bad connection) - my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query); +############################################################### +############################################################### - # Output search results +my @Phrases; - &output_results('Basic',$r,$envhash,$query,$reply); +sub concat { + my ($item) = @_; + my $results = ''; + foreach (@$item) { + if (ref($_) eq 'ARRAY') { + $results .= join(' ',@$_); + } + } + return $results; +} - return OK; +sub process_phrase_input { + 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 ($phrase eq 'NOT') { + $phrasedata->{'negate'}++; + if (! @::Phrases) { $phrasedata = undef; last; } + $phrase = shift(@::Phrases); + } + } + $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 { + $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.')'; + } + } else { + $SQLQuery = '('.$query.')'; + } + } + # + # &Apache::lonnet::logthis("SQLQuery = $SQLQuery"); + # + return undef,$SQLQuery; } -# ------------------------------------------------------------- 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; +###################################################################### +###################################################################### + +=pod + +=item &related_version() + +Modifies an input string to include related words. Words in the string +are replaced with parenthesized lists of 'OR'd words. For example +"torque" is replaced with "(torque OR word1 OR word2 OR ...)". + +Note: Using this twice on a string is probably silly. + +=cut + +###################################################################### +###################################################################### +sub related_version { + my ($word) = @_; + return (undef) if (lc($word) =~ /\b(or|and|not)\b/); + my @Words = &Apache::loncommon::get_related_words($word); + # Only use 4 related words + @Words = ($#Words>4? @Words[0..4] : @Words); + my $result = join " OR ", ($word,@Words); + return $result,sort(@Words); } -# ------------------------------------------------- build custom metadata query + +###################################################################### +###################################################################### + +=pod + +=item &build_custommetadata_query() + +Constructs a custom metadata query using a rather heinous regular +expression. + +=cut + +###################################################################### +###################################################################### sub build_custommetadata_query { my ($field_name,$logic_statement)=@_; my $q=new Text::Query('abc', @@ -784,999 +2047,1970 @@ sub build_custommetadata_query { 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; + # wordone=wordtwo becomes\[^\<] *wordtwo[^\<]*\<\/wordone\> + $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to + /\\<$1\\>?# \ + \[\^\\<\]?# [^\<] + \*$2\[\^\\<\]?# *wordtwo[^\<] + \*\\<\\\/$1\\>?# *\<\/wordone\> + /g; 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 '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); -} -# ------------------------------------------------------------ Build date query +###################################################################### +###################################################################### + +=pod + +=item &build_date_queries() + +Builds a SQL logic query to check time/date entries. +Also reports errors (check for /^Incorrect/). + +=cut + +###################################################################### +###################################################################### 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; + my ($cafter,$cbefore,$mafter,$mbefore) = @_; + my ($result,$error,$pretty_string); + # + # Verify the input + if (! defined($cafter) && ! defined($cbefore) && + ! defined($mafter) && ! defined($mbefore)) { + # This is an okay situation, so return undef for the error + return (undef,undef,undef); + } + if ((defined($cafter) && ! defined($cbefore)) || + (defined($cbefore) && ! defined($cafter))) { + # This is bad, so let them know + $error = &mt('Incorrect entry for the creation date. '. + 'You must specify both the beginning and ending dates.'); + } + if (! defined($error) && + ((defined($mafter) && ! defined($mbefore)) || + (defined($mbefore) && ! defined($mafter)))) { + # This is also bad, so let them know + $error = &mt('Incorrect entry for the last revision date. '. + 'You must specify both the beginning and ending dates.'); + } + if (! defined($error)) { + # + # Build the queries + my @queries; + if (defined($cbefore) && defined($cafter)) { + my (undef,undef,undef,$caday,$camon,$cayear) = localtime($cafter); + my (undef,undef,undef,$cbday,$cbmon,$cbyear) = localtime($cbefore); + # Correct for year being relative to 1900 + $cayear+=1900; $cbyear+=1900; + my $cquery= + '(creationdate BETWEEN '. + "'".$cayear.'-'.$camon.'-'.$caday."'". + ' AND '. + "'".$cbyear.'-'.$cbmon.'-'.$cbday." 23:59:59')"; + $pretty_string .= '
' if (defined($pretty_string)); + $pretty_string .= + &mt('created between [_1] and [_2]', + &Apache::lonlocal::locallocaltime($cafter), + &Apache::lonlocal::locallocaltime($cbefore+24*60*60-1)); + push(@queries,$cquery); + $pretty_string =~ s/ 00:00:00//g; + } + if (defined($mbefore) && defined($mafter)) { + my (undef,undef,undef,$maday,$mamon,$mayear) = localtime($mafter); + my (undef,undef,undef,$mbday,$mbmon,$mbyear) = localtime($mbefore); + # Correct for year being relative to 1900 + $mayear+=1900; $mbyear+=1900; + my $mquery= + '(lastrevisiondate BETWEEN '. + "'".$mayear.'-'.$mamon.'-'.$maday."'". + ' AND '. + "'".$mbyear.'-'.$mbmon.'-'.$mbday." 23:59:59')"; + push(@queries,$mquery); + $pretty_string .= '
' if (defined($pretty_string)); + $pretty_string .= + &mt('last revised between [_1] and [_2]', + &Apache::lonlocal::locallocaltime($mafter), + &Apache::lonlocal::locallocaltime($mbefore+24*60*60-1)); + $pretty_string =~ s/ 00:00:00//g; + } + if (@queries) { + $result .= join(" AND ",@queries); + } } - if (@queries) { - return join(" AND ",@queries); + return ($result,$error,$pretty_string); +} + +###################################################################### +###################################################################### + +=pod + +=item ©right_check() + +Inputs: $Metadata, a hash pointer of metadata for a resource. + +Returns: 1 if the resource is available to the user making the query, + 0 otherwise. + +=cut + +###################################################################### +###################################################################### +sub copyright_check { + my $Metadata = shift; + # Check copyright tags and skip results the user cannot use + my (undef,undef,$resdom,$resname) = split('/', + $Metadata->{'url'}); + # Check for priv + if (($Metadata->{'copyright'} eq 'priv') && + (($env{'user.name'} ne $resname) && + ($env{'user.domain'} ne $resdom))) { + return 0; + } + # Check for domain + if (($Metadata->{'copyright'} eq 'domain') && + ($env{'user.domain'} ne $resdom)) { + return 0; + } + # Check for custom rights + if ($Metadata->{'copyright'} eq 'custom') { + return &Apache::lonnet::customaccess('bre',$Metadata->{'url'}); } - return ''; + return 1; } -# ----------------------------- format and output results based on a reply list -# There are two windows that this function writes to. The main search -# window ("srch") has a listing of the results. A secondary window ("popwin") -# gives the status of the network search (time elapsed, number of machines -# contacted, etc.) -sub output_results { - my $fnum; # search result counter - my ($mode,$r,$envhash,$query,$replyref)=@_; - my %ENV=%{$envhash}; - my %rhash=%{$replyref}; - my $compiledresult=''; - my $timeremain=300; - my $elapsetime=0; - my $resultflag=0; - my $tflag=1; +###################################################################### +###################################################################### - # make query information persistent to allow for subsequent revision - my $persistent=&make_persistent(); +=pod - # output beginning of search page - $r->print(< - -The LearningOnline Network with CAPA -BEGINNING +=item &ensure_db_and_table() - # conditional output of script functions dependent on the mode in - # which the search was invoked - if ($ENV{'form.catalogmode'} eq 'interactive'){ - if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { - $r->print(< - function select_data(title,url) { - changeTitle(title); - changeURL(url); - self.close(); +Ensure we can get lonmysql to connect to the database and the table we +need exists. + +Inputs: $r, table id + +Returns: undef on error, 1 if the table exists. + +=cut + +###################################################################### +###################################################################### +sub ensure_db_and_table { + my ($r,$table) = @_; + ## + ## Sanity check the table id. + ## + if (! defined($table) || $table eq '' || $table =~ /\D/ ) { + $r->print(&Apache::loncommon::start_page(&mt('Error')) +. '

table: |'.$table.'|

' # SB + .'

' + .&mt('Unable to retrieve search results. ' + .'Unable to determine the table results were saved in.') + .&Apache::loncommon::end_page() + ); + return undef; + } + ## + ## Make sure we can connect and the table exists. + ## + my $connection_result = &Apache::lonmysql::connect_to_db(); + if (!defined($connection_result)) { + $r->print("Unable to connect to the MySQL database where your results". + " are saved.". + &Apache::loncommon::end_page()); + &Apache::lonnet::logthis("lonsearchcat: unable to get lonmysql to". + " connect to database."); + &Apache::lonnet::logthis(&Apache::lonmysql::get_error()); + return undef; + } + my $table_check = &Apache::lonmysql::check_table($table); + if (! defined($table_check)) { + $r->print("A MySQL error has occurred.". + &Apache::loncommon::end_page()); + &Apache::lonnet::logthis("lonmysql was unable to determine the status". + " of table ".$table); + return undef; + } elsif (! $table_check) { + $r->print("The table of results could not be found."); + &Apache::lonnet::logthis("The user requested a table, ".$table. + ", that could not be found."); + return undef; } - function changeTitle(val) { - if (opener.inf.document.forms.resinfo.elements.t) { - opener.inf.document.forms.resinfo.elements.t.value=val; - } + return 1; +} + +###################################################################### +###################################################################### + +=pod + +=item &print_sort_form() + +The sort feature is not implemented at this time. This form just prints +a link to change the search query. + +=cut + +###################################################################### +###################################################################### +sub print_sort_form { + my ($r,$pretty_query_string) = @_; + + ## + my %SortableFields=&Apache::lonlocal::texthash( + id => 'Default', + title => 'Title', + author => 'Author', + subject => 'Subject', + url => 'URL', + version => 'Version Number', + mime => 'Mime type', + lang => 'Language', + owner => 'Owner/Publisher', + copyright => 'Copyright', + hostname => 'Host', + creationdate => 'Creation Date', + lastrevisiondate => 'Revision Date' + ); + ## + my $table = $env{'form.table'}; + return if (! &ensure_db_and_table($r,$table)); + ## + ## Get the number of results + ## + my $total_results = &Apache::lonmysql::number_of_rows($table); + if (! defined($total_results)) { + $r->print("A MySQL error has occurred.". + &Apache::loncommon::end_page()); + &Apache::lonnet::logthis("lonmysql was unable to determine the number". + " of rows in table ".$table); + &Apache::lonnet::logthis(&Apache::lonmysql::get_error()); + return; } - function changeURL(val) { - if (opener.inf.document.forms.resinfo.elements.u) { - opener.inf.document.forms.resinfo.elements.u.value=val; - } + my $js =< +// -SCRIPT - } elsif ($ENV{'form.mode'} eq 'edit') { - my $form = $ENV{'form.form'}; - my $element = $ENV{'form.element'}; - $r->print(< -function select_data(title,url) { - changeURL(url); - self.close(); -} -function changeTitle(val) { +END + + my $start_page = &Apache::loncommon::start_page('Results',$js); + my $breadcrumbs= + &Apache::lonhtmlcommon::breadcrumbs('Searching','Searching', + $env{'form.catalogmode'} ne 'import'); + + my $result = < + + +END + +#

Sort Results

+#Sort by: }; + return $result; +} + +###################################################################### +###################################################################### + +=pod + +=item &run_search() + +Executes a search query by sending it the the other servers and putting the +results into MySQL. + +=cut + +###################################################################### +###################################################################### +sub run_search { + my ($r,$query,$customquery,$customshow,$serverlist, + $pretty_string,$area) = @_; + my $tabletype = 'metadata'; + if ($area eq 'portfolio') { + $tabletype = 'portfolio_search'; } - function select_group() { - window.location= - "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ - document.forms.results.acts.value; + my $connection = $r->connection; + # + # Print run_search header + # + my $start_page = &Apache::loncommon::start_page('Search Status',undef); + my $breadcrumbs = + &Apache::lonhtmlcommon::breadcrumbs('Searching','Searching', + $env{'form.catalogmode'} ne 'import'); + $r->print(< + $pretty_string =~ s:^\s*
::i; + $pretty_string =~ s:(
)*\s*$::im; + my @Lines = split("
",$pretty_string); + # I keep getting blank items at the end of the list, hence the following: + while ($Lines[-1] =~ /^\s*$/ && @Lines) { + pop(@Lines); } - -SCRIPT - $r->print(< - function displayinfo(val) { - popwin.document.forms.popremain.sdetails.value=val; + if (@Lines > 2) { + $pretty_string = join '
',(@Lines[0..2],'...
'); } - function openhelp(val) { - openhelpwin=open('/adm/help/searchcat.html','helpscreen', - 'scrollbars=1,width=400,height=300'); - openhelpwin.focus(); + $r->print(&mt("Search: [_1]",$pretty_string)); + $r->rflush(); + # + # Determine the servers we need to contact. + my @Servers_to_contact; + if (defined($serverlist)) { + if (ref($serverlist) eq 'ARRAY') { + @Servers_to_contact = @$serverlist; + } else { + @Servers_to_contact = ($serverlist); + } + } else { + my %all_library_servers = &Apache::lonnet::unique_library(); + @Servers_to_contact = sort(keys(%all_library_servers)); } - function abortsearch(val) { - popwin.close(); + my %Server_status; + # + # Check on the mysql table we will use to store results. + my $table =$env{'form.table'}; + if (! defined($table) || $table eq '' || $table =~ /\D/ ) { + $r->print("Unable to determine table id to save search results in.". + "The search has been aborted.". + &Apache::loncommon::end_page()); + return; + } + my $table_status = &Apache::lonmysql::check_table($table); + if (! defined($table_status)) { + $r->print("Unable to determine status of table.". + &Apache::loncommon::end_page()); + &Apache::lonnet::logthis("Bogus table id of $table for ". + "$env{'user.name'} @ $env{'user.domain'}"); + &Apache::lonnet::logthis("lonmysql error = ". + &Apache::lonmysql::get_error()); + return; + } + if (! $table_status) { + &Apache::lonnet::logthis("lonmysql error = ". + &Apache::lonmysql::get_error()); + &Apache::lonnet::logthis("lonmysql debug = ". + &Apache::lonmysql::get_debug()); + &Apache::lonnet::logthis('table status = "'.$table_status.'"'); + $r->print("The table id,$table, we tried to use is invalid.". + "The search has been aborted.". + &Apache::loncommon::end_page()); + return; + } + ## + ## Prepare for the big loop. + my $hitcountsum; + my %matches; + my $server; + my $status; + my $revise = &revise_button(); + $r->print('
'."\n". + ''."\n". + '' + .'' + .'' + .&Apache::loncommon::end_data_table_header_row() + .&Apache::loncommon::start_data_table_row() + .'' + .'' + .'' + .&Apache::loncommon::end_data_table_row() + .&Apache::loncommon::end_data_table() + .'
'."\n". + &Apache::loncommon::start_data_table()); + $r->print(&Apache::loncommon::start_data_table_header_row() + .''.&mt('Status').''.&mt('Total Matches').''.&mt('Time Remaining').' '.$revise.'
'); + $r->rflush(); + &reset_timing(); + &update_seconds($r); + &update_status($r,&mt('contacting [_1]',$Servers_to_contact[0])); + while (&time_left() && + ((@Servers_to_contact) || keys(%Server_status))) { + &update_seconds($r); + # + # Send out a search request + if (@Servers_to_contact) { + # Contact one server + my $server = shift(@Servers_to_contact); + &update_status($r,&mt('contacting [_1]',$server)); + my $reply=&Apache::lonnet::metadata_query($query,$customquery, + $customshow,[$server]); + ($server) = keys(%$reply); + $Server_status{$server} = $reply->{$server}; + } else { + # wait a sec. to give time for files to be written + # This sleep statement is here instead of outside the else + # block because we do not want to pause if we have servers + # left to contact. + if (scalar (keys(%Server_status))) { + &update_status($r, + &mt('waiting on [_1]',join(' ',keys(%Server_status)))); + } + sleep(1); + } + # + # Loop through the servers we have contacted but do not + # have results from yet, looking for results. + foreach my $server (keys(%Server_status)) { + last if ($connection->aborted()); + &update_seconds($r); + my $status = $Server_status{$server}; + if ($status eq 'con_lost') { + delete ($Server_status{$server}); + next; + } + $status=~s|/||g; + my $datafile=$r->dir_config('lonDaemons').'/tmp/'.$status; + if (-e $datafile && ! -e "$datafile.end") { + &update_status($r,&mt('Receiving results from [_1]',$server)); + next; + } + last if ($connection->aborted()); + if (-e "$datafile.end") { + &update_status($r,&mt('Reading results from [_1]',$server)); + if (-z "$datafile") { + delete($Server_status{$server}); + next; + } + my $fh; + if (!($fh=Apache::File->new($datafile))) { + $r->print("Unable to open search results file for ". + "server $server. Omitting from search"); + delete($Server_status{$server}); + next; + } + # Read in the whole file. + while (my $result = <$fh>) { + last if ($connection->aborted()); + # + # Records are stored one per line + chomp($result); + next if (! $result); + # + # Parse the result. + my %Fields = &parse_raw_result($result,$server,$tabletype); + $Fields{'hostname'} = $server; + # + # Skip based on copyright + next if (! ©right_check(\%Fields)); + + if ($area eq 'portfolio') { + next if (defined($matches{$Fields{'url'}})); + # Skip if inaccessible + next if (!&Apache::lonnet::portfolio_access($Fields{'url'})); + $matches{$Fields{'url'}} = 1; + } + # + # Store the result in the mysql database + my $result = &Apache::lonmysql::store_row($table,\%Fields); + if (! defined($result)) { + $r->print(&Apache::lonmysql::get_error()); + } + # + $hitcountsum ++; + &update_seconds($r); + if ($hitcountsum % 50 == 0) { + &update_count_status($r,$hitcountsum); + } + } + $fh->close(); + # $server is only deleted if the results file has been + # found and (successfully) opened. This may be a bad idea. + delete($Server_status{$server}); + } + last if ($connection->aborted()); + &update_count_status($r,$hitcountsum); + } + last if ($connection->aborted()); + &update_seconds($r); } + &update_status($r,&mt('Search Complete on Server [_1]',$server)); + &update_seconds($r); + # + &Apache::lonmysql::disconnect_from_db(); # This is unneccessary + # + # We have run out of time or run out of servers to talk to and + # results to get, so let the client know the top frame needs to be + # loaded from /adm/searchcat + $r->print(&Apache::loncommon::end_page()); +# if ($env{'form.catalogmode'} ne 'import') { + $r->print(< +window.location='/adm/searchcat?phase=sort&persistent_db_id=$env{'form.persistent_db_id'}'; SCRIPT - $r->rflush(); +# } + return; +} - # begin showing the cataloged results - $r->print(< - - -

Search Catalog

-CATALOGBEGIN - $r->print(< -$hidden - - -$importbutton -$closebutton -$persistent -
-

Search Query

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

-RESULTS +###################################################################### +###################################################################### + +=pod + +=item &prev_next_buttons() + +Returns html for the previous and next buttons on the search results page. + +=cut + +###################################################################### +###################################################################### +sub prev_next_buttons { + my ($current_min,$show,$total,$parms) = @_; + return '' if ($show eq 'all'); # No links if you get them all at once. + # + # Create buttons + return '

' + .'' + .' ' + .'' + .' ' + .'' + .'

'; +} + +###################################################################### +###################################################################### + +=pod + +=item &display_results() + +Prints the results out for selection and perusal. + +=cut + +###################################################################### +###################################################################### +sub display_results { + my ($r,$importbutton,$closebutton,$diropendb,$area) = @_; + my $connection = $r->connection; + $r->print(&search_results_header($importbutton,$closebutton)); + ## + ## Set viewing function + ## + my $viewfunction = $Views{$env{'form.viewselect'}}; + if (!defined($viewfunction)) { + $r->print('

' + .&mt('Internal Error - Bad view selected.') + .'

'."\n"); + $r->rflush(); + return; + } + ## + ## $checkbox_num is a count of the number of checkboxes output on the + ## page this is used only during catalogmode=import. + my $checkbox_num = 0; + ## + ## Get the catalog controls setup + ## + my $action = "/adm/searchcat?phase=results"; + ## + ## Deal with import by opening the import db file. + if ($env{'form.catalogmode'} eq 'import') { + if (! tie(%groupsearch_db,'GDBM_File',$diropendb, + &GDBM_WRCREAT(),0640)) { + $r->print('

'. + &mt('Unable to save import results.'). + '

'. + ''. + &Apache::loncommon::end_page()); + $r->rflush(); + return; + } + } + ## + ## Prepare the table for querying + my $table = $env{'form.table'}; + return if (! &ensure_db_and_table($r,$table)); + ## + ## Get the number of results + my $total_results = &Apache::lonmysql::number_of_rows($table); + if (! defined($total_results)) { + $r->print('

'. + &mt('A MySQL error has occurred.'). + '

'. + ''. + &Apache::loncommon::end_page()); + &Apache::lonnet::logthis("lonmysql was unable to determine the number". + " of rows in table ".$table); + &Apache::lonnet::logthis(&Apache::lonmysql::get_error()); + return; + } + ## + ## Determine how many results we need to get + $env{'form.start'} = 1 if (! exists($env{'form.start'})); + $env{'form.show'} = 20 if (! exists($env{'form.show'})); + if (exists($env{'form.prev'})) { + $env{'form.start'} -= $env{'form.show'}; + } elsif (exists($env{'form.next'})) { + $env{'form.start'} += $env{'form.show'}; + } + $env{'form.start'} = 1 if ($env{'form.start'}<1); + $env{'form.start'} = $total_results if ($env{'form.start'}>$total_results); + my $min = $env{'form.start'}; + my $max; + if ($env{'form.show'} eq 'all') { + $max = $total_results ; + } else { + $max = $min + $env{'form.show'} - 1; + $max = $total_results if ($max > $total_results); } - elsif ($mode eq 'Advanced') { - $r->print(< -Advanced search -$query -

-RESULTS + ## + ## Output form elements + $r->print(&hidden_field('table'). + &hidden_field('phase'). + &hidden_field('persistent_db_id'). + &hidden_field('start'). + &hidden_field('area') + ); + # + # Build sorting selector + my @fields = + ( + {key=>'default' }, + {key=>'title' }, + {key =>'author' }, + {key =>'subject'}, + {key =>'url',desc=>'URL'}, + {key =>'keywords'}, + {key =>'language'}, + {key =>'creationdate'}, + {key =>'lastrevisiondate'}, + {key =>'owner'}, + {key =>'copyright'}, + {key =>'authorspace'}, + {key =>'lowestgradelevel'}, + {key =>'highestgradelevel'}, + {key =>'standards',desc=>'Standards'}, + ); + if ($area eq 'portfolio') { + push(@fields, + ( + {key => 'scope'}, + {key => 'keynum'}, + )); + } else { + push(@fields, + ( + {key =>'count',desc=>'Number of accesses'}, + {key =>'stdno',desc=>'Students Attempting'}, + {key =>'avetries',desc=>'Average Number of Tries'}, + {key =>'difficulty',desc=>'Mean Degree of Difficulty'}, + {key =>'disc',desc=>'Mean Degree of Discrimination'}, + {key =>'clear',desc=>'Evaluation: Clear'}, + {key =>'technical',desc=>'Evaluation: Technically Correct'}, + {key =>'correct',desc=>'Evaluation: Material is Correct'}, + {key =>'helpful',desc=>'Evaluation: Material is Helpful'}, + {key =>'depth',desc=>'Evaluation: Material has Depth'}, + )); + } + my %fieldnames = &Apache::lonmeta::fieldnames(); + my @field_order; + foreach my $field_data (@fields) { + push(@field_order,$field_data->{'key'}); + if (! exists($field_data->{'desc'})) { + $field_data->{'desc'}=$fieldnames{$field_data->{'key'}}; + } else { + if (! defined($field_data->{'desc'})) { + $field_data->{'desc'} = ucfirst($field_data->{'key'}); + } + $field_data->{'desc'} = &mt($field_data->{'desc'}); + } } - $r->print('

Search Results

'); - $r->rflush(); - my $servernum=(keys %rhash)+0; - - # define server grid (shows status of multiple machines) - my $hcinit; - my $grid="'
'+"; - $grid.="\n"; - my $sn=1; - for my $sk (sort keys %rhash) { - # ''+ - $grid.="'+\"'\"+')\">'+"; - $grid.="\n"; - $grid.="'\"".$sk."\"'+\n"; - $grid.="'
'+\n" unless $sn%10; - $sn++; + my %sort_fields = map {$_->{'key'},$_->{'desc'}} @fields; + $sort_fields{'select_form_order'} = \@field_order; + $env{'form.sortorder'} = 'desc' if (! exists($env{'form.sortorder'})); + if (! exists($env{'form.sortfield'})) { + if ($area eq 'portfolio') { + $env{'form.sortfield'} = 'owner'; + } else { + $env{'form.sortfield'} = 'count'; + } } - $r->print(< - popwin=open('','popwin','scrollbars=1,width=400,height=220'); - popwin.focus(); - popwin.document.writeln('<'+'html>'); - popwin.document.writeln('<'+'head>'); - popwin.document.writeln('<'+'script>'); - popwin.document.writeln('hc=new Array();$hcinit'); - popwin.document.writeln('<'+'/script>'); - popwin.document.writeln('<'+'/head>'+ - '<'+'body bgcolor="#FFFFFF">'+ - '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+ - 'lonanim.gif" '+ - 'alt="animated logo" />'+ - '<'+'h3>Search Results Progress<'+'/h3>'+ - '<'+'form name="popremain">'+ - '<'+'tt>'+ - '<'+'br clear="all"/>PLEASE BE PATIENT'+ - '<'+'br />SCANNING $servernum SERVERS'+ - '<'+'br clear="all" />Number of record hits found '+ - '<'+'input type="text" size="10" name="numhits"'+ - ' value="0" />'+ - '<'+'br clear="all" />Time elapsed '+ - '<'+'input type="text" size="10" name="elapsetime"'+ - ' value="0" />'+ - '<'+'br />'+ - 'SERVER GRID (click on any cell for details)'+ - $grid - '<'+'br />'+ - 'Server details '+ - '<'+'input type="text" size="35" name="sdetails"'+ - ' value="" />'+ - '<'+'br />'+ - ' <'+'input type="button" name="button"'+ - ' value="close this window" '+ - ' onClick="javascript:opener.abortsearch()" />'+ - ' <'+'input type="button" name="button"'+ - ' value="help" onClick="javascript:opener.openhelp()" />'+ - '<'+'/tt>'+ - '<'+'/form>'+ - '<'+'/body><'+'/html>'); - popwin.document.close(); - -ENDPOP + if (! exists($env{'form.sortorder'})) { + if ($env{'form.sortfield'}=~/^(count|stdno|disc|clear|technical|correct|helpful)$/) { + $env{'form.sortorder'}='desc'; + } else { + $env{'form.sortorder'}='asc'; + } + } + my $sortform = '' + .&mt('Sort by:').' ' + .&Apache::loncommon::select_form($env{'form.sortfield'}, + 'sortfield', + %sort_fields) + .' ' + .&Apache::loncommon::select_form($env{'form.sortorder'}, + 'sortorder', + (asc =>&mt('Ascending'), + desc=>&mt('Descending') + )) + .''; + ## + ## Display links for 'prev' and 'next' pages (if necessary) and Display Options + $r->print('
'."\n" + .''.&mt('Display Options').''."\n" + .$sortform + .' ' + .&viewoptions() + .'
' + .&prev_next_buttons($min,$env{'form.show'},$total_results) + ); + + if ($total_results == 0) { + $r->print(''. + '

'.&mt('There are currently no results.').'

'. + "". + &Apache::loncommon::end_page()); + return; + } else { + $r->print('
'. + mt('Results [_1] to [_2] out of [_3]', + $min,$max,$total_results). + "
\n"); + } + ## + ## Get results from MySQL table + my $sort_command = 'id>='.$min.' AND id<='.$max; + my $order; + if (exists($env{'form.sortorder'})) { + if ($env{'form.sortorder'} eq 'asc') { + $order = 'ASC'; + } elsif ($env{'form.sortorder'} eq 'desc') { + $order = 'DESC'; + } else { + $order = ''; + } + } else { + $order = ''; + } + if ($env{'form.sortfield'} ne 'default' && + exists($sort_fields{$env{'form.sortfield'}})) { + $sort_command = $env{'form.sortfield'}.' IS NOT NULL '. + 'ORDER BY '.$env{'form.sortfield'}.' '.$order. + ' LIMIT '.($min-1).','.($max-$min+1); + } + my @Results = &Apache::lonmysql::get_rows($table,$sort_command); + ## + ## Loop through the results and output them. + my $tabletype = 'metadata'; + if ($area eq 'portfolio') { + $tabletype = 'portfolio_search'; + } + $r->print(&Apache::loncommon::start_data_table()); + foreach my $row (@Results) { + if ($connection->aborted()) { + &cleanup(); + return; + } + my %Fields = %{&parse_row($tabletype,@$row)}; + my $output; + if (! defined($Fields{'title'}) || $Fields{'title'} eq '') { + $Fields{'title'} = 'Untitled'; + } + my $prefix=&catalogmode_output($Fields{'title'},$Fields{'url'}, + $Fields{'id'},$checkbox_num++); + # Render the result into html + $output.= &$viewfunction($prefix,%Fields); + # Print them out as they come in. + $r->print(&Apache::loncommon::start_data_table_row() + .'' + .$output + .'' + .&Apache::loncommon::end_data_table_row() + ); + $r->rflush(); + } + $r->print(&Apache::loncommon::end_data_table()); + if (@Results < 1) { + $r->print('

' + .&mt('There were no results matching your query.') + .'

'); + } else { + $r->print( + &prev_next_buttons($min,$env{'form.show'},$total_results, + "table=".$env{'form.table'}. + "&phase=results". + "&persistent_db_id=". + $env{'form.persistent_db_id'}) + ); + } + $r->print("".&Apache::loncommon::end_page()); $r->rflush(); + untie %groupsearch_db if (tied(%groupsearch_db)); + return; +} - my $servercount=0; - my $hitcountsum=0; - my $bloop=$servernum; - my %orkey; - BLOOP: while(1) { - my $sn=0; - last BLOOP unless $bloop; - last BLOOP unless $timeremain; - RLOOP: foreach my $rkey (sort keys %rhash) { - $sn++; - next RLOOP if $orkey{$rkey}; - $servercount++; - $tflag=1; - $compiledresult=''; - my $hostname=$rkey; - my $reply=$rhash{$rkey}; - my @results; - - my $replyfile=''; - - if ($reply eq 'con_lost') { - &popwin_imgupdate($r,$sn,"srvbad.gif"); - $bloop--; - $orkey{$rkey}=1; - } - else { - $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting - $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; - $reply=~/(.*?)\_/; - { - my $temp=0; - WLOOP: while (1) { - if (-e $replyfile && $tflag) { - &popwin_imgupdate($r,$sn,"srvhalf.gif"); - &popwin_js($r,'popwin.hc["'.$rkey.'"]='. - '"still transferring..."'.';'); - $tflag=0; - } - if (-e "$replyfile.end") { - $bloop--; - $orkey{$rkey}=1; - if (-s $replyfile) { - &popwin_imgupdate($r,$sn,"srvgood.gif"); - my $fh=Apache::File->new($replyfile) or - ($r->print('ERROR: file '. - $replyfile.' cannot be opened') and - return OK); - @results=<$fh> if $fh; - $hitcount{$rkey}=@results+0; - &popwin_js($r,'popwin.hc["'.$rkey.'"]='. - $hitcount{$rkey}.';'); - $hitcountsum+=$hitcount{$rkey}; - &popwin_js($r,'popwin.document.forms.popremain.'. - 'numhits.value='.$hitcountsum.';'); - } - else { - &popwin_imgupdate($r,$sn,"srvempty.gif"); - &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); - } - last WLOOP; - } - if ($temp>1) { - sleep 1; - $timeremain--; - $elapsetime++; - last WLOOP; - } - last WLOOP unless $timeremain; - sleep 1; - $timeremain--; - $elapsetime++; - &popwin_js($r,"popwin.document.popremain.". - "elapsetime.value=$elapsetime;"); - $temp++; - } - } - &popwin_js($r,'popwin.document.whirly.'. - 'src="/adm/lonIcons/lonanimend.gif";'); - } - 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; - } - } - if (keys %hash) { - untie %hash; - } - if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { - if ($ENV{'form.launch'} eq '1') { - &start_fresh_session(); - } - 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; - - unless ($title) { $title='Untitled'; } - unless ($ENV{'user.adv'}) { - $keywords='- not displayed -'; - $fields[4]=$keywords; - $notes='- not displayed -'; - $fields[6]=$notes; - $abstract='- not displayed -'; - $fields[7]=$abstract; - $subject='- not displayed -'; - $fields[2]=$subject; - } +###################################################################### +###################################################################### - my $shortabstract=$abstract; - $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200; - $fields[7]=$shortabstract; - my $shortkeywords=$keywords; - $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200; - $fields[4]=$shortkeywords; - - 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 - if ($ENV{'form.catalogmode'} eq 'interactive') { - my $titleesc=$title; - $titleesc=~s/\'/\\'/; # ' - - $compiledresult.=< +=pod + +=item &catalogmode_output($title,$url,$fnum,$checkbox_num) + +Returns html needed for the various catalog modes. Gets inputs from +$env{'form.catalogmode'}. Stores data in %groupsearch_db. + +=cut + +###################################################################### +###################################################################### +sub catalogmode_output { + my $output = ''; + my ($title,$url,$fnum,$checkbox_num) = @_; + if ($env{'form.catalogmode'} eq 'interactive') { + $title=~ s/\'/\\\'/g; + if ($env{'form.catalogmode'} eq 'interactive') { + $output.=< -
END - } - if ($ENV{'form.catalogmode'} eq 'groupsearch') { - $fnum+=0; - $hash{"pre_${fnum}_link"}=$url; - $hash{"pre_${fnum}_title"}=$title; - $compiledresult.=< - + -
END -# -# - $fnum++; - } - my $httphost=$ENV{'HTTP_HOST'}; + } + return $output; +} +###################################################################### +###################################################################### - my $viewselect; - if ($mode eq 'Basic') { - $viewselect=$ENV{'form.basicviewselect'}; - } - elsif ($mode eq 'Advanced') { - $viewselect=$ENV{'form.advancedviewselect'}; - } +=pod - 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); - } - - } +=item &parse_row() - untie %hash; - } - else { - $r->print('Unable to tie hash to db '. - 'file'); - } - if ($compiledresult) { - $resultflag=1; - } +Parse a row returned from the database. - $r->print(<print("\nThere were no results that matched your query\n"); - } -# $r->print(''."\n"); $r->rflush(); - $r->print(< - -RESULTS -} +=cut -# ------------------------------------------------------ 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: -END - $result.=&Apache::loncommon::filedescription($mime); - $result.=< -Language: -END - $result.=&Apache::loncommon::languagedescription($lang); - $result.=< -Copyright/Distribution: -END - $result.=&Apache::loncommon::copyrightdescription($copyright); - $result.=< -

-$extrashow -

-$shortabstract -

-END - return $result; +###################################################################### +###################################################################### +sub parse_row { + my ($tabletype,@Row) = @_; + my %Fields; + if (! scalar(@Datatypes)) { + &set_up_table_structure($tabletype); + } + for (my $i=0;$i<=$#Row;$i++) { + $Fields{$Datatypes[$i]->{'name'}}=&unescape($Row[$i]); + } + $Fields{'language'} = + &Apache::loncommon::languagedescription($Fields{'language'}); + $Fields{'copyrighttag'} = + &Apache::loncommon::copyrightdescription($Fields{'copyright'}); + $Fields{'mimetag'} = + &Apache::loncommon::filedescription($Fields{'mime'}); + return \%Fields; } -# ---------------------------------------------------------------- Summary View -sub summary_view { - my ($title,$author,$subject,$url,$keywords,$version, - $notes,$shortabstract,$mime,$lang, - $creationdate,$lastrevisiondate,$owner,$copyright, - $hostname,$httphost,$extrashow)=@_; - my $cprtag=&Apache::loncommon::copyrightdescription($copyright); - my $result=<$author
-$title
-$owner -- $lastrevisiondate
-$cprtag
-$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 $mimetag=&Apache::loncommon::filedescription($mime); - my $language=&Apache::loncommon::languagedescription($lang); - my $cprtag=&Apache::loncommon::copyrightdescription($copyright); - my $result=<URL: $url -
-Title: $title
-Author(s): $author
-Subject: $subject
-Keyword(s): $keywords
-Notes: $notes
-MIME Type: $mimetag
-Language: $language
-Creation Date: $creationdate
-Last Revision Date: $lastrevisiondate
-Publisher/Owner: $owner
-Copyright/Distribution: $cprtag
-Repository Location: $hostname
-Abstract: $shortabstract
-$extrashow -

-END - return $result; -} +=pod -# -------------------------------------------------------------------- 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 $cprtag=&Apache::loncommon::copyrightdescription($copyright); - my $mimetag=&Apache::loncommon::filedescription($mime); - my $language=&Apache::loncommon::languagedescription($lang); - 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</mimetag> -</mimeInfo> -<languageInfo> -<language>$lang</language> -<languagetag>$language</languagetag> -</languageInfo> -<creationdate>$creationdate</creationdate> -<lastrevisiondate>$lastrevisiondate</lastrevisiondate> -<owner>$owner</owner> -<copyrightInfo> -<copyright>$copyright</copyright> -<copyrighttag>$cprtag</copyrighttag> -</copyrightInfo> -<repositoryLocation>$hostname</repositoryLocation> -<shortabstract>$shortabstract</shortabstract> -</LonCapaResource> - -$extrashow -END - return $result; +=item &parse_raw_result() + +Takes a line from the file of results and parse it. Returns a hash +with keys according to column labels + +In addition, the following tags are set by calling the appropriate +lonnet function: 'language', 'copyrighttag', 'mimetag'. + +The 'title' field is set to "Untitled" if the title field is blank. + +'abstract' and 'keywords' are truncated to 200 characters. + +=cut + +########################################################### +########################################################### +sub parse_raw_result { + my ($result,$hostname,$tabletype) = @_; + # conclude from self to others regarding fields + my %Fields=&LONCAPA::lonmetadata::metadata_col_to_hash + ($tabletype, + map { + &unescape($_); + } (split(/\,/,$result)) ); + return %Fields; } -# ---------------------------------------------------- see if a field is filled -sub filled { - my ($field)=@_; - if ($field=~/\S/ && $field ne 'any') { - return 1; +########################################################### +########################################################### + +=pod + +=item &handle_custom_fields() + +=cut + +########################################################### +########################################################### +sub handle_custom_fields { + my @results = @{shift()}; + 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"; + } } - else { - return 0; + 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 {&unescape($_); + } split(/\,/,$tmp); + $customhash{$k}=$v; + } } + return ($extrashow,\@customfields,\%customhash); } -# ---------------- 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 -} +=pod -# ----------------------------------------------------------- Output date error -sub output_date_error { - my ($r,$message)=@_; - # make query information persistent to allow for subsequent revision - my $persistent=&make_persistent(); +=item &search_results_header() - $r->print(< - -The LearningOnline Network with CAPA -BEGINNING - $r->print(< - - -

Search Catalog

- -$persistent - -$closebutton -
-

Helpful Message

-

-$message -

- - -RESULTS -} +Output the proper html headers and javascript code to deal with different +calling modes. -# --------- settings whenever the user causes the search window to be launched -sub start_fresh_session { - delete $hash{'mode_catalog'}; - foreach (keys %hash) { - if ($_ =~ /^pre_/) { - delete $hash{$_}; - } - if ($_ =~ /^store/) { - delete $hash{$_}; +Takes most inputs directly from %env, except $mode. + +=over 4 + +=item $mode is either (at this writing) 'Basic' or 'Advanced' + +=back + +The following environment variables are checked: + +=over 4 + +=item 'form.catalogmode' + +Checked for 'interactive' and 'import'. + +=item 'form.mode' + +Checked for existance & 'edit' mode. + +=item 'form.form' + +Contains the name of the form that has the input fields to set + +=item 'form.element' + +the name of the input field to put the URL into + +=item 'form.titleelement' + +the name of the input field to put the title into + +=back + +=cut + +###################################################################### +###################################################################### +sub search_results_header { + my ($importbutton,$closebutton) = @_; + + my $js; + # output beginning of search page + # conditional output of script functions dependent on the mode in + # which the search was invoked + if ($env{'form.catalogmode'} eq 'interactive'){ + if (! exists($env{'form.mode'}) || $env{'form.mode'} ne 'edit') { + $js.=< +// + +SCRIPT + } elsif ($env{'form.mode'} eq 'edit') { + my $form = $env{'form.form'}; + my $element = $env{'form.element'}; + my $titleelement = $env{'form.titleelement'}; + my $changetitle; + if (!$titleelement) { + $changetitle='function changeTitle(val) {}'; + } else { + $changetitle=<print(<<"END"); + $js.=< +// + +SCRIPT + } + } + my $inhibit_menu = "&".&Apache::loncommon::inhibit_menu_check(); + $js.=< +SCRIPT + + my $start_page = &Apache::loncommon::start_page(undef,$js, + {'only_body' =>1}); + my $result=< +$importbutton END - $r->rflush(); + return $result; } -sub popwin_imgupdate { - my ($r,$imgnum,$icon) = @_; - &popwin_js($r,'popwin.document.img'.$imgnum.'.'. - 'src="/adm/lonIcons/'.$icon.'";'); -} - -1; - -__END__ - -=pod - -=back +sub results_link { + my $basic_link = "/adm/searchcat?"."&table=".$env{'form.table'}. + "&persistent_db_id=".$env{'form.persistent_db_id'}; + my $results_link = $basic_link."&phase=results". + "&pause=1"."&start=1"; + return $results_link; +} -=over 4 +###################################################################### +###################################################################### +sub print_frames_interface { + my $r = shift; + my $basic_link = "/adm/searchcat?"."&table=".$env{'form.table'}. + "&persistent_db_id=".$env{'form.persistent_db_id'}; + my $run_search_link = $basic_link."&phase=run_search"; + my $results_link = &results_link(); + my $js = < +// + +JS -=head1 HANDLER SUBROUTINE + my $start_page = + &Apache::loncommon::start_page('LON-CAPA Digital Library Search Results', + $js, + {'frameset' => 1, + 'add_entries' => { + 'rows' => "150,*",},}); + my $end_page = + &Apache::loncommon::end_page({'frameset' => 1}); + + my $result = <<"ENDFRAMES"; +$start_page + + +$end_page +ENDFRAMES -This routine is called by Apache and mod_perl. + $r->print($result); + return; +} -=over 4 +###################################################################### +###################################################################### -=item * +sub has_stat_data { + my ($values) = @_; + if ( (defined($values->{'count'}) && $values->{'count'} ne '') || + (defined($values->{'stdno'}) && $values->{'stdno'} ne '') || + (defined($values->{'disc'}) && $values->{'disc'} ne '') || + (defined($values->{'avetries'}) && $values->{'avetries'} ne '') || + (defined($values->{'difficulty'}) && $values->{'difficulty'} ne '')) { + return 1; + } + return 0; +} -configure dynamic components of interface +sub statfields { + return ('count','stdno','disc','avetries','difficulty'); +} -=item * +sub has_eval_data { + my ($values) = @_; + if ( (defined($values->{'clear'}) && $values->{'clear'} ne '') || + (defined($values->{'technical'}) && $values->{'technical'} ne '') || + (defined($values->{'correct'}) && $values->{'correct'} ne '') || + (defined($values->{'helpful'}) && $values->{'helpful'} ne '') || + (defined($values->{'depth'}) && $values->{'depth'} ne '')) { + return 1; + } + return 0; +} -determine current user +sub evalfields { + return ('clear','technical','correct','helpful','depth'); +} -=item * +###################################################################### +###################################################################### -see if a search invocation should be done +=pod -=item * +=item Metadata Viewing Functions -else, begin building search interface to output +Output is a HTML-ified string. -=item * +Input arguments are title, author, subject, url, keywords, version, +notes, short abstract, mime, language, creation date, +last revision date, owner, copyright, hostname, and +extra custom metadata to show. -compute date selection boxes +=over 4 -=item * +=item &detailed_citation_view() -compute customized metadata field +=cut -=item * +###################################################################### +###################################################################### +sub detailed_citation_view { + my ($prefix,%values) = @_; + my $result; + my $jumpurl=$values{'url'}; + $jumpurl=~s|^/ext/|http://|; + $result .= ''.$prefix. + ''.' '. + ''.$values{'title'}."\n"; + $result .= "

\n"; + $result .= ''.$values{'author'}.','. + ' '.$values{'owner'}.'
'; + foreach my $field + ( + { name=>'url', + translate => 'URL: [_1]', + special => 'url link',}, + { name=>'subject', + translate => 'Subject: [_1]',}, + { name=>'keywords', + translate => 'Keywords: [_1]',}, + { name=>'notes', + translate => 'Notes: [_1]',}, + { name=>'mimetag', + translate => 'MIME Type: [_1]',}, + { name=>'standards', + translate => 'Standards:[_1]',}, + { name=>'copyrighttag', + translate => 'Copyright/Distribution: [_1]',}, + { name=>'count', + format => "%d", + translate => 'Access Count: [_1]',}, + { name=>'stdno', + format => "%d", + translate => 'Number of Students: [_1]',}, + { name=>'avetries', + format => "%.2f", + translate => 'Average Tries: [_1]',}, + { name=>'disc', + format => "%.2f", + translate => 'Degree of Discrimination: [_1]',}, + { name=>'difficulty', + format => "%.2f", + translate => 'Degree of Difficulty: [_1]',}, + { name=>'clear', + format => "%.2f", + translate => 'Clear: [_1]',}, + { name=>'depth', + format => "%.2f", + translate => 'Depth: [_1]',}, + { name=>'helpful', + format => "%.2f", + translate => 'Helpful: [_1]',}, + { name=>'correct', + format => "%.2f", + translate => 'Correct: [_1]',}, + { name=>'technical', + format => "%.2f", + translate => 'Technical: [_1]',}, + { name=>'comefrom_list', + type => 'list', + translate => 'Resources that lead up to this resource in maps',}, + { name=>'goto_list', + type => 'list', + translate => 'Resources that follow this resource in maps',}, + { name=>'sequsage_list', + type => 'list', + translate => 'Resources using or importing resource',}, + ) { + next if (! exists($values{$field->{'name'}}) || + $values{$field->{'name'}} eq ''); + if (exists($field->{'type'}) && $field->{'type'} eq 'list') { + $result .= ''.&mt($field->{'translate'}).''; + foreach my $item (split(',',$values{$field->{'name'}})){ + $item = &Apache::lonnet::clutter($item); + $result .= '
'.&display_url($item,1).'
'; + } + } elsif (exists($field->{'format'}) && $field->{'format'} ne ''){ + $result.= &mt($field->{'translate'}, + sprintf($field->{'format'}, + $values{$field->{'name'}}))."
\n"; + } else { + if ($field->{'special'} eq 'url link') { + $result .= '
'.&display_url($jumpurl,1).'
'; + } else { + $result.= &mt($field->{'translate'}, + $values{$field->{'name'}}); + } + $result .= "
\n"; + } + } + $result .= "

"; + if (exists($values{'extrashow'}) && $values{'extrashow'} ne '') { + $result .= '

'.$values{'extrashow'}.'

'; + } + if (exists($values{'shortabstract'}) && $values{'shortabstract'} ne '') { + $result .= '

'.$values{'shortabstract'}.'

'; + } + return $result; +} -print screen +sub detailed_citation_preview { + my ($prefix,%values)=@_; + return &detailed_citation_view($prefix,%values). + ''. + &Apache::lonindexer::showpreview($values{'url'}); +} -=back -=head1 OTHER SUBROUTINES +###################################################################### +###################################################################### -=over 4 +=pod -=item * +=item &summary_view() -get_unprocessed_cgi() : reads in critical name/value pairs that may have not -been processed and passed into %ENV by the web server +=cut +###################################################################### +###################################################################### +sub summary_view { + my ($prefix,%values) = @_; + my $icon=&Apache::loncommon::icon($values{'url'}); + my $result=qq{$prefix}; + if (exists($env{'form.sortfield'}) && + $env{'form.sortfield'} !~ /^(default| + author| + url| + title| + owner| + lastrevisiondate| + copyright)$/x) { + my $tmp = $values{$env{'form.sortfield'}}; + if (! defined($tmp)) { $tmp = 'undefined'; } + $result .= ' '.$tmp.' '; + } + my $jumpurl=$values{'url'}; + $jumpurl=~s|^/ext/|http://|; + my $link = '
'.&display_url($jumpurl,1).'
'; -=item * + $result.=<$values{'title'}
+$link
+$values{'author'}, $values{'owner'} -- $values{'lastrevisiondate'}
+$values{'copyrighttag'}
+$values{'extrashow'} +END + return $result; +} -make_persistent() : makes a set of hidden HTML fields to make -SQL search interface information to be persistent +sub summary_preview { + my ($prefix,%values)=@_; + return &summary_view($prefix,%values). + ''. + &Apache::lonindexer::showpreview($values{'url'}); +} -=back +###################################################################### +###################################################################### -WEB INTERFACE COMPONENT FUNCTIONS +=pod -=over 4 +=item &compact_view() -=item * +=cut -simpletextfield(name,value) : returns HTML formatted string for simple text -field +###################################################################### +###################################################################### +sub compact_view { + my ($prefix,%values) = @_; + my $jumpurl=$values{'url'}; + $jumpurl=~s|^/ext/|http://|; -=item * + my $link = &display_url($jumpurl,1); + + my $result = + $prefix.''; + if (exists($env{'form.sortfield'}) && + $env{'form.sortfield'} !~ /^(default|author|url|title)$/) { + my $tmp = $values{$env{'form.sortfield'}}; + if (! defined($tmp)) { $tmp = 'undefined'; } + $result .= ' '.$tmp.' '; + } + $jumpurl = &HTML::Entities::encode($jumpurl,'<>&"'); + $result.=' '. + ''. + &HTML::Entities::encode($values{'title'},'<>&"').' '. + $link.' '.$values{'author'}.' ('.$values{'domain'}.')'; + return $result; +} -simplecheckbox(name,value) : returns HTML formatted string for simple -checkbox +sub display_url { + my ($url,$skiplast) = @_; + my $link; + if ($url=~m|^/ext/|) { + $url=~s|^/ext/|http://|; + $link=''.$url.''; + } elsif ($url=~m{^(http://|/uploaded/)}) { + $link=''.$url.''; + } else { + $link=&Apache::lonhtmlcommon::crumbs( + $url, + 'preview', + '', + (($env{'form.catalogmode'} eq 'import')?'parent.statusframe.document.forms.statusform':''), + $skiplast).' '; + } + return $link; +} -=item * +###################################################################### +###################################################################### -searchphrasefield(title,name,value) : returns HTML formatted string for -a search expression phrase field +=pod -=item * +=item &fielded_format_view() -dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML -formatted string for a calendar date +=cut -=item * +###################################################################### +###################################################################### +sub fielded_format_view { + my ($prefix,%values) = @_; + my $icon=&Apache::loncommon::icon($values{'url'}); + my %Translated = &Apache::lonmeta::fieldnames(); + my $jumpurl=$values{'url'}; + $jumpurl=~s|^/ext/|http://|; -selectbox(title,name,value,%HASH=options) : returns HTML formatted string for -a selection box field + my $result=< +
+
URL:
+
$values{'url'}
+END + foreach my $field ('title','author','domain','subject','keywords','notes', + 'mimetag','language','creationdate','lastrevisiondate', + 'owner','copyrighttag','hostname','abstract') { + $result .= (' 'x4).'
'.$Translated{$field}.'
'."\n". + (' 'x8).'
'.$values{$field}.'
'."\n"; + } + if (&has_stat_data(\%values)) { + foreach my $field (&statfields()) { + $result .= (' 'x4).'
'.$Translated{$field}.'
'."\n". + (' 'x8).'
'.$values{$field}.'
'."\n"; + } + } + if (&has_eval_data(\%values)) { + foreach my $field (&evalfields()) { + $result .= (' 'x4).'
'.$Translated{$field}.'
'."\n". + (' 'x8).'
'.$values{$field}.'
'."\n"; + } + } + $result .= "
\n"; + $result .= $values{'extrashow'}; + return $result; +} -=back +###################################################################### +###################################################################### -SEARCH FUNCTIONS +=pod -=over 4 +=item &xml_sgml_view() -=item * +=back -advancedsearch(server reference, environment reference) : perform a complex -multi-field logical query +=cut -=item * +###################################################################### +###################################################################### +sub xml_sgml_view { + my ($prefix,%values) = @_; + my $xml = ''."\n"; + # The usual suspects + foreach my $field ('url','title','author','subject','keywords','notes','domain') { + $xml .= qq{<$field>$values{$field}}."\n"; + } + # + $xml .= "\n"; + foreach my $field ('mime','mimetag') { + $xml .= qq{<$field>$values{$field}}."\n"; + } + $xml .= "\n"; + # + $xml .= "\n"; + foreach my $field ('language','languagetag') { + $xml .= qq{<$field>$values{$field}}."\n"; + } + $xml .= "\n"; + # + foreach my $field ('creationdate','lastrevisiondate','owner') { + $xml .= qq{<$field>$values{$field}}."\n"; + } + # + $xml .= "\n"; + foreach my $field ('copyright','copyrighttag') { + $xml .= qq{<$field>$values{$field}}."\n"; + } + $xml .= "\n"; + $xml .= qq{$values{'hostname'}}. + "\n"; + $xml .= qq{$values{'shortabstract'}}."\n"; + # + if (&has_stat_data(\%values)){ + $xml .= "\n"; + foreach my $field (&statfields()) { + $xml .= qq{<$field>$values{$field}}."\n"; + } + $xml .= "\n"; + } + # + if (&has_eval_data(\%values)) { + $xml .= "\n"; + foreach my $field (&evalfields) { + $xml .= qq{<$field>$values{$field}}."\n"; + } + $xml .= "\n"; + } + # + $xml .= "\n"; + $xml = &HTML::Entities::encode($xml,'<>&'); + my $result=< +$xml + +$values{'extrashow'} +END + return $result; +} -basicsearch(server reference, environment reference) : perform a simple -single-field logical query +###################################################################### +###################################################################### -=item * +=pod -build_SQL_query(field name, logic) : builds a SQL query string from a -logical expression with AND/OR keywords +=item &filled() see if field is filled. -=item * +=cut -build_custommetadata_query(field_name, logic_statement) : builds a perl -regular expression from a logical expression with AND/OR keywords +###################################################################### +###################################################################### +sub filled { + my ($field)=@_; + if ($field=~/\S/ && $field ne 'any') { + return 1; + } else { + return 0; + } +} -=item * +###################################################################### +###################################################################### -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 +=pod -=item * +=item &output_unparsed_phrase_error() -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. +=cut -=back +###################################################################### +###################################################################### +sub output_unparsed_phrase_error { + my ($r,$closebutton,$parms,$hidden_fields,$field)=@_; + my $errorstring; + if ($field eq 'basicexp') { + $errorstring = &mt('Unable to understand the search phrase [_1]. Please modify your search.' + ,''.$env{'form.basicexp'}.''); + } else { + $errorstring = &mt('Unable to understand the search phrase [_1]: [_2]' + ,''.$field.'' + ,$env{'form.'.$field}); + } + my $heading = &mt('Unparsed Field'); + my $revise = &mt('Revise search request'); + # make query information persistent to allow for subsequent revision + my $start_page = &Apache::loncommon::start_page('Search'); + my $end_page = &Apache::loncommon::end_page(); + $r->print(< +$hidden_fields +$closebutton +
+

$heading

+

+$errorstring +

+

+$revise +

+$end_page +ENDPAGE +} -OUTPUTTING RESULTS FUNCTION +###################################################################### +###################################################################### -=over 4 +=pod -=item * +=item &output_blank_field_error() -output_results(output mode, server reference, environment reference, -reply list reference) : outputs results from search +Output a complete page that indicates the user has not filled in enough +information to do a search. -=back +Inputs: $r (Apache request handle), $closebutton, $parms. -DIFFERENT WAYS TO VIEW METADATA RECORDS +Returns: nothing -=over 4 +$parms is extra information to include in the 'Revise search request' link. -=item * +=cut -detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -see metadata viewing notes below +###################################################################### +###################################################################### +sub output_blank_field_error { + my ($r,$closebutton,$parms,$hidden_fields)=@_; + my $errormsg = &mt('You did not fill in enough information for the search to be started. You need to fill in relevant fields on the search page in order for a query to be processed.'); + my $revise = &mt('Revise Search Request'); + my $heading = &mt('Unactionable Search Query'); + my $start_page = &Apache::loncommon::start_page('Search'); + my $end_page = &Apache::loncommon::end_page(); + if ($closebutton) { + $closebutton = '

'.$closebutton.'

'; + } else { + &Apache::lonhtmlcommon::add_breadcrumb + ({href=>'', + text=>$heading,}); + $start_page .= &Apache::lonhtmlcommon::breadcrumbs(); + } -=item * + $r->print(< +$hidden_fields +$closebutton + +

$heading

+

+$errormsg +

+

+$revise +

+$end_page +ENDPAGE + return; +} -summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -see metadata viewing notes below +###################################################################### +###################################################################### -=item * +=pod -fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -see metadata viewing notes below +=item &output_date_error() -=item * +Output a full html page with an error message. -xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : -see metadata viewing notes below +Inputs: -=back + $r, the request pointer. + $message, the error message for the user. + $closebutton, the specialized close button needed for groupsearch. - _____________________________________________________________________ - | * Metadata viewing notes | - | Output is 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. | - --------------------------------------------------------------------- +=cut -TEST CONDITIONAL FUNCTIONS +###################################################################### +###################################################################### +sub output_date_error { + my ($r,$message,$closebutton,$hidden_fields)=@_; + # make query information persistent to allow for subsequent revision + my $start_page = &Apache::loncommon::start_page('Search'); + my $end_page = &Apache::loncommon::end_page(); + my $heading = &mt('Error'); + $r->print(< +$hidden_fields + +$closebutton + +
+

$heading

+

+$message +

+$end_page +RESULTS +} -=over 4 +###################################################################### +###################################################################### -=item * +=pod -filled(field) : determines whether a given field has been filled +=item &start_fresh_session() -=back +Cleans the global %groupsearch_db by removing all fields which begin with +'pre_' or 'store'. -ERROR FUNCTIONS +=cut -=over 4 +###################################################################### +###################################################################### +sub start_fresh_session { + delete $groupsearch_db{'mode_catalog'}; + foreach (keys %groupsearch_db) { + if ($_ =~ /^pre_/) { + delete $groupsearch_db{$_}; + } + if ($_ =~ /^store/) { + delete $groupsearch_db{$_}; + } + } +} -=item * +1; -output_blank_field_error(server reference) : outputs a message saying that -more fields need to be filled in +sub cleanup { + if (tied(%groupsearch_db)) { + unless (untie(%groupsearch_db)) { + &Apache::lonnet::logthis('Failed cleanup searchcat: groupsearch_db'); + } + } + &untiehash(); + &Apache::lonmysql::disconnect_from_db(); + return OK; +} -=item * +__END__ -output_date_error(server reference, error message) : outputs -an error message specific to bad date format. +=pod -=back +=back =cut