File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.145: download - view: text, annotated - select for diffs
Sun Jul 28 20:02:14 2002 UTC (21 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Major Changes:
    Store persistent values in %persistent_db instead of using hidden form
        elements.
    Global $hidden replaced with $hidden_fields.
    Global $closebutton replaced with local variable in &handler.
&handler: Comments changed.
    Read/write %persistent_db.
    Set $hidden_fields to contain the identifier for %persistent_db.
    $closebutton is now passed to many functions.
&advanced_search_form, &basic_search_form, &parse_advanced_search,
    &parse_basic_search - pass $closebutton instead of having it global.
&make_persistent and &reconstruct_persistent_form_data: new functions/rewrites
    of old functions to store and restore $ENV{'form.*'} values to/from the
    %persistent_db.
&run_search: Recommented & moved some code around.
    Now add time if we are able to contact a server within a few seconds.
    Changed status output text.
&display_buttons is still untested and will remain so until the frames
    interface is completed.
&display_results: Now check the database returns and output reasonable
    error messages.  Moved some code to &catalogmode_output.
Removed the following functions:
    &output_results, &make_popwin, &popwin_js, &popwin_imgupdate

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

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