File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.163: download - view: text, annotated - select for diffs
Tue Jan 14 18:47:50 2003 UTC (21 years, 4 months ago) by www
Branches: MAIN
CVS tags: HEAD
Attempt to better catch and log untied hashes by usage of cleanup handlers.

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

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