Annotation of loncom/interface/lonsearchcat.pm, revision 1.147

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

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