File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.177: download - view: text, annotated - select for diffs
Sat Jun 14 00:15:01 2003 UTC (20 years, 11 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- should be using the _users_ domain not the servers domain, (lonsequence.pm was already doing this, only by luck was this not blowing up.)

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

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