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

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

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