File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.152: download - view: text, annotated - select for diffs
Wed Aug 7 12:37:16 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Fixed bug in domain limited searches.  Cleaned up old debugging code.
Commented out custom metadata input and output code, since it doesn't work
right now anyway.

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

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