File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.188: download - view: text, annotated - select for diffs
Mon Sep 29 15:28:40 2003 UTC (20 years, 7 months ago) by www
Branches: MAIN
CVS tags: HEAD
Some translations.

    1: # The LearningOnline Network with CAPA
    2: # Search Catalog
    3: #
    4: # $Id: lonsearchcat.pm,v 1.188 2003/09/29 15:28:40 www Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###############################################################################
   29: ###############################################################################
   30: 
   31: =pod 
   32: 
   33: =head1 NAME
   34: 
   35: lonsearchcat - LONCAPA Search Interface
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: Search interface to LON-CAPAs digital library
   40: 
   41: =head1 DESCRIPTION
   42: 
   43: This module enables searching for a distributed browseable catalog.
   44: 
   45: This is part of the LearningOnline Network with CAPA project
   46: described at http://www.lon-capa.org.
   47: 
   48: lonsearchcat presents the user with an interface to search the LON-CAPA
   49: digital library.  lonsearchcat also initiates the execution of a search
   50: by sending the search parameters to LON-CAPA servers.  The progress of 
   51: search (on a server basis) is displayed to the user in a seperate window.
   52: 
   53: =head1 Internals
   54: 
   55: =over 4
   56: 
   57: =cut
   58: 
   59: ###############################################################################
   60: ###############################################################################
   61: 
   62: ###############################################################################
   63: ##                                                                           ##
   64: ## ORGANIZATION OF THIS PERL MODULE                                          ##
   65: ##                                                                           ##
   66: ## 1. Modules used by this module                                            ##
   67: ## 2. Variables used throughout the module                                   ##
   68: ## 3. handler subroutine called via Apache and mod_perl                      ##
   69: ## 4. Other subroutines                                                      ##
   70: ##                                                                           ##
   71: ###############################################################################
   72: 
   73: package Apache::lonsearchcat;
   74: 
   75: # ------------------------------------------------- modules used by this module
   76: use strict;
   77: use Apache::Constants qw(:common :http);
   78: use Apache::lonnet();
   79: use Apache::File();
   80: use CGI qw(:standard);
   81: use Text::Query;
   82: use GDBM_File;
   83: use Apache::loncommon();
   84: use Apache::lonmysql();
   85: use Apache::lonlocal;
   86: 
   87: # ---------------------------------------- variables used throughout the module
   88: 
   89: ######################################################################
   90: ######################################################################
   91: 
   92: =pod 
   93: 
   94: =item Global variables
   95: 
   96: =over 4
   97: 
   98: =item $importbutton
   99: 
  100: button to take the select results and go to group sorting
  101: 
  102: =item %groupsearch_db   
  103: 
  104: Database hash used to save values for the groupsearch RAT interface.
  105: 
  106: =item $diropendb 
  107: 
  108: The full path to the (temporary) search database file.  This is set and
  109: used in &handler() and is also used in &output_results().
  110: 
  111: =item %Views
  112: 
  113: Hash which associates an output view description with the function
  114: that produces it.  Adding a new view type should be as easy as
  115: adding a line to the definition of this hash and making sure the function
  116: takes the proper parameters.
  117: 
  118: =item $bodytag
  119: 
  120: LON-CAPA standard body tag, gotten from &Apache::lonnet::bodytag.
  121: No title, no table, just a <body> tag.
  122: 
  123: =back 
  124: 
  125: =cut
  126: 
  127: ######################################################################
  128: ######################################################################
  129: 
  130: # -- dynamically rendered interface components
  131: my $importbutton; # button to take the selected results and go to group sorting
  132: 
  133: # -- miscellaneous variables
  134: my %groupsearch_db;     # database hash
  135: my $diropendb = "";    # db file
  136: #             View Description           Function Pointer
  137: my %Views = ("Detailed Citation View" => \&detailed_citation_view,
  138:              "Summary View"           => \&summary_view,
  139:              "Fielded Format"         => \&fielded_format_view,
  140:              "XML/SGML"               => \&xml_sgml_view,
  141:              "Compact View"           => \&compact_view);
  142: my %persistent_db;
  143: my $hidden_fields;
  144: my $bodytag;
  145: 
  146: #
  147: # For course search
  148: #
  149: my %alreadyseen;
  150: my $hashtied;
  151: my %hash;
  152: my $totalfound;
  153:  
  154: ######################################################################
  155: ######################################################################
  156: 
  157: =pod 
  158: 
  159: =item &handler() - main handler invoked by httpd child
  160: 
  161: =item Variables
  162: 
  163: =over 4
  164: 
  165: =item $hidden
  166: 
  167: holds 'hidden' html forms
  168: 
  169: =item $scrout
  170: 
  171: string that holds portions of the screen output
  172: 
  173: =back 
  174: 
  175: =cut
  176: 
  177: ######################################################################
  178: ######################################################################
  179: sub handler {
  180:     my $r = shift;
  181:     #
  182: 
  183:     my $loaderror=&Apache::lonnet::overloaderror($r);
  184:     if ($loaderror) { return $loaderror; }
  185: 
  186:     my $closebutton;  # button that closes the search window 
  187:                       # This button is different for the RAT compared to
  188:                       # normal invocation.
  189:     #
  190:     &Apache::loncommon::content_type($r,'text/html');
  191:     $r->send_http_header;
  192:     return OK if $r->header_only;
  193:     ##
  194:     ## Prevent caching of the search interface window.  Hopefully this means
  195:     ## we will get the launch=1 passed in a little more.
  196:     &Apache::loncommon::no_cache($r);
  197:     ## 
  198:     ## Pick up form fields passed in the links.
  199:     ##
  200:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  201:              ['catalogmode','launch','acts','mode','form','element','pause',
  202:               'phase','persistent_db_id','table','start','show',
  203:               'cleargroupsort']);
  204:     ##
  205:     ## The following is a trick - we wait a few seconds if asked to so
  206:     ##     the daemon running the search can get ahead of the daemon
  207:     ##     printing the results.  We only need (theoretically) to do
  208:     ##     this once, so the pause indicator is deleted
  209:     ##
  210:     if (exists($ENV{'form.pause'})) {
  211:         sleep(1);
  212:         delete($ENV{'form.pause'});
  213:     }
  214:     ##
  215:     ## Initialize global variables
  216:     ##
  217:     my $domain  = $r->dir_config('lonDefDomain');
  218:     $diropendb= "/home/httpd/perl/tmp/$ENV{'user.domain'}_$ENV{'user.name'}_searchcat.db";
  219:     #
  220:     # set the name of the persistent database
  221:     #          $ENV{'form.persistent_db_id'} can only have digits in it.
  222:     if (! exists($ENV{'form.persistent_db_id'}) ||
  223:         ($ENV{'form.persistent_db_id'} =~ /\D/) ||
  224:         ($ENV{'form.launch'} eq '1')) {
  225:         $ENV{'form.persistent_db_id'} = time;
  226:     }
  227:     $bodytag=&Apache::loncommon::bodytag(undef,undef,undef,1);
  228:     my $persistent_db_file = "/home/httpd/perl/tmp/".
  229:         &Apache::lonnet::escape($domain).
  230:             '_'.&Apache::lonnet::escape($ENV{'user.name'}).
  231:                 '_'.$ENV{'form.persistent_db_id'}.'_persistent_search.db';
  232:     ##
  233:     if (! &get_persistent_form_data($persistent_db_file)) {
  234:         if ($ENV{'form.phase'} =~ /(run_search|results)/) {
  235:             &Apache::lonnet::logthis("lonsearchcat:Unable to recover data ".
  236:                                      "from $persistent_db_file");
  237:             $r->print(<<END);
  238: <html>
  239: <head><title>LON-CAPA Search Error</title></head>
  240: $bodytag
  241: We were unable to retrieve data describing your search.  This is a serious
  242: error and has been logged.  Please alert your LON-CAPA administrator.
  243: </body>
  244: </html>
  245: END
  246:             return OK;
  247:         }
  248:     }
  249:     ##
  250:     ## Clear out old values from groupsearch database
  251:     ##
  252:     untie %groupsearch_db if (tied(%groupsearch_db));
  253:     if (($ENV{'form.cleargroupsort'} eq '1') || 
  254:         (($ENV{'form.launch'} eq '1') && 
  255:          ($ENV{'form.catalogmode'} eq 'groupsearch'))) {
  256: 	if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) {
  257: 	    &start_fresh_session();
  258: 	    untie %groupsearch_db;
  259:             delete($ENV{'form.cleargroupsort'});
  260: 	} else {
  261:             # This is a stupid error to give to the user.  
  262:             # It really tells them nothing.
  263: 	    $r->print('<html><head></head>'.$bodytag.
  264:                       'Unable to tie hash to db file</body></html>');
  265: 	    return OK;
  266: 	}
  267:     }
  268:     ##
  269:     ## Configure hidden fields
  270:     ##
  271:     $hidden_fields = '<input type="hidden" name="persistent_db_id" value="'.
  272:         $ENV{'form.persistent_db_id'}.'" />'."\n";
  273:     if (exists($ENV{'form.catalogmode'})) {
  274:         $hidden_fields .= '<input type="hidden" name="catalogmode" value="'.
  275:                 $ENV{'form.catalogmode'}.'" />'."\n";
  276:     }
  277:     if (exists($ENV{'form.form'})) {
  278:         $hidden_fields .= '<input type="hidden" name="form" value="'.
  279:                 $ENV{'form.form'}.'" />'."\n";
  280:     }
  281:     if (exists($ENV{'form.element'})) {
  282:         $hidden_fields .= '<input type="hidden" name="element" value="'.
  283:                 $ENV{'form.element'}.'" />'."\n";
  284:     }
  285:     if (exists($ENV{'form.mode'})) {
  286:         $hidden_fields .= '<input type="hidden" name="mode" value="'.
  287:                 $ENV{'form.mode'}.'" />'."\n";
  288:     }
  289:     ##
  290:     ## Configure dynamic components of interface
  291:     ##
  292:     if ($ENV{'form.catalogmode'} eq 'interactive') {
  293:         $closebutton="<input type='button' name='close' value='CLOSE' ";
  294:         if ($ENV{'form.phase'} =~ /(results|run_search)/) {
  295: 	    $closebutton .="onClick='parent.close()'";
  296:         } else {
  297:             $closebutton .="onClick='self.close()'";
  298:         }
  299:         $closebutton .=">\n";
  300:     } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
  301:         $closebutton="<input type='button' name='close' value='CLOSE' ";
  302:         if ($ENV{'form.phase'} =~ /(results|run_search)/) {
  303: 	    $closebutton .="onClick='parent.close()'";
  304:         } else {
  305:             $closebutton .="onClick='self.close()'";
  306:         }
  307:         $closebutton .= ">";
  308:         $importbutton=<<END;
  309: <input type='button' name='import' value='IMPORT'
  310: onClick='javascript:select_group()'>
  311: END
  312:     } else {
  313:         $closebutton = '';
  314:         $importbutton = '';
  315:     }
  316:     ##
  317:     ## Sanity checks on form elements
  318:     ##
  319:     if (!defined($ENV{'form.viewselect'})) {
  320:         if (($ENV{'form.catalogmode'} eq 'groupsearch') ||
  321:             ($ENV{'form.catalogmode'} eq 'interactive')) {
  322:             $ENV{'form.viewselect'} ="Compact View";
  323:         } else {
  324:             $ENV{'form.viewselect'} ="Detailed Citation View";
  325:         }
  326:     }
  327:     $ENV{'form.phase'} = 'disp_basic' if (! exists($ENV{'form.phase'}));
  328:     $ENV{'form.show'} = 20 if (! exists($ENV{'form.show'}));
  329:     ##
  330:     ## Switch on the phase
  331:     ##
  332:     if ($ENV{'form.phase'} eq 'disp_basic') {
  333:         &print_basic_search_form($r,$closebutton);
  334:     } elsif ($ENV{'form.phase'} eq 'disp_adv') {
  335:         &print_advanced_search_form($r,$closebutton);
  336:     } elsif ($ENV{'form.phase'} eq 'results') {
  337:         &display_results($r,$importbutton,$closebutton);
  338:     } elsif ($ENV{'form.phase'} =~ /^(sort|run_search)$/) {
  339:         my ($query,$customquery,$customshow,$libraries,$pretty_string) =
  340:             &get_persistent_data($persistent_db_file,
  341:                  ['query','customquery','customshow',
  342:                   'libraries','pretty_string']);
  343:         if ($ENV{'form.phase'} eq 'sort') {
  344:             &print_sort_form($r,$pretty_string);
  345:         } elsif ($ENV{'form.phase'} eq 'run_search') {
  346:             &run_search($r,$query,$customquery,$customshow,
  347:                         $libraries,$pretty_string);
  348:         }
  349:     } elsif ($ENV{'form.phase'} eq 'course_search') {
  350:         &course_search($r);
  351:     } elsif(($ENV{'form.phase'} eq 'basic_search') ||
  352:             ($ENV{'form.phase'} eq 'adv_search')) {
  353:         $ENV{'form.searchmode'} = 'basic';
  354:         if ($ENV{'form.phase'} eq 'adv_search') {
  355:             $ENV{'form.searchmode'} = 'advanced';
  356:         }
  357:         # Set up table
  358:         if (! defined(&create_results_table())) {
  359:             $r->print(<<END);
  360: <html><head><title>Search Error</title></head>
  361: $bodytag
  362: Unable to create table in which to store search results.  
  363: The search has been aborted.
  364: </body>
  365: </html>
  366: END
  367:             return OK;
  368:         }
  369:         delete($ENV{'form.launch'});
  370:         if (! &make_form_data_persistent($r,$persistent_db_file)) {
  371:             $r->print(<<END);
  372: <html><head><title>Search Error</title></head>
  373: $bodytag
  374: Unable to properly store search information.  The search has been aborted.
  375: </body>
  376: </html>
  377: END
  378:             return OK;
  379:         }
  380:         #
  381:         # We are running a search
  382:         my ($query,$customquery,$customshow,$libraries) = 
  383:             (undef,undef,undef,undef);
  384:         my $pretty_string;
  385:         if ($ENV{'form.phase'} eq 'basic_search') {
  386:             ($query,$pretty_string,$libraries) = 
  387:                 &parse_basic_search($r,$closebutton);
  388:         } else {                      # Advanced search
  389:             ($query,$customquery,$customshow,$libraries,$pretty_string) 
  390:                 = &parse_advanced_search($r,$closebutton);
  391:             return OK if (! defined($query));
  392:         }
  393:         &make_persistent({ query => $query,
  394:                            customquery => $customquery,
  395:                            customshow => $customshow,
  396:                            libraries => $libraries,
  397:                            pretty_string => $pretty_string },
  398:                          $persistent_db_file);
  399:         ##
  400:         ## Print out the frames interface
  401:         ##
  402:         &print_frames_interface($r);
  403:     }
  404:     return OK;
  405: } 
  406: 
  407: ######################################################################
  408: ######################################################################
  409: 
  410: sub course_search {
  411:     my $r=shift;
  412:     my $bodytag=&Apache::loncommon::bodytag('Course Search');
  413:     my $pretty_search_string = '<b>'.$ENV{'form.courseexp'}.'</b>';
  414:     my $search_string = $ENV{'form.courseexp'};
  415:     my @New_Words;
  416:     if ($ENV{'form.crsrelated'}) {
  417:         ($search_string,@New_Words) = &related_version($ENV{'form.courseexp'});
  418:         if (@New_Words) {
  419:             $pretty_search_string .= " with related words: <b>@New_Words</b>.";
  420:         } else {
  421:             $pretty_search_string .= " with no related words.";
  422:         }
  423:     }
  424:     my $fulltext=$ENV{'form.crsfulltext'};
  425:     my @allwords=($search_string,@New_Words);
  426:     $totalfound=0;
  427:     $r->print('<html><head><title>LON-CAPA Course Search</title></head>'.
  428: 	      $bodytag.$pretty_search_string);
  429:     $r->rflush();
  430: # ======================================================= Go through the course
  431:    $hashtied=0;
  432:    undef %alreadyseen;
  433:    %alreadyseen=();
  434:     my $c=$r->connection;
  435:    &tiehash();
  436:    foreach (keys %hash) {
  437:        if ($c->aborted()) { last; }
  438:        if (($_=~/^src\_(.+)$/) && (!$alreadyseen{$hash{$_}})) {
  439:            &checkonthis($r,$hash{$_},0,$hash{'title_'.$1},$fulltext,@allwords);
  440:        }
  441:    }
  442:    &untiehash();
  443:     unless ($totalfound) {
  444: 	$r->print('<p>'.&mt('No resources found').'.</p>');
  445:     }
  446: # =================================================== Done going through course
  447:     $r->print('</body></html>');
  448: }
  449: 
  450: # ---------------------------------------------------------------- tie the hash
  451: 
  452: sub tiehash {
  453:     $hashtied=0;
  454:     if ($ENV{'request.course.fn'}) {
  455:         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.".db",
  456:             &GDBM_READER(),0640)) {
  457:                 $hashtied=1;
  458:         }
  459:     }    
  460: }
  461: 
  462: sub untiehash {
  463:     if ($hashtied) { untie %hash; }
  464:     $hashtied=0;
  465: }
  466: 
  467: # =============================== This pulls up a resource and its dependencies
  468: 
  469: sub checkonthis {
  470:     my ($r,$url,$level,$title,$fulltext,@allwords)=@_;
  471:     $alreadyseen{$url}=1;
  472:     $r->rflush();
  473:     my $result=&Apache::lonnet::metadata($url,'title').' '.
  474:                &Apache::lonnet::metadata($url,'subject').' '.
  475:                &Apache::lonnet::metadata($url,'abstract').' '.
  476:                &Apache::lonnet::metadata($url,'keywords');
  477:     if (($url) && ($fulltext)) {
  478: 	$result.=&Apache::lonnet::ssi_body($url);
  479:     }
  480:     $result=~s/\s+/ /gs;
  481:     my $applies=0;
  482:     foreach (@allwords) {
  483:         if ($_=~/\w/) {
  484: 	   if ($result=~/$_/si) {
  485: 	      $applies++;
  486:            }
  487:        }
  488:     }
  489: # Does this resource apply?
  490:     if ($applies) {
  491:        $r->print('<br />');
  492:        for (my $i=0;$i<=$level*5;$i++) {
  493:            $r->print('&nbsp;');
  494:        }
  495:        $r->print('<a href="'.$url.'" target="cat">'.
  496: 		 ($title?$title:$url).'</a><br />');
  497:        $totalfound++;
  498:     } elsif ($fulltext) {
  499:        $r->print(' .');
  500:     }
  501:     $r->rflush();
  502: # Check also the dependencies of this one
  503:     my $dependencies=
  504:                 &Apache::lonnet::metadata($url,'dependencies');
  505:     foreach (split(/\,/,$dependencies)) {
  506:        if (($_=~/^\/res\//) && (!$alreadyseen{$_})) {
  507:           &checkonthis($r,$_,$level+1,'',$fulltext,@allwords);
  508:        }
  509:     }
  510: }
  511: 
  512: ######################################################################
  513: ######################################################################
  514: 
  515: =pod 
  516: 
  517: =item &print_basic_search_form() 
  518: 
  519: Returns a scalar which holds html for the basic search form.
  520: 
  521: =cut
  522: 
  523: ######################################################################
  524: ######################################################################
  525: 
  526: sub print_basic_search_form{
  527:     my ($r,$closebutton) = @_;
  528:     my $bodytag=&Apache::loncommon::bodytag('Search');
  529:     my $scrout=<<"ENDDOCUMENT";
  530: <html>
  531: <head>
  532: <title>The LearningOnline Network with CAPA</title>
  533: <script type="text/javascript">
  534:     function openhelp(val) {
  535: 	openhelpwin=open('/adm/help/searchcat.html','helpscreen',
  536: 	     'scrollbars=1,width=600,height=300');
  537: 	openhelpwin.focus();
  538:     }
  539: </script>
  540: </head>
  541: $bodytag
  542: ENDDOCUMENT
  543: if (&Apache::lonnet::allowed('bre',$ENV{'request.role.domain'})) {
  544:     $scrout.=(<<ENDDOCUMENT);
  545: <h1>Catalog Search</h1>
  546: <form method="post" action="/adm/searchcat">
  547: <input type="hidden" name="phase" value="basic_search" />
  548: $hidden_fields
  549: <p>
  550: Enter terms or phrases separated by AND, OR, or NOT 
  551: then press SEARCH below.
  552: </p>
  553: <p>
  554: <table>
  555: <tr><td>
  556: ENDDOCUMENT
  557:     $scrout.='&nbsp;'.&simpletextfield('basicexp',$ENV{'form.basicexp'},40).
  558:         '&nbsp;';
  559:     my $relatedcheckbox = &simplecheckbox('related',$ENV{'form.related'});
  560:     my $domain = $r->dir_config('lonDefDomain');
  561:     my $domaincheckbox = &simplecheckbox('domains',$domain);
  562:     my $srch=&mt('Search');
  563:     my $header=&mt('Advanced Search');
  564:     $scrout.=<<END;
  565: </td><td><a
  566: href="/adm/searchcat?phase=disp_adv&catalogmode=$ENV{'form.catalogmode'}&launch=$ENV{'form.launch'}"
  567: >$header</a></td></tr>
  568: <tr><td>$relatedcheckbox use related words</td>
  569:     <td>$domaincheckbox only search domain <b>$domain</b></td></tr>
  570: </table>
  571: </p>
  572: <p>
  573: &nbsp;<input type="submit" name="basicsubmit" value='$srch' />&nbsp;
  574: $closebutton
  575: END
  576:     $scrout.=&selectbox('View','viewselect',
  577: 			$ENV{'form.viewselect'},
  578: 			undef,undef,undef,
  579: 			sort(keys(%Views)));
  580:     $scrout.=&selectbox('Per Page','show',
  581: 			$ENV{'form.show'},
  582: 			undef,undef,undef,
  583: 			(10,20,50,100));
  584:     $scrout.=<<ENDDOCUMENT;
  585: </p>
  586: </form>
  587: ENDDOCUMENT
  588:     }
  589:     if ($ENV{'request.course.id'}) {
  590: 	my %lt=&Apache::lonlocal::texthash(
  591: 					   'srch' => 'Search',
  592:                                            'header' => 'Course Search',
  593: 	 'note' => 'Enter terms or phrases, then press "Search" below',
  594: 					   );
  595:         $scrout.=(<<ENDCOURSESEARCH);
  596: <hr />
  597: <h1>$lt{'header'}</h1>    
  598: <form method="post" action="/adm/searchcat">
  599: <input type="hidden" name="phase" value="course_search" />
  600: $hidden_fields
  601: <p>
  602: $lt{'note'}.
  603: </p>
  604: <p>
  605: <table>
  606: <tr><td>
  607: ENDCOURSESEARCH
  608:         $scrout.='&nbsp;'.
  609:             &simpletextfield('courseexp',$ENV{'form.courseexp'},40);
  610:         my $crscheckbox = 
  611:             &simplecheckbox('crsfulltext',$ENV{'form.crsfulltext'});
  612:         my $relcheckbox = 
  613:             &simplecheckbox('crsrelated',$ENV{'form.crsrelated'});
  614:         $scrout.=(<<ENDENDCOURSE);
  615: </td></tr>
  616: <tr><td>$relcheckbox use related words</td><td></td></tr>
  617: <tr><td>$crscheckbox fulltext search (time consuming)</td><td></td></tr>
  618: </table><p>
  619: &nbsp;<input type="submit" name="coursesubmit" value='$lt{'srch'}' />
  620: </p>
  621: ENDENDCOURSE
  622:     }
  623:     $scrout.=(<<ENDDOCUMENT);
  624: </body>
  625: </html>
  626: ENDDOCUMENT
  627:     $r->print($scrout);
  628:     return;
  629: }
  630: ######################################################################
  631: ######################################################################
  632: 
  633: =pod 
  634: 
  635: =item &advanced_search_form() 
  636: 
  637: Returns a scalar which holds html for the advanced search form.
  638: 
  639: =cut
  640: 
  641: ######################################################################
  642: ######################################################################
  643: 
  644: sub print_advanced_search_form{
  645:     my ($r,$closebutton) = @_;
  646:     my $advanced_buttons = <<"END";
  647: <p>
  648: <input type="submit" name="advancedsubmit" value='SEARCH' />
  649: <input type="reset" name="reset" value='RESET' />
  650: $closebutton
  651: <input type="button" value="HELP" onClick="openhelp()" />
  652: </p>
  653: END
  654:     if (!defined($ENV{'form.viewselect'})) {
  655:         $ENV{'form.viewselect'} ="Detailed Citation View";
  656:     }
  657:     my $bodytag=&Apache::loncommon::bodytag('Advanced Catalog Search');
  658:     my $scrout=<<"ENDHEADER";
  659: <html>
  660: <head>
  661: <title>The LearningOnline Network with CAPA</title>
  662: <script type="text/javascript">
  663:     function openhelp(val) {
  664: 	openhelpwin=open('/adm/help/searchcat.html','helpscreen',
  665: 	     'scrollbars=1,width=600,height=300');
  666: 	openhelpwin.focus();
  667:     }
  668: </script>
  669: </head>
  670: $bodytag
  671: Enter terms or phrases separated by search operators 
  672: such as AND, OR, or NOT.<br />
  673: <form method="post" action="/adm/searchcat">
  674: $advanced_buttons
  675: $hidden_fields
  676: <input type="hidden" name="phase" value="adv_search" />
  677: <table>
  678: <tr><td><font color="#800000" face="helvetica"><b>VIEW:</b></font></td>
  679: <td>
  680: ENDHEADER
  681:     $scrout.=&selectbox(undef,'viewselect',
  682: 			$ENV{'form.viewselect'},
  683: 			undef,undef,undef,
  684: 			sort(keys(%Views)));
  685:     $scrout.='&nbsp;';
  686:     $scrout.=&selectbox(undef,'show',
  687: 			$ENV{'form.show'},
  688: 			undef,undef,undef,
  689: 			(10,20,50,100));
  690:     $scrout.='&nbsp;'.
  691:         '<font color="#800000" face="helvetica">'.&mt('Per Page').'</font>';
  692:     $scrout.="</td><td>".&mt('Related').'<br />'.&mt('Words')."</td></tr>\n";
  693:     $scrout.=&searchphrasefield_with_related('title',   'title'   ,
  694:                                              $ENV{'form.title'});
  695:     $scrout.=&searchphrasefield('author',  'author'  ,$ENV{'form.author'});
  696:     $scrout.=&searchphrasefield_with_related('subject', 'subject' ,
  697:                                              $ENV{'form.subject'});
  698:     $scrout.=&searchphrasefield_with_related('keywords','keywords',
  699:                                              $ENV{'form.keywords'});
  700:     $scrout.=&searchphrasefield('URL',     'url'     ,$ENV{'form.url'});
  701:     $scrout.=&searchphrasefield_with_related('notes',   'notes'   ,
  702:                                              $ENV{'form.notes'});
  703:     $scrout.=&searchphrasefield_with_related('abstract','abstract',
  704:                                              $ENV{'form.abstract'});
  705:     # Hack - an empty table row.
  706:     $scrout.="<tr><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td></tr>\n";
  707:     $scrout.=&searchphrasefield('file<br />extension','extension',
  708:                         $ENV{'form.extension'});
  709:     $scrout.="<tr><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td></tr>\n";
  710:     $scrout.=&searchphrasefield('publisher<br />owner','owner',
  711: 				$ENV{'form.owner'});
  712:     $scrout.="</table>\n";
  713:     $ENV{'form.category'}='any' if (! defined($ENV{'form.category'}));
  714:     $scrout.=&selectbox('File Category','category',
  715: 			$ENV{'form.category'},
  716: 			'any','Any category',
  717: 			undef,
  718: 			(&Apache::loncommon::filecategories()));
  719:     $ENV{'form.language'}='any' unless length($ENV{'form.language'});
  720:     #----------------------------------------------------------------
  721:     # Allow restriction to multiple domains.
  722:     #   I make the crazy assumption that there will never be a domain 'any'.
  723:     #
  724:     $ENV{'form.domains'} = 'any' if (! exists($ENV{'form.domains'}));
  725:     my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}} 
  726:                            :  ($ENV{'form.domains'}) );
  727:     my %domain_hash = ();
  728:     foreach (@allowed_domains) {
  729:         $domain_hash{$_}++;
  730:     }
  731:     my @domains =&Apache::loncommon::get_domains();
  732:     # adjust the size of the select box
  733:     my $size = 4;
  734:     $size = (scalar @domains < ($size - 1) ? scalar @domains + 1 : $size);
  735:     $scrout.="\n".'<font color="#800000" face="helvetica"><b>'.
  736:         'DOMAINS TO BE SEARCHED</b></font><br />'.
  737:             '<select name="domains" size="'.$size.'" multiple>'."\n".
  738:                 '<option name="any" value="any" '.
  739:                     ($domain_hash{'any'}? 'selected ' :'').
  740:                         '>all domains</option>'."\n";
  741:     foreach my $dom (sort @domains) {
  742:         $scrout.="<option name=\"$dom\" ".
  743:             ($domain_hash{$dom} ? 'selected ' :'').">$dom</option>\n";
  744:     }
  745:     $scrout.="</select>\n";
  746:     #----------------------------------------------------------------
  747:     $scrout.=&selectbox('Limit by language','language',
  748: 			$ENV{'form.language'},'any','Any Language',
  749: 			\&Apache::loncommon::languagedescription,
  750: 			(&Apache::loncommon::languageids),
  751: 			);
  752: # ------------------------------------------------ Compute date selection boxes
  753:     $scrout.=<<CREATIONDATESTART;
  754: <p>
  755: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
  756: </font>
  757: <br />
  758: between:
  759: CREATIONDATESTART
  760:     $scrout.=&dateboxes('creationdatestart',1,1,1976,
  761: 			$ENV{'form.creationdatestart_month'},
  762: 			$ENV{'form.creationdatestart_day'},
  763: 			$ENV{'form.creationdatestart_year'},
  764: 			);
  765:     $scrout.="and:\n";
  766:     $scrout.=&dateboxes('creationdateend',12,31,2051,
  767: 			$ENV{'form.creationdateend_month'},
  768: 			$ENV{'form.creationdateend_day'},
  769: 			$ENV{'form.creationdateend_year'},
  770: 			);
  771:     $scrout.="</p>";
  772:     $scrout.=<<LASTREVISIONDATESTART;
  773: <p>
  774: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
  775: </b></font>
  776: <br />between:
  777: LASTREVISIONDATESTART
  778:     $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
  779: 			$ENV{'form.lastrevisiondatestart_month'},
  780: 			$ENV{'form.lastrevisiondatestart_day'},
  781: 			$ENV{'form.lastrevisiondatestart_year'},
  782: 			);
  783:     $scrout.=<<LASTREVISIONDATEEND;
  784: and:
  785: LASTREVISIONDATEEND
  786:     $scrout.=&dateboxes('lastrevisiondateend',12,31,2051,
  787: 			$ENV{'form.lastrevisiondateend_month'},
  788: 			$ENV{'form.lastrevisiondateend_day'},
  789: 			$ENV{'form.lastrevisiondateend_year'},
  790: 			);
  791:     $scrout.='</p>';
  792:     $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
  793:     $scrout.=&selectbox('Limit by copyright/distribution','copyright',
  794: 			 $ENV{'form.copyright'},
  795: 			 'any','Any copyright/distribution',
  796: 			 \&Apache::loncommon::copyrightdescription,
  797: 			 (&Apache::loncommon::copyrightids),
  798: 			 );
  799: # ------------------------------------------- Compute customized metadata field
  800: #    $scrout.=<<CUSTOMMETADATA;
  801: #<p>
  802: #<font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
  803: #</font>
  804: #For resource-specific metadata, enter in an expression in the form of 
  805: #<i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
  806: #<b>Example:</b> grandmother=75 OR grandfather=85
  807: #<br />
  808: #CUSTOMMETADATA
  809: #    $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
  810: #    $scrout.=<<CUSTOMSHOW;
  811: #<p>
  812: #<font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b>
  813: #</font>
  814: #Enter in a space-separated list of special metadata fields to show
  815: #in a fielded listing for each record result.
  816: #<br />
  817: #CUSTOMSHOW
  818: #    $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'});
  819:     $scrout.=<<ENDDOCUMENT;
  820: $advanced_buttons
  821: </form>
  822: </body>
  823: </html>
  824: ENDDOCUMENT
  825:     $r->print($scrout);
  826:     return;
  827: }
  828: 
  829: ######################################################################
  830: ######################################################################
  831: 
  832: =pod 
  833: 
  834: =item &get_persistent_form_data
  835: 
  836: Inputs: filename of database
  837: 
  838: Outputs: returns undef on database errors.
  839: 
  840: This function is the reverse of &make_persistent() for form data.
  841: Retrieve persistent data from %persistent_db.  Retrieved items will have their
  842: values unescaped.  If a form value already exists in $ENV, it will not be
  843: overwritten.  Form values that are array references may have values appended
  844: to them.
  845: 
  846: =cut
  847: 
  848: ######################################################################
  849: ######################################################################
  850: sub get_persistent_form_data {
  851:     my $filename = shift;
  852:     return 0 if (! -e $filename);
  853:     return undef if (! tie(%persistent_db,'GDBM_File',$filename,
  854:                            &GDBM_READER(),0640));
  855:     #
  856:     # These make sure we do not get array references printed out as 'values'.
  857:     my %arrays_allowed = ('form.domains'=>1);
  858:     #
  859:     # Loop through the keys, looking for 'form.'
  860:     foreach my $name (keys(%persistent_db)) {
  861:         next if ($name !~ /^form./);
  862:         # Kludgification begins!
  863:         if ($name eq 'form.domains' && 
  864:             $ENV{'form.searchmode'} eq 'basic' &&
  865:             $ENV{'form.phase'} ne 'disp_basic') {
  866:             next;
  867:         }
  868:         # End kludge (hopefully)
  869:         next if (exists($ENV{$name}));
  870:         my @values = map { 
  871:             &Apache::lonnet::unescape($_);
  872:         } split(',',$persistent_db{$name});
  873:         next if (@values <1);
  874:         if ($arrays_allowed{$name}) {
  875:             $ENV{$name} = [@values];
  876:         } else {
  877:             $ENV{$name} = $values[0] if ($values[0]);
  878:         }
  879:     }
  880:     untie (%persistent_db);
  881:     return 1;
  882: }
  883: 
  884: ######################################################################
  885: ######################################################################
  886: 
  887: =pod 
  888: 
  889: =item &get_persistent_data
  890: 
  891: Inputs: filename of database, ref to array of values to recover.
  892: 
  893: Outputs: array of values.  Returns undef on error.
  894: 
  895: This function is the reverse of &make_persistent();
  896: Retrieve persistent data from %persistent_db.  Retrieved items will have their
  897: values unescaped.  If the item contains commas (before unescaping), the
  898: returned value will be an array pointer. 
  899: 
  900: =cut
  901: 
  902: ######################################################################
  903: ######################################################################
  904: sub get_persistent_data {
  905:     my $filename = shift;
  906:     my @Vars = @{shift()};
  907:     my @Values;   # Return array
  908:     return undef if (! -e $filename);
  909:     return undef if (! tie(%persistent_db,'GDBM_File',$filename,
  910:                            &GDBM_READER(),0640));
  911:     foreach my $name (@Vars) {
  912:         if (! exists($persistent_db{$name})) {
  913:             push @Values, undef;
  914:             next;
  915:         }
  916:         my @values = map { 
  917:             &Apache::lonnet::unescape($_);
  918:         } split(',',$persistent_db{$name});
  919:         if (@values <= 1) {
  920:             push @Values,$values[0];
  921:         } else {
  922:             push @Values,\@values;
  923:         }
  924:     }
  925:     untie (%persistent_db);
  926:     return @Values;
  927: }
  928: 
  929: ######################################################################
  930: ######################################################################
  931: 
  932: =pod 
  933: 
  934: =item &make_persistent() 
  935: 
  936: Inputs: Hash of values to save, filename of persistent database.
  937: 
  938: Store variables away to the %persistent_db.
  939: Values will be escaped.  Values that are array pointers will have their
  940: elements escaped and concatenated in a comma seperated string.  
  941: 
  942: =cut
  943: 
  944: ######################################################################
  945: ######################################################################
  946: sub make_persistent {
  947:     my %save = %{shift()};
  948:     my $filename = shift;
  949:     return undef if (! tie(%persistent_db,'GDBM_File',
  950:                            $filename,&GDBM_WRCREAT(),0640));
  951:     foreach my $name (keys(%save)) {
  952:         my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name}));
  953:         # We handle array references, but not recursively.
  954:         my $store = join(',', map { &Apache::lonnet::escape($_); } @values );
  955:         $persistent_db{$name} = $store;
  956:     }
  957:     untie(%persistent_db);
  958:     return 1;
  959: }
  960: 
  961: ######################################################################
  962: ######################################################################
  963: 
  964: =pod 
  965: 
  966: =item &make_form_data_persistent() 
  967: 
  968: Inputs: filename of persistent database.
  969: 
  970: Store most form variables away to the %persistent_db.
  971: Values will be escaped.  Values that are array pointers will have their
  972: elements escaped and concatenated in a comma seperated string.  
  973: 
  974: =cut
  975: 
  976: ######################################################################
  977: ######################################################################
  978: sub make_form_data_persistent {
  979:     my $r = shift;
  980:     my $filename = shift;
  981:     my %save;
  982:     foreach (keys(%ENV)) {
  983:         next if (!/^form/ || /submit/);
  984:         $save{$_} = $ENV{$_};
  985:     }
  986:     return &make_persistent(\%save,$filename);
  987: }
  988: 
  989: ######################################################################
  990: #                HTML form building functions                        #  
  991: ######################################################################
  992: 
  993: =pod 
  994: 
  995: =item HTML form building functions
  996: 
  997: =over 4
  998: 
  999: =cut
 1000: 
 1001: ###############################################
 1002: ###############################################
 1003: 
 1004: =pod
 1005: 
 1006: =item &simpletextfield() 
 1007: 
 1008: Inputs: $name,$value,$size
 1009: 
 1010: Returns a text input field with the given name, value, and size.  
 1011: If size is not specified, a value of 20 is used.
 1012: 
 1013: =cut
 1014: 
 1015: ###############################################
 1016: ###############################################
 1017: 
 1018: sub simpletextfield {
 1019:     my ($name,$value,$size)=@_;
 1020:     $size = 20 if (! defined($size));
 1021:     return '<input type="text" name="'.$name.
 1022:         '" size="'.$size.'" value="'.$value.'" />';
 1023: }
 1024: 
 1025: ###############################################
 1026: ###############################################
 1027: 
 1028: =pod
 1029: 
 1030: =item &simplecheckbox()
 1031: 
 1032: Inputs: $name,$value
 1033: 
 1034: Returns a simple check box with the given $name.
 1035: If $value eq 'on' the box is checked.
 1036: 
 1037: =cut
 1038: 
 1039: ###############################################
 1040: ###############################################
 1041: 
 1042: sub simplecheckbox{
 1043:     my ($name,$value,$checked)=@_;
 1044:     $checked="checked" if ($value eq 'on');
 1045:     return '<input type="checkbox" name="'.$name.'" value="'.$value.'" '.
 1046:         $checked.' />';
 1047: }
 1048: 
 1049: ###############################################
 1050: ###############################################
 1051: 
 1052: =pod
 1053: 
 1054: =item &fieldtitle()
 1055: 
 1056: Input: $title
 1057: 
 1058: Returns a scalar with html which will display $title as a search
 1059: field heading.
 1060: 
 1061: =cut
 1062: 
 1063: ###############################################
 1064: ###############################################
 1065: 
 1066: sub fieldtitle {
 1067:     my $title = uc(&mt(shift()));
 1068:     return '<font color="#800000" face="helvetica"><b>'.$title.
 1069:         ':&nbsp;</b></font>';
 1070: }
 1071: 
 1072: ###############################################
 1073: ###############################################
 1074: 
 1075: =pod
 1076: 
 1077: =item &searchphrasefield()
 1078: 
 1079: Inputs: $title,$name,$value
 1080: 
 1081: Returns html for a title line and an input field for entering search terms.
 1082: The entry field (which is where the $name and $value are used) is a 50 column 
 1083: simpletextfield.  The html returned is for a row in a three column table.
 1084: 
 1085: =cut
 1086: 
 1087: ###############################################
 1088: ###############################################
 1089:     
 1090: sub searchphrasefield {
 1091:     my ($title,$name,$value)=@_;
 1092:     return '<tr><td>'.&fieldtitle($title).'</td><td>'.
 1093:         &simpletextfield($name,$value,50)."</td><td>&nbsp;</td></tr>\n";
 1094: }
 1095: 
 1096: ###############################################
 1097: ###############################################
 1098: 
 1099: =pod
 1100: 
 1101: =item &searchphrasefield_with_related()
 1102: 
 1103: Inputs: $title,$name,$value
 1104: 
 1105: Returns html for a title line and an input field for entering search terms
 1106: and a check box for 'related words'.  The entry field (which is where the 
 1107: $name and $value are used) is a 50 column simpletextfield.  The name of
 1108: the related words checkbox is "$name_related".
 1109: 
 1110: =cut
 1111: 
 1112: ###############################################
 1113: ###############################################
 1114:     
 1115: sub searchphrasefield_with_related {
 1116:     my ($title,$name,$value)=@_;
 1117:     return '<tr><td>'.&fieldtitle($title).'</td><td>'.
 1118:         &simpletextfield($name,$value,50).'</td><td align="center">&nbsp;'.
 1119:             &simplecheckbox($name.'_related',$ENV{'form.'.$name.'_related'}).
 1120:                 "&nbsp;</td></tr>\n";
 1121: }
 1122: 
 1123: ###############################################
 1124: ###############################################
 1125: 
 1126: =pod
 1127: 
 1128: =item &dateboxes()
 1129: 
 1130: Returns html selection form elements for the specification of 
 1131: the day, month, and year.
 1132: 
 1133: =cut
 1134: 
 1135: ###############################################
 1136: ###############################################
 1137: 
 1138: sub dateboxes {
 1139:     my ($name,$defaultmonth,$defaultday,$defaultyear,
 1140: 	$currentmonth,$currentday,$currentyear)=@_;
 1141:     ($defaultmonth,$defaultday,$defaultyear)=('','','');
 1142:     #
 1143:     # Day
 1144:     my $day=<<END;
 1145: <select name="${name}_day">
 1146: <option value='$defaultday'> </option>
 1147: END
 1148:     for (my $i = 1; $i<=31; $i++) {
 1149: 	$day.="<option value=\"$i\">$i</option>\n";
 1150:     }
 1151:     $day.="</select>\n";
 1152:     $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
 1153:     #
 1154:     # Month
 1155:     my $month=<<END;
 1156: <select name="${name}_month">
 1157: <option value='$defaultmonth'> </option>
 1158: END
 1159:     my $i = 1;
 1160:     foreach (qw/January February March April May June 
 1161: 	     July August September October November December /){
 1162: 	$month .="<option value=\"$i\">".&mt($_)."</option>\n";
 1163: 	$i++;
 1164:     }
 1165:     $month.="</select>\n";
 1166:     $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
 1167:     #
 1168:     # Year (obviously)
 1169:     my $year=<<END;
 1170: <select name="${name}_year">
 1171: <option value='$defaultyear'> </option>
 1172: END
 1173:     my $maxyear = 2051; 
 1174:     for (my $i = 1976; $i<=$maxyear; $i++) {
 1175: 	$year.="<option value=\"$i\">$i</option>\n";
 1176:     }
 1177:     $year.="</select>\n";
 1178:     $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
 1179:     return "$month$day$year";
 1180: }
 1181: 
 1182: ###############################################
 1183: ###############################################
 1184: 
 1185: =pod
 1186: 
 1187: =item &selectbox()
 1188: 
 1189: Returns a scalar containing an html <select> form.  
 1190: 
 1191: Inputs: 
 1192: 
 1193: =over 4
 1194: 
 1195: =item $title 
 1196: 
 1197: Printed above the select box, in uppercase.  If undefined, only a select
 1198: box will be returned, with no additional html.
 1199: 
 1200: =item $name 
 1201: 
 1202: The name element of the <select> tag.
 1203: 
 1204: =item $default 
 1205: 
 1206: The default value of the form.  Can be $anyvalue, or in @idlist.
 1207: 
 1208: =item $anyvalue 
 1209: 
 1210: The <option value="..."> used to indicate a default of 
 1211: none of the values.  Can be undef.
 1212: 
 1213: =item $anytag 
 1214: 
 1215: The text associate with $anyvalue above.
 1216: 
 1217: =item $functionref 
 1218: 
 1219: Each element in @idlist will be passed as a parameter 
 1220: to the function referenced here.  The return value of the function should
 1221: be a scalar description of the items.  If this value is undefined the 
 1222: description of each item in @idlist will be the item name.
 1223: 
 1224: =item @idlist 
 1225: 
 1226: The items to be selected from.  One of these or $anyvalue will be the 
 1227: value returned by the form element, $ENV{form.$name}.
 1228: 
 1229: =back
 1230: 
 1231: =cut
 1232: 
 1233: ###############################################
 1234: 
 1235: sub selectbox {
 1236:     my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_;
 1237:     if (! defined($functionref)) { $functionref = sub { $_[0]}; }
 1238:     my $selout='';
 1239:     $title=&mt($title);
 1240:     if (defined($title)) {
 1241:         my $uctitle=uc($title);
 1242:         $selout="\n".'<p><font color="#800000" face="helvetica">'.
 1243:             '<b>'.$uctitle.': </b></font>';
 1244:     }
 1245:     $selout .= '<select name="'.$name.'">';
 1246:     unshift @idlist,$anyvalue if (defined($anyvalue));
 1247:     foreach (@idlist) {
 1248:         $selout.='<option value="'.$_.'"';
 1249:         if ($_ eq $default and !/^any$/) {
 1250: 	    $selout.=' selected >'.&mt(&{$functionref}($_)).'</option>';
 1251: 	}
 1252: 	elsif ($_ eq $default and /^$anyvalue$/) {
 1253: 	    $selout.=' selected >'.&mt($anytag).'</option>';
 1254: 	}
 1255:         else {$selout.='>'.&mt(&{$functionref}($_)).'</option>';}
 1256:     }
 1257:     return $selout.'</select>'.(defined($title)?'</p>':' ');
 1258: }
 1259: 
 1260: ######################################################################
 1261: #                End of HTML form building functions                 #  
 1262: ######################################################################
 1263: 
 1264: =pod
 1265: 
 1266: =back 
 1267: 
 1268: =cut
 1269: 
 1270: 
 1271: ######################################################################
 1272: ######################################################################
 1273: 
 1274: =pod 
 1275: 
 1276: =item &parse_advanced_search()
 1277: 
 1278: Parse advanced search form and return the following:
 1279: 
 1280: =over 4
 1281: 
 1282: =item $query Scalar containing an SQL query.
 1283: 
 1284: =item $customquery Scalar containing a custom query.
 1285: 
 1286: =item $customshow Scalar containing commands to show custom metadata.
 1287: 
 1288: =item $libraries_to_query Reference to array of domains to search.
 1289: 
 1290: =back
 1291: 
 1292: =cut
 1293: 
 1294: ######################################################################
 1295: ######################################################################
 1296: sub parse_advanced_search {
 1297:     my ($r,$closebutton)=@_;
 1298:     my $fillflag=0;
 1299:     my $pretty_search_string = "<br />\n";
 1300:     # Clean up fields for safety
 1301:     for my $field ('title','author','subject','keywords','url','version',
 1302: 		   'creationdatestart_month','creationdatestart_day',
 1303: 		   'creationdatestart_year','creationdateend_month',
 1304: 		   'creationdateend_day','creationdateend_year',
 1305: 		   'lastrevisiondatestart_month','lastrevisiondatestart_day',
 1306: 		   'lastrevisiondatestart_year','lastrevisiondateend_month',
 1307: 		   'lastrevisiondateend_day','lastrevisiondateend_year',
 1308: 		   'notes','abstract','extension','language','owner',
 1309: 		   'custommetadata','customshow','category') {
 1310: 	$ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
 1311:     }
 1312:     foreach ('mode','form','element') {
 1313: 	# is this required?  Hmmm.
 1314: 	next unless (exists($ENV{"form.$_"}));
 1315: 	$ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
 1316: 	$ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
 1317:     }
 1318:     # Preprocess the category form element.
 1319:     $ENV{'form.category'} = 'any' if (! defined($ENV{'form.category'}) ||
 1320:                                       ref($ENV{'form.category'}));
 1321:     #
 1322:     # Check to see if enough information was filled in
 1323:     for my $field ('title','author','subject','keywords','url','version',
 1324: 		   'notes','abstract','category','extension','language',
 1325:                    'owner','custommetadata') {
 1326: 	if (&filled($ENV{"form.$field"})) {
 1327: 	    $fillflag++;
 1328: 	}
 1329:     }
 1330:     unless ($fillflag) {
 1331: 	&output_blank_field_error($r,$closebutton,'phase=disp_adv');
 1332: 	return ;
 1333:     }
 1334:     # Turn the form input into a SQL-based query
 1335:     my $query='';
 1336:     my @queries;
 1337:     my $font = '<font color="#800000" face="helvetica">';
 1338:     # Evaluate logical expression AND/OR/NOT phrase fields.
 1339:     foreach my $field ('title','author','subject','notes','abstract','url',
 1340: 		       'keywords','version','owner') {
 1341: 	if ($ENV{'form.'.$field}) {
 1342:             my $searchphrase = $ENV{'form.'.$field};
 1343:             $pretty_search_string .= $font."$field</font> contains <b>".
 1344:                 $searchphrase."</b>";
 1345:             if ($ENV{'form.'.$field.'_related'}) {
 1346:                 my @New_Words;
 1347:                 ($searchphrase,@New_Words) = &related_version($searchphrase);
 1348:                 if (@New_Words) {
 1349:                     $pretty_search_string .= " with related words: ".
 1350:                         "<b>@New_Words</b>.";
 1351:                 } else {
 1352:                     $pretty_search_string .= " with no related words.";
 1353:                 }
 1354:             }
 1355:             $pretty_search_string .= "<br />\n";
 1356: 	    push @queries,&build_SQL_query($field,$searchphrase);
 1357:         }
 1358:     }
 1359:     #
 1360:     # Make the 'mime' from 'form.category' and 'form.extension'
 1361:     #
 1362:     my $searchphrase;
 1363:     if (exists($ENV{'form.category'})    && 
 1364:         $ENV{'form.category'} !~ /^\s*$/ &&
 1365:         $ENV{'form.category'} ne 'any')     {
 1366:         my @extensions = &Apache::loncommon::filecategorytypes
 1367:                                                    ($ENV{'form.category'});
 1368:         if (scalar(@extensions) > 0) {
 1369:             $searchphrase = join(' OR ',@extensions);
 1370:         }
 1371:     }
 1372:     if (exists($ENV{'form.extension'}) && $ENV{'form.extension'} !~ /^\s*$/) {
 1373:         $searchphrase .= ' OR ' if (defined($searchphrase));
 1374:         my @extensions = split(/,/,$ENV{'form.extension'});
 1375:         $searchphrase .= join(' OR ',@extensions);
 1376:     }
 1377:     if (defined($searchphrase)) {
 1378:         push @queries,&build_SQL_query('mime',$searchphrase);
 1379:         $pretty_search_string .=$font.'mime</font> contains <b>'.
 1380:             $searchphrase.'</b><br />';
 1381:     }
 1382:     #####
 1383:     # Evaluate option lists
 1384:     if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
 1385: 	push @queries,"(language like \"$ENV{'form.language'}\")";
 1386:         $pretty_search_string.=$font."language</font>= ".
 1387:             &Apache::loncommon::languagedescription($ENV{'form.language'}).
 1388:                 "<br />\n";
 1389:     }
 1390:     if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
 1391: 	push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
 1392:         $pretty_search_string.=$font."copyright</font> = ".
 1393:             &Apache::loncommon::copyrightdescription($ENV{'form.copyright'}).
 1394:                 "<br \>\n";
 1395:     }
 1396:     #
 1397:     # Evaluate date windows
 1398:     my $datequery=&build_date_queries(
 1399: 			$ENV{'form.creationdatestart_month'},
 1400: 			$ENV{'form.creationdatestart_day'},
 1401: 			$ENV{'form.creationdatestart_year'},
 1402: 			$ENV{'form.creationdateend_month'},
 1403: 			$ENV{'form.creationdateend_day'},
 1404: 			$ENV{'form.creationdateend_year'},
 1405: 			$ENV{'form.lastrevisiondatestart_month'},
 1406: 			$ENV{'form.lastrevisiondatestart_day'},
 1407: 			$ENV{'form.lastrevisiondatestart_year'},
 1408: 			$ENV{'form.lastrevisiondateend_month'},
 1409: 			$ENV{'form.lastrevisiondateend_day'},
 1410: 			$ENV{'form.lastrevisiondateend_year'},
 1411: 			);
 1412:     # Test to see if date windows are legitimate
 1413:     if ($datequery=~/^Incorrect/) {
 1414: 	&output_date_error($r,$datequery,$closebutton);
 1415: 	return ;
 1416:     } elsif ($datequery) {
 1417:         # Here is where you would set up pretty_search_string to output
 1418:         # date query information.
 1419: 	push @queries,$datequery;
 1420:     }
 1421:     # Process form information for custom metadata querying
 1422:     my $customquery=undef;
 1423: #    if ($ENV{'form.custommetadata'}) {
 1424: #        $pretty_search_string .=$font."Custom Metadata Search</font>: <b>".
 1425: #            $ENV{'form.custommetadata'}."</b><br />\n";
 1426: #	$customquery=&build_custommetadata_query('custommetadata',
 1427: #				      $ENV{'form.custommetadata'});
 1428: #    }
 1429:     my $customshow=undef;
 1430: #    if ($ENV{'form.customshow'}) {
 1431: #        $pretty_search_string .=$font."Custom Metadata Display</font>: <b>".
 1432: #            $ENV{'form.customshow'}."</b><br />\n";
 1433: #	$customshow=$ENV{'form.customshow'};
 1434: #	$customshow=~s/[^\w\s]//g;
 1435: #	my @fields=split(/\s+/,$customshow);
 1436: #	$customshow=join(" ",@fields);
 1437: #    }
 1438:     ## ---------------------------------------------------------------
 1439:     ## Deal with restrictions to given domains
 1440:     ## 
 1441:     my ($libraries_to_query,$pretty_domains_string) = 
 1442:         &parse_domain_restrictions();
 1443:     $pretty_search_string .= $pretty_domains_string."<br />\n";
 1444:     #
 1445:     if (@queries) {
 1446: 	$query=join(" AND ",@queries);
 1447: 	$query="select * from metadata where $query";
 1448:     } elsif ($customquery) {
 1449:         $query = '';
 1450:     }
 1451:     return ($query,$customquery,$customshow,$libraries_to_query,
 1452:             $pretty_search_string);
 1453: }
 1454: 
 1455: sub parse_domain_restrictions {
 1456:     my $libraries_to_query = undef;
 1457:     # $ENV{'form.domains'} can be either a scalar or an array reference.
 1458:     # We need an array.
 1459:     if (! exists($ENV{'form.domains'})) {
 1460:         return (undef,'');
 1461:     }
 1462:     my @allowed_domains;
 1463:     if (ref($ENV{'form.domains'})) {
 1464:         @allowed_domains =  @{$ENV{'form.domains'}};
 1465:     } else {
 1466:         @allowed_domains = ($ENV{'form.domains'});
 1467:     }
 1468:     my %domain_hash = ();
 1469:     my $pretty_domains_string;
 1470:     foreach (@allowed_domains) {
 1471:         $domain_hash{$_}++;
 1472:     }
 1473:     if ($domain_hash{'any'}) {
 1474:         $pretty_domains_string = "In all LON-CAPA domains.";
 1475:     } else {
 1476:         if (@allowed_domains > 1) {
 1477:             $pretty_domains_string = "In LON-CAPA domains:";
 1478:         } else {
 1479:             $pretty_domains_string = "In LON-CAPA domain ";
 1480:         }
 1481:         foreach (sort @allowed_domains) {
 1482:             $pretty_domains_string .= "<b>".$_."</b> ";
 1483:         }
 1484:         foreach (keys(%Apache::lonnet::libserv)) {
 1485:             if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) {
 1486:                 push @$libraries_to_query,$_;
 1487:             }
 1488:         }
 1489:     }
 1490:     return ($libraries_to_query,$pretty_domains_string);
 1491: }
 1492: 
 1493: ######################################################################
 1494: ######################################################################
 1495: 
 1496: =pod 
 1497: 
 1498: =item &parse_basic_search() 
 1499: 
 1500: Parse the basic search form and return a scalar containing an sql query.
 1501: 
 1502: =cut
 1503: 
 1504: ######################################################################
 1505: ######################################################################
 1506: sub parse_basic_search {
 1507:     my ($r,$closebutton)=@_;
 1508:     # Clean up fields for safety
 1509:     for my $field ('basicexp') {
 1510: 	$ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
 1511:     }
 1512:     foreach ('mode','form','element') {
 1513: 	# is this required?  Hmmm.
 1514: 	next unless (exists($ENV{"form.$_"}));
 1515: 	$ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
 1516: 	$ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
 1517:     }
 1518:     my ($libraries_to_query,$pretty_domains_string) = 
 1519:         &parse_domain_restrictions();
 1520:     # Check to see if enough is filled in
 1521:     unless (&filled($ENV{'form.basicexp'})) {
 1522: 	&output_blank_field_error($r,$closebutton,'phase=disp_basic');
 1523: 	return OK;
 1524:     }
 1525:     my $pretty_search_string = '<b>'.$ENV{'form.basicexp'}.'</b>';
 1526:     my $search_string = $ENV{'form.basicexp'};
 1527:     if ($ENV{'form.related'}) {
 1528:         my @New_Words;
 1529:         ($search_string,@New_Words) = &related_version($ENV{'form.basicexp'});
 1530:         if (@New_Words) {
 1531:             $pretty_search_string .= " with related words: <b>@New_Words</b>.";
 1532:         } else {
 1533:             $pretty_search_string .= " with no related words.";
 1534:         }
 1535:     }
 1536:     # Build SQL query string based on form page
 1537:     my $query='';
 1538:     my $concatarg=join(',',
 1539: 		       ('title', 'author', 'subject', 'notes', 'abstract',
 1540:                         'keywords'));
 1541:     $concatarg='title' if $ENV{'form.titleonly'};
 1542:     $query=&build_SQL_query('concat_ws(" ",'.$concatarg.')',$search_string);
 1543:     if (defined($pretty_domains_string) && $pretty_domains_string ne '') {
 1544:         $pretty_search_string .= ' '.$pretty_domains_string;
 1545:     }
 1546:     $pretty_search_string .= "<br />\n";
 1547:     my $final_query = 'SELECT * FROM metadata WHERE '.$query;
 1548: #    &Apache::lonnet::logthis($final_query);
 1549:     return ($final_query,$pretty_search_string,
 1550:             $libraries_to_query);
 1551: }
 1552: 
 1553: 
 1554: ######################################################################
 1555: ######################################################################
 1556: 
 1557: =pod 
 1558: 
 1559: =item &related_version
 1560: 
 1561: Modifies an input string to include related words.  Words in the string
 1562: are replaced with parenthesized lists of 'OR'd words.  For example
 1563: "torque" is replaced with "(torque OR word1 OR word2 OR ...)".  
 1564: 
 1565: Note: Using this twice on a string is probably silly.
 1566: 
 1567: =cut
 1568: 
 1569: ######################################################################
 1570: ######################################################################
 1571: sub related_version {
 1572:     my $search_string = shift;
 1573:     my $result = $search_string;
 1574:     my %New_Words = ();
 1575:     while ($search_string =~ /(\w+)/cg) {
 1576:         my $word = $1;
 1577:         next if (lc($word) =~ /\b(or|and|not)\b/);
 1578:         my @Words = &Apache::loncommon::get_related_words($word);
 1579:         @Words = ($#Words>4? @Words[0..4] : @Words);
 1580:         foreach (@Words) { $New_Words{$_}++;}
 1581:         my $replacement = join " OR ", ($word,@Words);
 1582:         $result =~ s/(\b)$word(\b)/$1($replacement)$2/g;
 1583:     }
 1584:     return $result,sort(keys(%New_Words));
 1585: }
 1586: 
 1587: ######################################################################
 1588: ######################################################################
 1589: 
 1590: =pod 
 1591: 
 1592: =item &build_SQL_query() 
 1593: 
 1594: Builds a SQL query string from a logical expression with AND/OR keywords
 1595: using Text::Query and &recursive_SQL_query_builder()
 1596: 
 1597: =cut
 1598: 
 1599: ######################################################################
 1600: ######################################################################
 1601: sub build_SQL_query {
 1602:     my ($field_name,$logic_statement)=@_;
 1603:     my $q=new Text::Query('abc',
 1604: 			  -parse => 'Text::Query::ParseAdvanced',
 1605: 			  -build => 'Text::Query::Build');
 1606:     $q->prepare($logic_statement);
 1607:     my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
 1608:     my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
 1609:     return $sql_query;
 1610: }
 1611: 
 1612: ######################################################################
 1613: ######################################################################
 1614: 
 1615: =pod 
 1616: 
 1617: =item &build_custommetadata_query() 
 1618: 
 1619: Constructs a custom metadata query using a rather heinous regular
 1620: expression.
 1621: 
 1622: =cut
 1623: 
 1624: ######################################################################
 1625: ######################################################################
 1626: sub build_custommetadata_query {
 1627:     my ($field_name,$logic_statement)=@_;
 1628:     my $q=new Text::Query('abc',
 1629: 			  -parse => 'Text::Query::ParseAdvanced',
 1630: 			  -build => 'Text::Query::BuildAdvancedString');
 1631:     $q->prepare($logic_statement);
 1632:     my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
 1633:     # quick fix to change literal into xml tag-matching
 1634:     # will eventually have to write a separate builder module
 1635:     # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
 1636:     $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to 
 1637:                  /\\<$1\\>?#           \<wordone\>
 1638:                    \[\^\\<\]?#        [^\<]         
 1639:                    \*$2\[\^\\<\]?#           *wordtwo[^\<]
 1640:                    \*\\<\\\/$1\\>?#                        *\<\/wordone\>
 1641:                    /g;
 1642:     return $matchexp;
 1643: }
 1644: 
 1645: ######################################################################
 1646: ######################################################################
 1647: 
 1648: =pod 
 1649: 
 1650: =item &recursive_SQL_query_build() 
 1651: 
 1652: Recursively constructs an SQL query.  Takes as input $dkey and $pattern.
 1653: 
 1654: =cut
 1655: 
 1656: ######################################################################
 1657: ######################################################################
 1658: sub recursive_SQL_query_build {
 1659:     my ($dkey,$pattern)=@_;
 1660:     my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
 1661:     return $pattern unless @matches;
 1662:     foreach my $match (@matches) {
 1663:         $match=~/\[ (\w+)\s(.*) \]/;
 1664:         my ($key,$value)=($1,$2);
 1665:         my $replacement='';
 1666:         if ($key eq 'literal') {
 1667:             $replacement="($dkey LIKE \"\%$value\%\")";
 1668:         } elsif (lc($key) eq 'not') {
 1669:             $value=~s/LIKE/NOT LIKE/;
 1670: #          $replacement="($dkey not like $value)";
 1671:             $replacement="$value";
 1672:         } elsif ($key eq 'and') {
 1673:             $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
 1674:             $replacement="($1 AND $2)";
 1675: 	} elsif ($key eq 'or') {
 1676:             $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
 1677:             $replacement="($1 OR $2)";
 1678: 	}
 1679: 	substr($pattern,
 1680:                index($pattern,$match),
 1681:                length($match),
 1682:                $replacement);
 1683:     }
 1684:     &recursive_SQL_query_build($dkey,$pattern);
 1685: }
 1686: 
 1687: ######################################################################
 1688: ######################################################################
 1689: 
 1690: =pod 
 1691: 
 1692: =item &build_date_queries() 
 1693: 
 1694: Builds a SQL logic query to check time/date entries.
 1695: Also reports errors (check for /^Incorrect/).
 1696: 
 1697: =cut
 1698: 
 1699: ######################################################################
 1700: ######################################################################
 1701: sub build_date_queries {
 1702:     my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
 1703: 	$lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
 1704:     my @queries;
 1705:     if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) {
 1706: 	unless ($cmonth1 and $cday1 and $cyear1 and
 1707: 		$cmonth2 and $cday2 and $cyear2) {
 1708: 	    return "Incorrect entry for the creation date.  You must specify ".
 1709: 		   "a starting month, day, and year and an ending month, ".
 1710: 		   "day, and year.";
 1711: 	}
 1712: 	my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1);
 1713: 	$cnumeric1+=0;
 1714: 	my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2);
 1715: 	$cnumeric2+=0;
 1716: 	if ($cnumeric1>$cnumeric2) {
 1717: 	    return "Incorrect entry for the creation date.  The starting ".
 1718: 		   "date must occur before the ending date.";
 1719: 	}
 1720: 	my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '".
 1721: 	           "$cyear2-$cmonth2-$cday2 23:59:59')";
 1722: 	push @queries,$cquery;
 1723:     }
 1724:     if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) {
 1725: 	unless ($lmonth1 and $lday1 and $lyear1 and
 1726: 		$lmonth2 and $lday2 and $lyear2) {
 1727: 	    return "Incorrect entry for the last revision date.  You must ".
 1728: 		   "specify a starting month, day, and year and an ending ".
 1729: 		   "month, day, and year.";
 1730: 	}
 1731: 	my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1);
 1732: 	$lnumeric1+=0;
 1733: 	my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2);
 1734: 	$lnumeric2+=0;
 1735: 	if ($lnumeric1>$lnumeric2) {
 1736: 	    return "Incorrect entry for the last revision date.  The ".
 1737: 		   "starting date must occur before the ending date.";
 1738: 	}
 1739: 	my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '".
 1740: 	           "$lyear2-$lmonth2-$lday2 23:59:59')";
 1741: 	push @queries,$lquery;
 1742:     }
 1743:     if (@queries) {
 1744: 	return join(" AND ",@queries);
 1745:     }
 1746:     return '';
 1747: }
 1748: 
 1749: ######################################################################
 1750: ######################################################################
 1751: 
 1752: =pod
 1753: 
 1754: =item &copyright_check()
 1755: 
 1756: =cut
 1757: 
 1758: ######################################################################
 1759: ######################################################################
 1760: sub copyright_check {
 1761:     my $Metadata = shift;
 1762:     # Check copyright tags and skip results the user cannot use
 1763:     my (undef,undef,$resdom,$resname) = split('/',
 1764:                                               $Metadata->{'url'});
 1765:     # Check for priv
 1766:     if (($Metadata->{'copyright'} eq 'priv') && 
 1767:         (($ENV{'user.name'} ne $resname) &&
 1768:          ($ENV{'user.domain'} ne $resdom))) {
 1769:         return 0;
 1770:     }
 1771:     # Check for domain
 1772:     if (($Metadata->{'copyright'} eq 'domain') &&
 1773:         ($ENV{'user.domain'} ne $resdom)) {
 1774:         return 0;
 1775:     }
 1776:     return 1;
 1777: }
 1778: 
 1779: 
 1780: ######################################################################
 1781: ######################################################################
 1782: 
 1783: =pod
 1784: 
 1785: =item &ensure_db_and_table
 1786: 
 1787: Ensure we can get lonmysql to connect to the database and the table we
 1788: need exists.
 1789: 
 1790: Inputs: $r, table id
 1791: 
 1792: Returns: undef on error, 1 if the table exists.
 1793: 
 1794: =cut
 1795: 
 1796: ######################################################################
 1797: ######################################################################
 1798: sub ensure_db_and_table {
 1799:     my ($r,$table) = @_;
 1800:     ##
 1801:     ## Sanity check the table id.
 1802:     ##
 1803:     if (! defined($table) || $table eq '' || $table =~ /\D/ ) {
 1804:         $r->print("Unable to retrieve search results.  ".
 1805:                   "Unable to determine the table results were stored in.  ".
 1806:                   "</body></html>");
 1807:         return undef;
 1808:     }
 1809:     ##
 1810:     ## Make sure we can connect and the table exists.
 1811:     ##
 1812:     my $connection_result = &Apache::lonmysql::connect_to_db();
 1813:     if (!defined($connection_result)) {
 1814:         $r->print("Unable to connect to the MySQL database where your results".
 1815:                   " are stored. </body></html>");
 1816:         &Apache::lonnet::logthis("lonsearchcat: unable to get lonmysql to".
 1817:                                  " connect to database.");
 1818:         &Apache::lonnet::logthis(&Apache::lonmysql::get_error());
 1819:         return undef;
 1820:     }
 1821:     my $table_check = &Apache::lonmysql::check_table($table);
 1822:     if (! defined($table_check)) {
 1823:         $r->print("A MySQL error has occurred.</form></body></html>");
 1824:         &Apache::lonnet::logthis("lonmysql was unable to determine the status".
 1825:                                  " of table ".$table);
 1826:         return undef;
 1827:     } elsif (! $table_check) {
 1828:         $r->print("The table of results could not be found.");
 1829:         &Apache::lonnet::logthis("The user requested a table, ".$table.
 1830:                                  ", that could not be found.");
 1831:         return undef;
 1832:     }
 1833:     return 1;
 1834: }
 1835: 
 1836: ######################################################################
 1837: ######################################################################
 1838: 
 1839: =pod
 1840: 
 1841: =item &print_sort_form
 1842: 
 1843: =cut
 1844: 
 1845: ######################################################################
 1846: ######################################################################
 1847: sub print_sort_form {
 1848:     my ($r,$pretty_query_string) = @_;
 1849:     ##
 1850:     my %SortableFields=&Apache::lonlocal::texthash( 
 1851:          id        => 'Default',
 1852:          title     => 'Title',
 1853:          author    => 'Author',
 1854:          subject   => 'Subject',
 1855:          url       => 'URL',
 1856:          version   => 'Version Number',
 1857:          mime      => 'Mime type',
 1858:          lang      => 'Language',
 1859:          owner     => 'Owner/Publisher',
 1860:          copyright => 'Copyright',
 1861:          hostname  => 'Host',
 1862:          creationdate     => 'Creation Date',
 1863:          lastrevisiondate => 'Revision Date'
 1864:      );
 1865:     ##
 1866:     my $table = $ENV{'form.table'};
 1867:     return if (! &ensure_db_and_table($r,$table));
 1868:     ##
 1869:     ## Get the number of results 
 1870:     ##
 1871:     my $total_results = &Apache::lonmysql::number_of_rows($table);
 1872:     if (! defined($total_results)) {
 1873:         $r->print("A MySQL error has occurred.</form></body></html>");
 1874:         &Apache::lonnet::logthis("lonmysql was unable to determine the number".
 1875:                                  " of rows in table ".$table);
 1876:         &Apache::lonnet::logthis(&Apache::lonmysql::get_error());
 1877:         return;
 1878:     }
 1879:     my $result;
 1880:     $result.=<<END;
 1881: <html>
 1882: <head>
 1883: <script>
 1884:     function change_sort() {
 1885:         var newloc = "/adm/searchcat?phase=results";
 1886:         newloc += "&persistent_db_id=$ENV{'form.persistent_db_id'}";
 1887:         newloc += "&sortby=";
 1888:         newloc += document.forms.statusform.elements.sortby.value;
 1889:         parent.resultsframe.location= newloc;
 1890:     }
 1891: </script>
 1892: <title>Results</title>
 1893: </head>
 1894: $bodytag
 1895: <form name="statusform" action="" method="post">
 1896: <input type="hidden" name="Queue" value="" />
 1897: END
 1898: 
 1899: #<h2>Sort Results</h2>
 1900: #Sort by: <select size="1" name="sortby" onchange="javascript:change_sort();">
 1901: #    $ENV{'form.sortby'} = 'id' if (! defined($ENV{'form.sortby'}));
 1902: #    foreach (keys(%SortableFields)) {
 1903: #        $result.="<option name=\"$_\"";
 1904: #        if ($_ eq $ENV{'form.sortby'}) {
 1905: #            $result.=" selected ";
 1906: #        }
 1907: #        $result.=" >$SortableFields{$_}</option>\n";
 1908: #    }
 1909: #    $result.="</select>\n";
 1910:     my $revise = &revise_button();
 1911:     $result.=<<END;
 1912: <p>
 1913: There are $total_results matches to your query. $revise
 1914: </p><p>
 1915: Search:$pretty_query_string
 1916: </p>
 1917: </form>
 1918: </body>
 1919: </html>
 1920: END
 1921:     $r->print($result);
 1922:     return;
 1923: }
 1924: 
 1925: #####################################################################
 1926: #####################################################################
 1927: 
 1928: =pod
 1929: 
 1930: =item MySQL Table Description
 1931: 
 1932: MySQL table creation requires a precise description of the data to be
 1933: stored.  The use of the correct types to hold data is vital to efficient
 1934: storage and quick retrieval of records.  The columns must be described in
 1935: the following format:
 1936: 
 1937: =cut
 1938: 
 1939: #####################################################################
 1940: #####################################################################
 1941: 
 1942: my @Datatypes = 
 1943:     ( { name => 'id', 
 1944:         type => 'MEDIUMINT',
 1945:         restrictions => 'UNSIGNED NOT NULL',
 1946:         primary_key  => 'yes',
 1947:         auto_inc     => 'yes' },
 1948:       { name => 'title',     type=>'TEXT'},
 1949:       { name => 'author',    type=>'TEXT'},
 1950:       { name => 'subject',   type=>'TEXT'},
 1951:       { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
 1952:       { name => 'keywords',  type=>'TEXT'},
 1953:       { name => 'version',   type=>'TEXT'},
 1954:       { name => 'notes',     type=>'TEXT'},
 1955:       { name => 'abstract',  type=>'TEXT'},
 1956:       { name => 'mime',      type=>'TEXT'},
 1957:       { name => 'lang',      type=>'TEXT'},
 1958:       { name => 'owner',     type=>'TEXT'},
 1959:       { name => 'copyright', type=>'TEXT'},
 1960:       { name => 'hostname',  type=>'TEXT'},
 1961:       #--------------------------------------------------
 1962:       { name => 'creationdate',     type=>'DATETIME'},
 1963:       { name => 'lastrevisiondate', type=>'DATETIME'},
 1964:       #--------------------------------------------------
 1965:       );
 1966: 
 1967: my @Fullindicies = 
 1968:     qw/title/;
 1969: #    qw/title author subject abstract mime language owner copyright/;
 1970:     
 1971: ######################################################################
 1972: ######################################################################
 1973: 
 1974: =pod
 1975: 
 1976: =item &create_results_table()
 1977: 
 1978: Creates the table of search results by calling lonmysql.  Stores the
 1979: table id in $ENV{'form.table'}
 1980: 
 1981: Inputs: none.
 1982: 
 1983: Returns: the identifier of the table on success, undef on error.
 1984: 
 1985: =cut
 1986: 
 1987: ######################################################################
 1988: ######################################################################
 1989: sub create_results_table {
 1990:     my $table = &Apache::lonmysql::create_table
 1991:         ( { columns => \@Datatypes,
 1992:             FULLTEXT => [{'columns' => \@Fullindicies},],
 1993:         } );
 1994:     if (defined($table)) {
 1995:         $ENV{'form.table'} = $table;
 1996:         return $table;
 1997:     } 
 1998:     return undef; # Error...
 1999: }
 2000: 
 2001: ######################################################################
 2002: ######################################################################
 2003: 
 2004: =pod
 2005: 
 2006: =item Search Status update functions
 2007: 
 2008: Each of the following functions changes the values of one of the
 2009: input fields used to display the search status to the user.  The names
 2010: should be explanatory.
 2011: 
 2012: Inputs: Apache request handler ($r), text to display.
 2013: 
 2014: Returns: Nothing.
 2015: 
 2016: =over 4
 2017: 
 2018: =item &update_count_status()
 2019: 
 2020: =item &update_status()
 2021: 
 2022: =item &update_seconds()
 2023: 
 2024: =back
 2025: 
 2026: =cut
 2027: 
 2028: ######################################################################
 2029: ######################################################################
 2030: sub update_count_status {
 2031:     my ($r,$text) = @_;
 2032:     $text =~ s/\'/\\\'/g;
 2033:     $r->print
 2034:         ("<script>document.statusform.count.value = ' $text'</script>\n");
 2035:     $r->rflush();
 2036: }
 2037: 
 2038: sub update_status {
 2039:     my ($r,$text) = @_;
 2040:     $text =~ s/\'/\\\'/g;
 2041:     $text=&mt($text);
 2042:     $r->print
 2043:         ("<script>document.statusform.status.value = ' $text'</script>\n");
 2044:     $r->rflush();
 2045: }
 2046: 
 2047: sub update_seconds {
 2048:     my ($r,$text) = @_;
 2049:     $text =~ s/\'/\\\'/g;
 2050:     $r->print
 2051:         ("<script>document.statusform.seconds.value = ' $text'</script>\n");
 2052:     $r->rflush();
 2053: }
 2054: 
 2055: ######################################################################
 2056: ######################################################################
 2057: 
 2058: =pod
 2059: 
 2060: =item &revise_button
 2061: 
 2062: Inputs: None
 2063: 
 2064: Returns: html string for a 'revise search' button.
 2065: 
 2066: =cut
 2067: 
 2068: ######################################################################
 2069: ######################################################################
 2070: sub revise_button {
 2071:     my $revise_phase = 'disp_basic';
 2072:     $revise_phase = 'disp_adv' if ($ENV{'form.searchmode'} eq 'advanced');
 2073:     my $newloc = '/adm/searchcat'.
 2074:         '?persistent_db_id='.$ENV{'form.persistent_db_id'}.
 2075:             '&cleargroupsort=1'.
 2076:             '&phase='.$revise_phase;
 2077:     my $result = qq{<input type="button" value="Revise search" name="revise"} .
 2078:         qq{ onClick="parent.location='$newloc';" /> };
 2079:     return $result;
 2080: }
 2081: 
 2082: ######################################################################
 2083: ######################################################################
 2084: 
 2085: =pod
 2086: 
 2087: =item &run_search 
 2088: 
 2089: =cut
 2090: 
 2091: ######################################################################
 2092: ######################################################################
 2093: sub run_search {
 2094:     my ($r,$query,$customquery,$customshow,$serverlist,$pretty_string) = @_;
 2095:     my $connection = $r->connection;
 2096:     #
 2097:     # Timing variables
 2098:     #
 2099:     my $starttime = time;
 2100:     my $max_time  = 30;  # seconds for the search to complete
 2101:     #
 2102:     # Print run_search header
 2103:     #
 2104:     $r->print(<<END);
 2105: <html>
 2106: <head><title>Search Status</title></head>
 2107: $bodytag
 2108: <form name="statusform" action="" method="post">
 2109: <input type="hidden" name="Queue" value="" />
 2110: END
 2111:     # Check to see if $pretty_string has more than one carriage return.
 2112:     # Assume \n s are following <br /> s and truncate the value.
 2113:     # (there is probably a better way)...
 2114:     my @Lines = split /<br \/>/,$pretty_string;
 2115:     if (@Lines > 2) {
 2116:         $pretty_string = join '<br \>',(@Lines[0..2],'....<br />');
 2117:     }
 2118:     $r->print(&mt("Search").": ".$pretty_string);
 2119:     $r->rflush();
 2120:     #
 2121:     # Determine the servers we need to contact.
 2122:     #
 2123:     my @Servers_to_contact;
 2124:     if (defined($serverlist)) {
 2125:         if (ref($serverlist) eq 'ARRAY') {
 2126:             @Servers_to_contact = @$serverlist;
 2127:         } else {
 2128:             @Servers_to_contact = ($serverlist);
 2129:         }
 2130:     } else {
 2131:         @Servers_to_contact = sort(keys(%Apache::lonnet::libserv));
 2132:     }
 2133:     my %Server_status;
 2134:     my $table =$ENV{'form.table'};
 2135:     if (! defined($table) || $table eq '' || $table =~ /\D/ ) {
 2136:         $r->print("Unable to determine table id to store search results in.".
 2137:                   "The search has been aborted.</body></html>");
 2138:         return;
 2139:     }
 2140:     my $table_status = &Apache::lonmysql::check_table($table);
 2141:     if (! defined($table_status)) {
 2142:         $r->print("Unable to determine status of table.</body></html>");
 2143:         &Apache::lonnet::logthis("Bogus table id of $table for ".
 2144:                                  "$ENV{'user.name'} @ $ENV{'user.domain'}");
 2145:         &Apache::lonnet::logthis("lonmysql error = ".
 2146:                                  &Apache::lonmysql::get_error());
 2147:         return;
 2148:     }
 2149:     if (! $table_status) {
 2150:         $r->print("The table id,$table, we tried to use is invalid.".
 2151:                   "The search has been aborted.</body></html>");
 2152:         return;
 2153:     }
 2154:     ##
 2155:     ## Prepare for the big loop.
 2156:     ##
 2157:     my $hitcountsum;
 2158:     my $server; 
 2159:     my $status;
 2160:     my $revise = &revise_button();
 2161:     $r->print(<<END);
 2162: <table>
 2163: <tr><th>Status</th><th>Total Matches</th><th>Time Remaining</th><th></th></tr>
 2164: <tr>
 2165: <td><input type="text" name="status"  value="" size="30" /></td>
 2166: <td><input type="text" name="count"   value="" size="10" /></td>
 2167: <td><input type="text" name="seconds" value="" size="8" /></td>
 2168: <td>$revise</td>
 2169: </tr>
 2170: </table>
 2171: </form>
 2172: END
 2173:     $r->rflush();
 2174:     my $time_remaining = $max_time - (time - $starttime) ;
 2175:     my $last_time = $time_remaining;
 2176:     &update_seconds($r,$time_remaining);
 2177:     &update_status($r,'contacting '.$Servers_to_contact[0]);
 2178:     while (($time_remaining > 0) &&
 2179:            ((@Servers_to_contact) || keys(%Server_status))) {
 2180:         # Send out a search request if it needs to be done.
 2181:         if (@Servers_to_contact) {
 2182:             # Contact one server
 2183:             my $server = shift(@Servers_to_contact);
 2184:             &update_status($r,'contacting '.$server);
 2185:             my $reply=&Apache::lonnet::metadata_query($query,$customquery,
 2186:                                                       $customshow,[$server]);
 2187:             ($server) = keys(%$reply);
 2188:             $Server_status{$server} = $reply->{$server};
 2189:         } else {
 2190:             # wait a sec. to give time for files to be written
 2191:             # This sleep statement is here instead of outside the else 
 2192:             # block because we do not want to pause if we have servers
 2193:             # left to contact.  
 2194:             if (scalar (keys(%Server_status))) {
 2195:                 &update_status($r,
 2196:                                'waiting on '.(join(' ',keys(%Server_status))));
 2197:             }
 2198:             sleep(1); 
 2199:         }
 2200:         #
 2201:         #
 2202:         # Loop through the servers we have contacted but do not
 2203:         # have results from yet, looking for results.
 2204:         while (my ($server,$status) = each(%Server_status)) {
 2205:             last if ($connection->aborted());
 2206:             if ($status eq 'con_lost') {
 2207:                 delete ($Server_status{$server});
 2208:                 next;
 2209:             }
 2210:             $status=~/^([\.\w]+)$/; 
 2211:        	    my $datafile=$r->dir_config('lonDaemons').'/tmp/'.$1;
 2212:             if (-e $datafile && ! -e "$datafile.end") {
 2213:                 &update_status($r,'Receiving results from '.$server);
 2214:                 next;
 2215:             }
 2216:             last if ($connection->aborted());
 2217:             if (-e "$datafile.end") {
 2218:                 &update_status($r,'Reading results from '.$server);
 2219:                 if (-z "$datafile") {
 2220:                     delete($Server_status{$server});
 2221:                     next;
 2222:                 }
 2223:                 my $fh;
 2224:                 if (!($fh=Apache::File->new($datafile))) { 
 2225:                     $r->print("Unable to open search results file for ".
 2226:                                   "server $server.  Omitting from search");
 2227:                     delete($Server_status{$server}); 
 2228:                    next;
 2229:                 }
 2230:                 # Read in the whole file.
 2231:                 while (my $result = <$fh>) {
 2232:                     last if ($connection->aborted());
 2233:                     # handle custom fields?  Someday we will!
 2234:                     chomp($result);
 2235:                     next unless $result;
 2236:                     # Parse the result.
 2237:                     my %Fields = &parse_raw_result($result,$server);
 2238:                     $Fields{'hostname'} = $server;
 2239:                     next if (! &copyright_check(\%Fields));
 2240:                     # Store the result in the mysql database
 2241:                     my $result = &Apache::lonmysql::store_row($table,\%Fields);
 2242:                     if (! defined($result)) {
 2243:                         $r->print(&Apache::lonmysql::get_error());
 2244:                     }
 2245:                     # $r->print(&Apache::lonmysql::get_debug());
 2246:                     $hitcountsum ++;
 2247:                     $time_remaining = $max_time - (time - $starttime) ;
 2248:                     if ($last_time - $time_remaining > 0) {
 2249:                         &update_seconds($r,$time_remaining);
 2250:                         $last_time = $time_remaining;
 2251:                     }
 2252:                     if ($hitcountsum % 50 == 0) {
 2253:                         &update_count_status($r,$hitcountsum);
 2254:                     }
 2255:                 } # End of foreach (@results)
 2256:                 $fh->close();
 2257:                 # $server is only deleted if the results file has been 
 2258:                 # found and (successfully) opened.  This may be a bad idea.
 2259:                 delete($Server_status{$server});
 2260:             }
 2261:             last if ($connection->aborted());
 2262:             &update_count_status($r,$hitcountsum);
 2263:         }
 2264:         last if ($connection->aborted());
 2265:         # Finished looping through the servers
 2266:         $starttime = time if (@Servers_to_contact);
 2267:         $time_remaining = $max_time - (time - $starttime) ;
 2268:         if ($last_time - $time_remaining > 0) {
 2269:             $last_time = $time_remaining;
 2270:             &update_seconds($r,$time_remaining);
 2271:         }
 2272:     }
 2273:     &update_status($r,'Search Complete'.$server);
 2274:     &update_seconds($r,0);
 2275:     &Apache::lonmysql::disconnect_from_db();
 2276:     # We have run out of time or run out of servers to talk to and
 2277:     # results to get.  
 2278:     $r->print("</body></html>");
 2279:     if ($ENV{'form.catalogmode'} ne 'groupsearch') {
 2280:         $r->print("<script>".
 2281:                       "window.location='/adm/searchcat?".
 2282:                       "phase=sort&".
 2283:                       "persistent_db_id=$ENV{'form.persistent_db_id'}';".
 2284:                   "</script>");
 2285:     }
 2286:     return;
 2287: }
 2288: 
 2289: ######################################################################
 2290: ######################################################################
 2291: =pod
 2292: 
 2293: =item &prev_next_buttons
 2294: 
 2295: =cut
 2296: 
 2297: ######################################################################
 2298: ######################################################################
 2299: sub prev_next_buttons {
 2300:     my ($current_min,$show,$total,$parms) = @_;
 2301:     return '' if ($show eq 'all'); # No links if you get them all at once.
 2302:     my $links;
 2303:     ##
 2304:     ## Prev
 2305:     my $prev_min = $current_min - $show;
 2306:     $prev_min = 1 if $prev_min < 1;
 2307:     if ($prev_min < $current_min) {
 2308:         $links .= qq{
 2309: <a href="/adm/searchcat?$parms&start=$prev_min&show=$show">prev</a>
 2310: };    
 2311:     } else {
 2312:         $links .= 'prev';
 2313:     }
 2314:     ##
 2315:     ## Pages.... Someday.
 2316:     ##
 2317:     $links .= qq{ &nbsp;
 2318: <a href="/adm/searchcat?$parms&start=$current_min&$show=$show">reload</a>
 2319: };
 2320:     ##
 2321:     ## Next
 2322:     my $next_min = $current_min + $show;
 2323:     $next_min = $current_min if ($next_min > $total);
 2324:     if ($next_min != $current_min) {
 2325:         $links .= qq{ &nbsp;
 2326: <a href="/adm/searchcat?$parms&start=$next_min&show=$show">next</a>
 2327: };    
 2328:     } else {
 2329:         $links .= '&nbsp;next';
 2330:     }
 2331:     return $links;
 2332: }
 2333: ######################################################################
 2334: ######################################################################
 2335: 
 2336: =pod
 2337: 
 2338: =item &display_results
 2339: 
 2340: =cut
 2341: 
 2342: ######################################################################
 2343: ######################################################################
 2344: sub display_results {
 2345:     my ($r,$importbutton,$closebutton) = @_;
 2346:     my $connection = $r->connection;
 2347:     $r->print(&search_results_header($importbutton,$closebutton));
 2348:     ##
 2349:     ## Set viewing function
 2350:     ##
 2351:     my $viewfunction = $Views{$ENV{'form.viewselect'}};
 2352:     if (!defined($viewfunction)) {
 2353:         $r->print("Internal Error - Bad view selected.\n");
 2354:         $r->rflush();
 2355:         return;
 2356:     }
 2357:     ##
 2358:     ## $checkbox_num is a count of the number of checkboxes output on the 
 2359:     ## page this is used only during catalogmode=groupsearch.
 2360:     my $checkbox_num = 0;
 2361:     ##
 2362:     ## Get the catalog controls setup
 2363:     ##
 2364:     my $action = "/adm/searchcat?phase=results";
 2365:     ##
 2366:     ## Deal with groupsearch
 2367:     ##
 2368:     if ($ENV{'form.catalogmode'} eq 'groupsearch') {
 2369:         if (! tie(%groupsearch_db,'GDBM_File',$diropendb,
 2370:                   &GDBM_WRCREAT(),0640)) {
 2371:             $r->print('Unable to store import results.</form></body></html>');
 2372:             $r->rflush();
 2373:             return;
 2374:         } 
 2375:     }
 2376:     ##
 2377:     ## Prepare the table for querying
 2378:     ##
 2379:     my $table = $ENV{'form.table'};
 2380:     return if (! &ensure_db_and_table($r,$table));
 2381:     ##
 2382:     ## Get the number of results 
 2383:     ##
 2384:     my $total_results = &Apache::lonmysql::number_of_rows($table);
 2385:     if (! defined($total_results)) {
 2386:         $r->print("A MySQL error has occurred.</form></body></html>");
 2387:         &Apache::lonnet::logthis("lonmysql was unable to determine the number".
 2388:                                  " of rows in table ".$table);
 2389:         &Apache::lonnet::logthis(&Apache::lonmysql::get_error());
 2390:         return;
 2391:     }
 2392:     ##
 2393:     ## Determine how many results we need to get
 2394:     ##
 2395:     $ENV{'form.start'} = 1      if (! exists($ENV{'form.start'}));
 2396:     $ENV{'form.show'}  = 'all'  if (! exists($ENV{'form.show'}));
 2397:     my $min = $ENV{'form.start'};
 2398:     my $max;
 2399:     if ($ENV{'form.show'} eq 'all') {
 2400:         $max = $total_results ;
 2401:     } else {
 2402:         $max = $min + $ENV{'form.show'} - 1;
 2403:         $max = $total_results if ($max > $total_results);
 2404:     }
 2405:     ##
 2406:     ## Output links (if necessary) for 'prev' and 'next' pages.
 2407:     ##
 2408:     $r->print
 2409:         ('<center>'.
 2410:          &prev_next_buttons($min,$ENV{'form.show'},$total_results,
 2411:                             "table=".$ENV{'form.table'}.
 2412:                             "&phase=results".
 2413:                             "&persistent_db_id=".$ENV{'form.persistent_db_id'})
 2414:          ."</center>\n"
 2415:          );
 2416:     if ($total_results == 0) {
 2417:         $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="1">'.
 2418:                   '<h3>'.&mt('There are currently no results').'.</h3>'.
 2419:                   "</form></body></html>");
 2420:         return;
 2421:     } else {
 2422:         $r->print
 2423:             ("<center>Results $min to $max out of $total_results</center>\n");
 2424:     }
 2425:     ##
 2426:     ## Get results from MySQL table
 2427:     ##
 2428:     my @Results = &Apache::lonmysql::get_rows($table,
 2429:                                               'id>='.$min.' AND id<='.$max);
 2430:     ##
 2431:     ## Loop through the results and output them.
 2432:     ##
 2433:     foreach my $row (@Results) {
 2434:         if ($connection->aborted()) {
 2435:             &cleanup();
 2436:             return;
 2437:         }
 2438:         my %Fields = %{&parse_row(@$row)};
 2439:         my $output="<p>\n";
 2440:         my $prefix=&catalogmode_output($Fields{'title'},$Fields{'url'},
 2441:                                        $Fields{'id'},$checkbox_num++);
 2442:         # Render the result into html
 2443:         $output.= &$viewfunction($prefix,%Fields);
 2444:         # Print them out as they come in.
 2445:         $r->print($output);
 2446:         $r->rflush();
 2447:     }
 2448:     if (@Results < 1) {
 2449:         $r->print(&mt("There were no results matching your query"));
 2450:     } else {
 2451:         $r->print
 2452:             ('<center>'.
 2453:              &prev_next_buttons($min,$ENV{'form.show'},$total_results,
 2454:                                 "table=".$ENV{'form.table'}.
 2455:                                 "&phase=results".
 2456:                                 "&persistent_db_id=".
 2457:                                 $ENV{'form.persistent_db_id'})
 2458:              ."</center>\n"
 2459:              );
 2460:     }
 2461:     $r->print("</form></body></html>");
 2462:     $r->rflush();
 2463:     untie %groupsearch_db if (tied(%groupsearch_db));
 2464:     return;
 2465: }
 2466: 
 2467: ######################################################################
 2468: ######################################################################
 2469: 
 2470: =pod
 2471: 
 2472: =item &catalogmode_output($title,$url,$fnum,$checkbox_num)
 2473: 
 2474: Returns html needed for the various catalog modes.  Gets inputs from
 2475: $ENV{'form.catalogmode'}.  Stores data in %groupsearch_db.
 2476: 
 2477: =cut
 2478: 
 2479: ######################################################################
 2480: ######################################################################
 2481: sub catalogmode_output {
 2482:     my $output = '';
 2483:     my ($title,$url,$fnum,$checkbox_num) = @_;
 2484:     if ($ENV{'form.catalogmode'} eq 'interactive') {
 2485:         $title=~ s/\'/\\\'/g;
 2486:         if ($ENV{'form.catalogmode'} eq 'interactive') {
 2487:             $output.=<<END 
 2488: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
 2489: onClick="javascript:select_data('$title','$url')">
 2490: </font>
 2491: END
 2492:         }
 2493:     } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
 2494:         $groupsearch_db{"pre_${fnum}_link"}=$url;
 2495:         $groupsearch_db{"pre_${fnum}_title"}=$title;
 2496:         $output.=<<END;
 2497: <font size='-1'>
 2498: <input type="checkbox" name="returnvalues" value="SELECT"
 2499: onClick="javascript:queue($checkbox_num,$fnum)" />
 2500: </font>
 2501: END
 2502:     }
 2503:     return $output;
 2504: }
 2505: ######################################################################
 2506: ######################################################################
 2507: 
 2508: =pod
 2509: 
 2510: =item &parse_row
 2511: 
 2512: Parse a row returned from the database.
 2513: 
 2514: =cut
 2515: 
 2516: ######################################################################
 2517: ######################################################################
 2518: sub parse_row {
 2519:     my @Row = @_;
 2520:     my %Fields;
 2521:     for (my $i=0;$i<=$#Row;$i++) {
 2522:         $Fields{$Datatypes[$i]->{'name'}}=&Apache::lonnet::unescape($Row[$i]);
 2523:     }
 2524:     $Fields{'language'} = 
 2525:         &Apache::loncommon::languagedescription($Fields{'lang'});
 2526:     $Fields{'copyrighttag'} =
 2527:         &Apache::loncommon::copyrightdescription($Fields{'copyright'});
 2528:     $Fields{'mimetag'} =
 2529:         &Apache::loncommon::filedescription($Fields{'mime'});
 2530:     return \%Fields;
 2531: }
 2532: 
 2533: ###########################################################
 2534: ###########################################################
 2535: 
 2536: =pod
 2537: 
 2538: =item &parse_raw_result()
 2539: 
 2540: Takes a line from the file of results and parse it.  Returns a hash 
 2541: with keys for the following fields:
 2542: 'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes', 
 2543: 'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate', 
 2544: 'lastrevisiondate'.
 2545: 
 2546: In addition, the following tags are set by calling the appropriate 
 2547: lonnet function: 'language', 'cprtag', 'mimetag'.
 2548: 
 2549: The 'title' field is set to "Untitled" if the title field is blank.
 2550: 
 2551: 'abstract' and 'keywords' are truncated to 200 characters.
 2552: 
 2553: =cut
 2554: 
 2555: ###########################################################
 2556: ###########################################################
 2557: sub parse_raw_result {
 2558:     my ($result,$hostname) = @_;
 2559:     # Check for a comma - if it is there then we do not need to unescape the
 2560:     # string.  There seems to be some kind of problem with some items in
 2561:     # the database - the entire string gets sent out unescaped...?
 2562:     unless ($result =~ /,/) {
 2563:         $result = &Apache::lonnet::unescape($result);
 2564:     }
 2565:     my @fields=map {
 2566:         &Apache::lonnet::unescape($_);
 2567:     } (split(/\,/,$result));
 2568:     my ($title,$author,$subject,$url,$keywords,$version,
 2569:         $notes,$abstract,$mime,$lang,
 2570:         $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
 2571:     my %Fields = 
 2572:         ( title     => &Apache::lonnet::unescape($title),
 2573:           author    => &Apache::lonnet::unescape($author),
 2574:           subject   => &Apache::lonnet::unescape($subject),
 2575:           url       => &Apache::lonnet::unescape($url),
 2576:           keywords  => &Apache::lonnet::unescape($keywords),
 2577:           version   => &Apache::lonnet::unescape($version),
 2578:           notes     => &Apache::lonnet::unescape($notes),
 2579:           abstract  => &Apache::lonnet::unescape($abstract),
 2580:           mime      => &Apache::lonnet::unescape($mime),
 2581:           lang      => &Apache::lonnet::unescape($lang),
 2582:           owner     => &Apache::lonnet::unescape($owner),
 2583:           copyright => &Apache::lonnet::unescape($copyright),
 2584:           creationdate     => &Apache::lonnet::unescape($creationdate),
 2585:           lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate)
 2586:         );
 2587:     $Fields{'language'} = 
 2588:         &Apache::loncommon::languagedescription($Fields{'lang'});
 2589:     $Fields{'copyrighttag'} =
 2590:         &Apache::loncommon::copyrightdescription($Fields{'copyright'});
 2591:     $Fields{'mimetag'} =
 2592:         &Apache::loncommon::filedescription($Fields{'mime'});
 2593:     if ($Fields{'author'}=~/^(\s*|error)$/) {
 2594:         $Fields{'author'}="Unknown Author";
 2595:     }
 2596:     # Put spaces in the keyword list, if needed.
 2597:     $Fields{'keywords'}=~ s/,([A-z])/, $1/g; 
 2598:     if ($Fields{'title'}=~ /^\s*$/ ) { 
 2599:         $Fields{'title'}='Untitled'; 
 2600:     }
 2601:     unless ($ENV{'user.adv'}) {
 2602:         # What is this anyway?
 2603:         $Fields{'keywords'} = '- not displayed -';
 2604:         $Fields{'notes'}    = '- not displayed -';
 2605:         $Fields{'abstract'} = '- not displayed -';
 2606:         $Fields{'subject'}  = '- not displayed -';
 2607:     }
 2608:     if (length($Fields{'abstract'})>200) {
 2609:         $Fields{'abstract'} = 
 2610:             substr($Fields{'abstract'},0,200).'...';
 2611:     }
 2612:     if (length($Fields{'keywords'})>200) {
 2613:         $Fields{'keywords'} =
 2614:             substr($Fields{'keywords'},0,200).'...';
 2615:     }
 2616:     return %Fields;
 2617: }
 2618: 
 2619: ###########################################################
 2620: ###########################################################
 2621: 
 2622: =pod
 2623: 
 2624: =item &handle_custom_fields()
 2625: 
 2626: =cut
 2627: 
 2628: ###########################################################
 2629: ###########################################################
 2630: sub handle_custom_fields {
 2631:     my @results = @{shift()};
 2632:     my $customshow='';
 2633:     my $extrashow='';
 2634:     my @customfields;
 2635:     if ($ENV{'form.customshow'}) {
 2636:         $customshow=$ENV{'form.customshow'};
 2637:         $customshow=~s/[^\w\s]//g;
 2638:         my @fields=map {
 2639:             "<font color=\"#008000\">$_:</font><!-- $_ -->";
 2640:         } split(/\s+/,$customshow);
 2641:         @customfields=split(/\s+/,$customshow);
 2642:         if ($customshow) {
 2643:             $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
 2644:         }
 2645:     }
 2646:     my $customdata='';
 2647:     my %customhash;
 2648:     foreach my $result (@results) {
 2649:         if ($result=~/^(custom\=.*)$/) { # grab all custom metadata
 2650:             my $tmp=$result;
 2651:             $tmp=~s/^custom\=//;
 2652:             my ($k,$v)=map {&Apache::lonnet::unescape($_);
 2653:                         } split(/\,/,$tmp);
 2654:             $customhash{$k}=$v;
 2655:         }
 2656:     }
 2657:     return ($extrashow,\@customfields,\%customhash);
 2658: }
 2659: 
 2660: ######################################################################
 2661: ######################################################################
 2662: 
 2663: =pod
 2664: 
 2665: =item &search_results_header
 2666: 
 2667: Output the proper html headers and javascript code to deal with different 
 2668: calling modes.
 2669: 
 2670: Takes most inputs directly from %ENV, except $mode.  
 2671: 
 2672: =over 4
 2673: 
 2674: =item $mode is either (at this writing) 'Basic' or 'Advanced'
 2675: 
 2676: =back
 2677: 
 2678: The following environment variables are checked:
 2679: 
 2680: =over 4
 2681: 
 2682: =item 'form.catalogmode' 
 2683: 
 2684: Checked for 'interactive' and 'groupsearch'.
 2685: 
 2686: =item 'form.mode'
 2687: 
 2688: Checked for existance & 'edit' mode.
 2689: 
 2690: =item 'form.form'
 2691: 
 2692: =item 'form.element'
 2693: 
 2694: =back
 2695: 
 2696: =cut
 2697: 
 2698: ######################################################################
 2699: ######################################################################
 2700: sub search_results_header {
 2701:     my ($importbutton,$closebutton) = @_;
 2702:     my $result = '';
 2703:     # output beginning of search page
 2704:     # conditional output of script functions dependent on the mode in
 2705:     # which the search was invoked
 2706:     if ($ENV{'form.catalogmode'} eq 'interactive'){
 2707: 	if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') {
 2708:             $result.=<<SCRIPT;
 2709: <script type="text/javascript">
 2710:     function select_data(title,url) {
 2711: 	changeTitle(title);
 2712: 	changeURL(url);
 2713: 	parent.close();
 2714:     }
 2715:     function changeTitle(val) {
 2716: 	if (parent.opener.inf.document.forms.resinfo.elements.t) {
 2717: 	    parent.opener.inf.document.forms.resinfo.elements.t.value=val;
 2718: 	}
 2719:     }
 2720:     function changeURL(val) {
 2721: 	if (parent.opener.inf.document.forms.resinfo.elements.u) {
 2722: 	    parent.opener.inf.document.forms.resinfo.elements.u.value=val;
 2723: 	}
 2724:     }
 2725: </script>
 2726: SCRIPT
 2727:         } elsif ($ENV{'form.mode'} eq 'edit') {
 2728:             my $form = $ENV{'form.form'};
 2729:             my $element = $ENV{'form.element'};
 2730:             $result.=<<SCRIPT;
 2731: <script type="text/javascript">
 2732: function select_data(title,url) {
 2733:     changeURL(url);
 2734:     parent.close();
 2735: }
 2736: function changeTitle(val) {
 2737: }
 2738: function changeURL(val) {
 2739:     if (parent.targetwin.document) {
 2740:         parent.targetwin.document.forms["$form"].elements["$element"].value=val;
 2741:     } else {
 2742: 	var url = 'forms[\"$form\"].elements[\"$element\"].value';
 2743:         alert("Unable to transfer data to "+url);
 2744:     }
 2745: }
 2746: </script>
 2747: SCRIPT
 2748:         }
 2749:     }
 2750:     $result.=<<SCRIPT if $ENV{'form.catalogmode'} eq 'groupsearch';
 2751: <script type="text/javascript">
 2752:     function queue(checkbox_num,val) {
 2753:         if (document.forms.results.returnvalues.length != "undefined" &&
 2754:             typeof(document.forms.results.returnvalues.length) == "number") {
 2755:             if (document.forms.results.returnvalues[checkbox_num].checked) {
 2756:                 parent.statusframe.document.forms.statusform.elements.Queue.value +='1a'+val+'b';
 2757:             } else {
 2758:                 parent.statusframe.document.forms.statusform.elements.Queue.value +='0a'+val+'b';
 2759:             }
 2760:         } else {
 2761:             if (document.forms.results.returnvalues.checked) {
 2762:                 parent.statusframe.document.forms.statusform.elements.Queue.value +='1a'+val+'b';
 2763:             } else {
 2764:                 parent.statusframe.document.forms.statusform.elements.Queue.value +='0a'+val+'b';
 2765:             }
 2766:         }
 2767:     }
 2768:     function select_group() {
 2769: 	parent.window.location=
 2770:     "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+
 2771: 	    parent.statusframe.document.forms.statusform.elements.Queue.value;
 2772:     }
 2773: </script>
 2774: SCRIPT
 2775:     $result.=<<END;
 2776: </head>
 2777: $bodytag
 2778: <form name="results" method="post" action="" >
 2779: <input type="hidden" name="Queue" value="" />
 2780: $importbutton
 2781: END
 2782:     return $result;
 2783: }
 2784: 
 2785: ######################################################################
 2786: ######################################################################
 2787: sub search_status_header {
 2788:     return <<ENDSTATUS;
 2789: <html><head><title>Search Status</title></head>
 2790: $bodytag
 2791: <h3>Search Status</h3>
 2792: Sending search request to LON-CAPA servers.<br />
 2793: ENDSTATUS
 2794: }
 2795: 
 2796: sub results_link {
 2797:     my $basic_link   = "/adm/searchcat?"."&table=".$ENV{'form.table'}.
 2798:         "&persistent_db_id=".$ENV{'form.persistent_db_id'};
 2799:     my $results_link = $basic_link."&phase=results".
 2800:         "&pause=1"."&start=1";
 2801:     return $results_link;
 2802: }
 2803: 
 2804: ######################################################################
 2805: ######################################################################
 2806: sub print_frames_interface {
 2807:     my $r = shift;
 2808:     my $basic_link = "/adm/searchcat?"."&table=".$ENV{'form.table'}.
 2809:         "&persistent_db_id=".$ENV{'form.persistent_db_id'};
 2810:     my $run_search_link = $basic_link."&phase=run_search";
 2811:     my $results_link = &results_link();
 2812:     my $result = <<"ENDFRAMES";
 2813: <html>
 2814: <head>
 2815: <script>
 2816: var targetwin = opener;
 2817: var queue = '';
 2818: </script>
 2819: <title>LON-CAPA Digital Library Search Results</title>
 2820: </head>
 2821: <frameset rows="150,*">
 2822:     <frame name="statusframe"  src="$run_search_link">
 2823:     <frame name="resultsframe" src="$results_link">
 2824: </frameset>
 2825: </html>
 2826: ENDFRAMES
 2827: 
 2828:     $r->print($result);
 2829:     return;
 2830: }
 2831: 
 2832: ######################################################################
 2833: ######################################################################
 2834: 
 2835: =pod 
 2836: 
 2837: =item Metadata Viewing Functions
 2838: 
 2839: Output is a HTML-ified string.
 2840: Input arguments are title, author, subject, url, keywords, version,
 2841: notes, short abstract, mime, language, creation date,
 2842: last revision date, owner, copyright, hostname, and
 2843: extra custom metadata to show.
 2844: 
 2845: =over 4
 2846: 
 2847: =item &detailed_citation_view() 
 2848: 
 2849: =cut
 2850: 
 2851: ######################################################################
 2852: ######################################################################
 2853: sub detailed_citation_view {
 2854:     my ($prefix,%values) = @_;
 2855:     my $result=<<END;
 2856: <b>$prefix<a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 
 2857:     target='search_preview'>$values{'title'}</a></b>
 2858: <p>
 2859: <b>$values{'author'}</b>, <i>$values{'owner'}</i><br />
 2860: 
 2861: <b>Subject:       </b> $values{'subject'}<br />
 2862: <b>Keyword(s):    </b> $values{'keywords'}<br />
 2863: <b>Notes:         </b> $values{'notes'}<br />
 2864: <b>MIME Type:     </b> $values{'mimetag'}<br />
 2865: <b>Language:      </b> $values{'language'}<br />
 2866: <b>Copyright/Distribution:</b> $values{'cprtag'}<br />
 2867: </p>
 2868: $values{'extrashow'}
 2869: <p>
 2870: $values{'shortabstract'}
 2871: </p>
 2872: <hr align='left' width='200' noshade />
 2873: END
 2874:     return $result;
 2875: }
 2876: 
 2877: ######################################################################
 2878: ######################################################################
 2879: 
 2880: =pod 
 2881: 
 2882: =item &summary_view() 
 2883: 
 2884: =cut
 2885: ######################################################################
 2886: ######################################################################
 2887: sub summary_view {
 2888:     my ($prefix,%values) = @_;
 2889:     my $result=<<END;
 2890: $prefix<a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 
 2891:    target='search_preview'>$values{'author'}</a><br />
 2892: $values{'title'}<br />
 2893: $values{'owner'} -- $values{'lastrevisiondate'}<br />
 2894: $values{'copyrighttag'}<br />
 2895: $values{'extrashow'}
 2896: </p>
 2897: <hr align='left' width='200' noshade />
 2898: END
 2899:     return $result;
 2900: }
 2901: 
 2902: ######################################################################
 2903: ######################################################################
 2904: 
 2905: =pod 
 2906: 
 2907: =item &compact_view() 
 2908: 
 2909: =cut
 2910: 
 2911: ######################################################################
 2912: ######################################################################
 2913: sub compact_view {
 2914:     my ($prefix,%values) = @_;
 2915:     my $result=<<END;
 2916: $prefix <a href="http://$ENV{'HTTP_HOST'}$values{'url'}"  target='search_preview'>
 2917: $values{'title'}</a>
 2918: <b>$values{'author'}</b><br />
 2919: END
 2920:     return $result;
 2921: }
 2922: 
 2923: 
 2924: ######################################################################
 2925: ######################################################################
 2926: 
 2927: =pod 
 2928: 
 2929: =item &fielded_format_view() 
 2930: 
 2931: =cut
 2932: 
 2933: ######################################################################
 2934: ######################################################################
 2935: sub fielded_format_view {
 2936:     my ($prefix,%values) = @_;
 2937:     my $result=<<END;
 2938: $prefix
 2939: <b>URL: </b> <a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 
 2940:               target='search_preview'>$values{'url'}</a>
 2941: <br />
 2942: <b>Title:</b> $values{'title'}<br />
 2943: <b>Author(s):</b> $values{'author'}<br />
 2944: <b>Subject:</b> $values{'subject'}<br />
 2945: <b>Keyword(s):</b> $values{'keywords'}<br />
 2946: <b>Notes:</b> $values{'notes'}<br />
 2947: <b>MIME Type:</b> $values{'mimetag'}<br />
 2948: <b>Language:</b> $values{'language'}<br />
 2949: <b>Creation Date:</b> $values{'creationdate'}<br />
 2950: <b>Last Revision Date:</b> $values{'lastrevisiondate'}<br />
 2951: <b>Publisher/Owner:</b> $values{'owner'}<br />
 2952: <b>Copyright/Distribution:</b> $values{'copyrighttag'}<br />
 2953: <b>Repository Location:</b> $values{'hostname'}<br />
 2954: <b>Abstract:</b> $values{'shortabstract'}<br />
 2955: $values{'extrashow'}
 2956: </p>
 2957: <hr align='left' width='200' noshade />
 2958: END
 2959:     return $result;
 2960: }
 2961: 
 2962: ######################################################################
 2963: ######################################################################
 2964: 
 2965: =pod 
 2966: 
 2967: =item &xml_sgml_view() 
 2968: 
 2969: =back 
 2970: 
 2971: =cut
 2972: 
 2973: ######################################################################
 2974: ######################################################################
 2975: sub xml_sgml_view {
 2976:     my ($prefix,%values) = @_;
 2977:     my $result=<<END;
 2978: $prefix
 2979: <pre>
 2980: &lt;LonCapaResource&gt;
 2981: &lt;url&gt;$values{'url'}&lt;/url&gt;
 2982: &lt;title&gt;$values{'title'}&lt;/title&gt;
 2983: &lt;author&gt;$values{'author'}&lt;/author&gt;
 2984: &lt;subject&gt;$values{'subject'}&lt;/subject&gt;
 2985: &lt;keywords&gt;$values{'keywords'}&lt;/keywords&gt;
 2986: &lt;notes&gt;$values{'notes'}&lt;/notes&gt;
 2987: &lt;mimeInfo&gt;
 2988: &lt;mime&gt;$values{'mime'}&lt;/mime&gt;
 2989: &lt;mimetag&gt;$values{'mimetag'}&lt;/mimetag&gt;
 2990: &lt;/mimeInfo&gt;
 2991: &lt;languageInfo&gt;
 2992: &lt;language&gt;$values{'lang'}&lt;/language&gt;
 2993: &lt;languagetag&gt;$values{'language'}&lt;/languagetag&gt;
 2994: &lt;/languageInfo&gt;
 2995: &lt;creationdate&gt;$values{'creationdate'}&lt;/creationdate&gt;
 2996: &lt;lastrevisiondate&gt;$values{'lastrevisiondate'}&lt;/lastrevisiondate&gt;
 2997: &lt;owner&gt;$values{'owner'}&lt;/owner&gt;
 2998: &lt;copyrightInfo&gt;
 2999: &lt;copyright&gt;$values{'copyright'}&lt;/copyright&gt;
 3000: &lt;copyrighttag&gt;$values{'copyrighttag'}&lt;/copyrighttag&gt;
 3001: &lt;/copyrightInfo&gt;
 3002: &lt;repositoryLocation&gt;$values{'hostname'}&lt;/repositoryLocation&gt;
 3003: &lt;shortabstract&gt;$values{'shortabstract'}&lt;/shortabstract&gt;
 3004: &lt;/LonCapaResource&gt;
 3005: </pre>
 3006: $values{'extrashow'}
 3007: <hr align='left' width='200' noshade />
 3008: END
 3009:     return $result;
 3010: }
 3011: 
 3012: ######################################################################
 3013: ######################################################################
 3014: 
 3015: =pod 
 3016: 
 3017: =item &filled() see if field is filled.
 3018: 
 3019: =cut
 3020: 
 3021: ######################################################################
 3022: ######################################################################
 3023: sub filled {
 3024:     my ($field)=@_;
 3025:     if ($field=~/\S/ && $field ne 'any') {
 3026: 	return 1;
 3027:     }
 3028:     else {
 3029: 	return 0;
 3030:     }
 3031: }
 3032: 
 3033: ######################################################################
 3034: ######################################################################
 3035: 
 3036: =pod 
 3037: 
 3038: =item &output_blank_field_error()
 3039: 
 3040: Output a complete page that indicates the user has not filled in enough
 3041: information to do a search.
 3042: 
 3043: Inputs: $r (Apache request handle), $closebutton, $parms.
 3044: 
 3045: Returns: nothing
 3046: 
 3047: $parms is extra information to include in the 'Revise search request' link.
 3048: 
 3049: =cut
 3050: 
 3051: ######################################################################
 3052: ######################################################################
 3053: sub output_blank_field_error {
 3054:     my ($r,$closebutton,$parms)=@_;
 3055:     # make query information persistent to allow for subsequent revision
 3056:     $r->print(<<BEGINNING);
 3057: <html>
 3058: <head>
 3059: <title>The LearningOnline Network with CAPA</title>
 3060: BEGINNING
 3061:     $r->print(<<RESULTS);
 3062: </head>
 3063: $bodytag
 3064: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
 3065: <h1>Search Catalog</h1>
 3066: <form method="post" action="/adm/searchcat">
 3067: $hidden_fields
 3068: <a href="/adm/searchcat?$parms&persistent_db_id=$ENV{'form.persistent_db_id'}"
 3069: >Revise search request</a>&nbsp;
 3070: $closebutton
 3071: <hr />
 3072: <h3>Unactionable search query.</h3>
 3073: <p>
 3074: You did not fill in enough information for the search to be started.
 3075: You need to fill in relevant fields on the search page in order 
 3076: for a query to be processed.
 3077: </p>
 3078: </body>
 3079: </html>
 3080: RESULTS
 3081: }
 3082: 
 3083: ######################################################################
 3084: ######################################################################
 3085: 
 3086: =pod 
 3087: 
 3088: =item &output_date_error()
 3089: 
 3090: Output a full html page with an error message.
 3091: 
 3092: Inputs: 
 3093: 
 3094:     $r, the request pointer.
 3095:     $message, the error message for the user.
 3096:     $closebutton, the specialized close button needed for groupsearch.
 3097: 
 3098: =cut
 3099: 
 3100: ######################################################################
 3101: ######################################################################
 3102: sub output_date_error {
 3103:     my ($r,$message,$closebutton)=@_;
 3104:     # make query information persistent to allow for subsequent revision
 3105:     $r->print(<<RESULTS);
 3106: <html>
 3107: <head>
 3108: <title>The LearningOnline Network with CAPA</title>
 3109: </head>
 3110: $bodytag
 3111: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
 3112: <h1>Search Catalog</h1>
 3113: <form method="post" action="/adm/searchcat">
 3114: $hidden_fields
 3115: <input type='button' value='Revise search request'
 3116: onClick='this.form.submit();' />
 3117: $closebutton
 3118: <hr />
 3119: <h3>Error</h3>
 3120: <p>
 3121: $message
 3122: </p>
 3123: </body>
 3124: </html>
 3125: RESULTS
 3126: }
 3127: 
 3128: ######################################################################
 3129: ######################################################################
 3130: 
 3131: =pod 
 3132: 
 3133: =item &start_fresh_session()
 3134: 
 3135: Cleans the global %groupsearch_db by removing all fields which begin with
 3136: 'pre_' or 'store'.
 3137: 
 3138: =cut
 3139: 
 3140: ######################################################################
 3141: ######################################################################
 3142: sub start_fresh_session {
 3143:     delete $groupsearch_db{'mode_catalog'};
 3144:     foreach (keys %groupsearch_db) {
 3145:         if ($_ =~ /^pre_/) {
 3146:             delete $groupsearch_db{$_};
 3147:         }
 3148:         if ($_ =~ /^store/) {
 3149: 	    delete $groupsearch_db{$_};
 3150: 	}
 3151:     }
 3152: }
 3153: 
 3154: 1;
 3155: 
 3156: sub cleanup {
 3157:     if (tied(%groupsearch_db)) {
 3158: 	&Apache::lonnet::logthis('Cleanup searchcat: groupsearch_db');
 3159:         unless (untie(%groupsearch_db)) {
 3160: 	  &Apache::lonnet::logthis('Failed cleanup searchcat: groupsearch_db');
 3161:         }
 3162:     }
 3163:     &untiehash();
 3164:     &Apache::lonmysql::disconnect_from_db();
 3165: }
 3166: 
 3167: __END__
 3168: 
 3169: =pod
 3170: 
 3171: =back 
 3172: 
 3173: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>