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

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.