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

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

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