[BACK]Return to lonsearchcat.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonsearchcat.pm between versions 1.98 and 1.123

version 1.98, 2001/08/26 21:19:35 version 1.123, 2002/06/19 20:39:11
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 #  
 # Search Catalog  # Search Catalog
 #  #
 # YEAR=2001  # $Id$
 # 03/08/2001 Scott Harrison  
 # Scott Harrison: 03/12/2001, 03/13/2001, 03/14/2001, 03/15/2001, 03/19/2001  
 # Scott Harrison: 03/20/2001, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001  
 # Scott Harrison: 04/02/2001, 08/15/2001, 08/24/2001, 08/25/2001  
   
 ###############################################################################  
 ##                                                                           ##  
 ## ORGANIZATION OF THIS PERL MODULE                                          ##  
 ##                                                                           ##  
 ## 1. Description of functions                                               ##  
 ## 2. Modules used by this module                                            ##  
 ## 3. Choices for different output views (detailed, summary, xml, etc)       ##  
 ## 4. BEGIN block (to be run once after compilation)                         ##  
 ## 5. Handling routine called via Apache and mod_perl                        ##  
 ## 6. Other subroutines                                                      ##  
 ##                                                                           ##  
 ###############################################################################  
   
 # ---------------------------------------------------- Description of functions  
 #  
 #  
 # === WEB HANDLER FUNCTIONS  
 # BEGIN() : run once after compilation to initialize values  
 # handler(server reference) : interacts with the Apache server layer  
 #                             (for /adm/searchcat URLs)  
 # get_unprocessed_cgi() : reads in critical name/value pairs that may have not  
 #                         been processed and passed into %ENV by the web server  
 # make_persistent() : makes a set of hidden HTML fields to make  
 #                     SQL search interface information to be persistent  
 #  
 #  #
 # === WEB INTERFACE COMPONENT FUNCTIONS  # Copyright Michigan State University Board of Trustees
 # simpletextfield(name,value) : returns HTML formatted string for simple text  
 #                               field  
 # simplecheckbox(name,value) : returns HTML formatted string for simple  
 #                              checkbox  
 # searchphrasefield(title,name,value) : returns HTML formatted string for  
 #                                       a search expression phrase field  
 # dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML  
 #                                                          formatted string  
 #                                                          for a calendar date  
 # selectbox(title,name,value,%HASH=options) : returns HTML formatted string for  
 #                                             a selection box field  
 #  #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  #
 # === SEARCH FUNCTIONS  # LON-CAPA is free software; you can redistribute it and/or modify
 # advancedsearch(server reference, environment reference) : perform a complex  # it under the terms of the GNU General Public License as published by
 #                                  multi-field logical query  # the Free Software Foundation; either version 2 of the License, or
 # basicsearch(server reference, environment reference) : perform a simple  # (at your option) any later version.
 #                               single-field logical query  
 # build_SQL_query(field name, logic) : builds a SQL query string from a  
 #                                      logical expression with AND/OR keywords  
 # build_custommetadata_query(field_name, logic_statement) : builds a perl  
 #                 regular expression from a logical expression with AND/OR  
 #                 keywords  
 # recursive_SQL_query_build(field name, reverse notation expression) :   
 #                 builds a SQL query string from a reverse notation expression  
 #                 logical expression with AND/OR keywords  
 # build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2,  
 #                    lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) :  
 #                 Builds a SQL logic query to check time/date entries.  
 #  #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
 #  #
 # === OUTPUTTING RESULTS FUNCTION  # You should have received a copy of the GNU General Public License
 # output_results(output mode,  # along with LON-CAPA; if not, write to the Free Software
 #                server reference,   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #                environment reference,  
 #                reply list reference) : outputs results from search  
 #  #
   # /home/httpd/html/adm/gpl.txt
 #  #
 # === DIFFERENT WAYS TO VIEW METADATA RECORDS  # http://www.lon-capa.org/
 # detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :  
 #          see metadata viewing notes below   
 # summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :  
 #          see metadata viewing notes below   
 # fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :  
 #          see metadata viewing notes below   
 # xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :  
 #          see metadata viewing notes below   
 #  ___________________________________________________________________________  
 # | * Metadata viewing notes                                                  |  
 # | Output is a HTML-ified string.                                            |  
 # | Input arguments are title, author, subject, url, keywords, version, notes,|  
 # | short abstract, mime, language, creation date, last revision date, owner, |  
 # | copyright, hostname, httphost, and extra custom metadata to show.         |  
 #  ---------------------------------------------------------------------------  
 #  
 #  
 # === TEST CONDITIONAL FUNCTIONS  
 # filled(field) : determines whether a given field has been filled  
 #  #
   # YEAR=2001
   # 3/8, 3/12, 3/13, 3/14, 3/15, 3/19 Scott Harrison
   # 3/20, 3/21, 3/22, 3/26, 3/27, 4/2, 8/15, 8/24, 8/25 Scott Harrison
   # 10/12,10/14,10/15,10/16,11/28,11/29,12/10,12/12,12/16 Scott Harrison
   # YEAR=2002
   # 1/17 Scott Harrison
   # 6/17 Matthew Hall
 #  #
 # === ERROR FUNCTIONS  ###############################################################################
 # output_blank_field_error(server reference) : outputs a message saying that  ###############################################################################
 #                                              more fields need to be filled in  
 # output_date_error(server reference, error message) : outputs  =pod 
 #         an error message specific to bad date format.  
   =head1 NAME
   
   lonsearchcat
   
   =head1 SYNOPSIS
   
   Search interface to LON-CAPAs digital library
   
   =head1 DESCRIPTION
   
   This module enables searching for a distributed browseable catalog.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   lonsearchcat presents the user with an interface to search the LON-CAPA
   digital library.  lonsearchcat also initiates the execution of a search
   by sending the search parameters to LON-CAPA servers.  The progress of 
   search (on a server basis) is displayed to the user in a seperate window.
   
   =head1 Internals
   
   =over 4
   
   =cut
   
   ###############################################################################
   ###############################################################################
   
   ##                                                                           ##
   ## ORGANIZATION OF THIS PERL MODULE                                          ##
   ##                                                                           ##
   ## 1. Modules used by this module                                            ##
   ## 2. Choices for different output views (detailed, summary, xml, etc)       ##
   ## 3. BEGIN block (to be run once after compilation)                         ##
   ## 4. Handling routine called via Apache and mod_perl                        ##
   ## 5. Other subroutines                                                      ##
   ##                                                                           ##
   ###############################################################################
   
 package Apache::lonsearchcat;  package Apache::lonsearchcat;
   
Line 110  use Apache::lonnet(); Line 87  use Apache::lonnet();
 use Apache::File();  use Apache::File();
 use CGI qw(:standard);  use CGI qw(:standard);
 use Text::Query;  use Text::Query;
   use GDBM_File;
   use Apache::loncommon();
   
 # ---------------------------------------- variables used throughout the module  # ---------------------------------------- variables used throughout the module
   
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item Global variables
   
   =over 4
   
   =item %hostdomains
   
   matches host name to host domain
   
   =item %hostips
   
   matches host name to host ip
   
   =item %hitcount
   
   stores number of hits per host
   
   =item $closebutton
   
   button that closes the search window
   
   =item $importbutton
   
   button to take the selecte results and go to group sorting
   
   =item $hidden
   
   holds 'hidden' html forms
   
   =item $scrout
   
   string that holds portions of the screen output
   
   =item $yourself
   
   allows for quickly limiting to oneself
   
   =item %hash   
   
   The ubiquitous database hash
   
   =item $diropendb 
   
   The full path to the (temporary) search database file.  This is set and
   used in &handler() and is also used in &output_results().
   
   =back 
   
   =cut
   
   ######################################################################
   ######################################################################
   
 # -- information holders  # -- information holders
 my %language; # holds contents of language.tab  
 my %cprtag; # holds contents of copyright.tab  
 my %mimetag; # holds contents of filetypes.tab  
 my %hostdomains; # matches host name to host domain  my %hostdomains; # matches host name to host domain
 my %hostips; # matches host name to host ip  my %hostips;     # matches host name to host ip
 my %hitcount; # stores number of hits per host  my %hitcount;    # stores number of hits per host
   
 # -- dynamically rendered interface components  # -- dynamically rendered interface components
 my $closebutton; # button that closes the search window  my $closebutton;  # button that closes the search window
 my $importbutton; # button to take the selected results and go to group sorting  my $importbutton; # button to take the selected results and go to group sorting
   my $hidden;       # Holds 'hidden' html forms
   
 # -- miscellaneous variables  # -- miscellaneous variables
 my $scrout; # string that holds portions of the screen output  my $scrout;   # string that holds portions of the screen output
 my $fnum; # search result counter  
 my $yourself; # allows for quickly limiting to oneself  my $yourself; # allows for quickly limiting to oneself
   my %hash;     # database hash
   
 # ------------------------------------------ choices for different output views  # ------------------------------------------ choices for different output views
 # Detailed Citation View ---> sub detailed_citation_view  # Detailed Citation View ---> sub detailed_citation_view
 # Summary View ---> sub summary_view  # Summary View ---> sub summary_view
 # Fielded Format ---> sub fielded_format_view  # Fielded Format ---> sub fielded_format_view
 # XML/SGML ---> sub xml_sgml_view  # XML/SGML ---> sub xml_sgml_view
 my $basicviewselect=<<END;  
 <select name='basicviewselect'>  #------------------------------------------------------------- global variables
 <option value='Detailed Citation View'>Detailed Citation View</option>  my $diropendb = "";
 <option value='Summary View'>Summary View</option>  my $domain = "";
 <option value='Fielded Format'>Fielded Format</option>  
 <option value='XML/SGML'>XML/SGML</option>  
 </select>  
 END  
 my $advancedviewselect=<<END;  
 <select name='advancedviewselect'>  
 <option value='Detailed Citation View'>Detailed Citation View</option>  
 <option value='Summary View'>Summary View</option>  
 <option value='Fielded Format'>Fielded Format</option>  
 <option value='XML/SGML'>XML/SGML</option>  
 </select>  
 END  
   
 # ----------------------------------------------------------------------- BEGIN  # ----------------------------------------------------------------------- BEGIN
 sub BEGIN {  
 # --------------------------------- Compute various listings of metadata values  =pod
     $language{'any'}='Any language';  
     {  =item BEGIN block
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.  
  '/language.tab');  Load %hostdomains and %hostips with data from lonnet.pm.  Only library
  map {  servers are considered.
     $_=~/(\w+)\s+([\w\s\-]+)/; chomp;  
     $language{$1}=$2;  =cut
  } <$fh>;  
     }  BEGIN {
     $cprtag{'any'}='Any copyright/distribution';      foreach (keys (%Apache::lonnet::libserv)) {
     {          $hostdomains{$_}=$Apache::lonnet::hostdom{$_};
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.          $hostips{$_}=$Apache::lonnet::hostip{$_};
  '/copyright.tab');  
  map {  
     $_=~/(\w+)\s+([\w\s\-]+)/; chomp;  
     $cprtag{$1}=$2;  
  } <$fh>;  
     }  
     $mimetag{'any'}='Any type';  
     {  
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.  
  '/filetypes.tab');  
  map {  
     $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; chomp;  
     $mimetag{$1}=".$1 $3";  
  } <$fh>;  
     }  
     {  
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.  
  '/hosts.tab');  
  map {  
     $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp;  
     if ($3 eq 'library') {  
  $hostdomains{$1}=$2;  
  $hostips{$1}=$4;  
     }  
  } <$fh>;  
     }      }
 }  }
   
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item &handler() - main handler invoked by httpd child
   
   =cut
   
   ######################################################################
   ######################################################################
 # ----------------------------- Handling routine called via Apache and mod_perl  # ----------------------------- Handling routine called via Apache and mod_perl
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
       untie %hash;
     &get_unprocessed_cgi();  
   
     $r->content_type('text/html');      $r->content_type('text/html');
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
   
       my $domain  = $r->dir_config('lonDefDomain');
       $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain).
               "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db";
   
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                ['catalogmode','launch','acts','mode','form','element']);
   
       if ($ENV{'form.launch'} eq '1') {
    if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
       &start_fresh_session();
       untie %hash;
    } else {
       $r->print('<html><head></head><body>Unable to tie hash to db '.
         'file</body></html>');
       return OK;
    }
       }
   
   # --------------------------- Produce some output, so people know it is working
   
       $r->print("\n");
       $r->rflush;
   
 # ----------------------------------- configure dynamic components of interface  # ----------------------------------- configure dynamic components of interface
     my $hidden='';  
     if ($ENV{'form.catalogmode'} eq 'interactive') {      if ($ENV{'form.catalogmode'} eq 'interactive') {
  $hidden="<input type='hidden' name='catalogmode' value='interactive'>".   $hidden="<input type='hidden' name='catalogmode' value='interactive'>".
     "\n";      "\n";
Line 225  END Line 255  END
 onClick='javascript:select_group()'>  onClick='javascript:select_group()'>
 END  END
     }      }
       $hidden .= <<END;
   <input type='hidden' name='mode'    value='$ENV{'form.mode'}'>
   <input type='hidden' name='form'    value='$ENV{'form.form'}'>
   <input type='hidden' name='element' value='$ENV{'form.element'}'>
   <input type='hidden' name='date' value='2'>
   END
 # ------------------------------------------------------ Determine current user  # ------------------------------------------------------ Determine current user
     $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'};      $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
   
Line 236  END Line 271  END
   
 # ----------------------------------- See if a search invocation should be done  # ----------------------------------- See if a search invocation should be done
     if ($ENV{'form.basicsubmit'} eq 'SEARCH') {      if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
  return &basicsearch($r,\%ENV);   untie %hash; return &basicsearch($r,\%ENV);
     }      }
     elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {      elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
  return &advancedsearch($r,\%ENV);   untie %hash; return &advancedsearch($r,\%ENV);
     }      }
   
 # ----------------------------- Else, begin building search interface to output  # ----------------------------- Else, begin building search interface to output
Line 268  END Line 303  END
     $scrout.=&searchphrasefield('Limit by abstract','abstract',      $scrout.=&searchphrasefield('Limit by abstract','abstract',
  $ENV{'form.abstract'});   $ENV{'form.abstract'});
   
     $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'});      $ENV{'form.mime'}='any' unless length($ENV{'form.mime'});
     $scrout.=&selectbox('Limit by MIME type','mime',      $scrout.=&selectbox('Limit by MIME type','mime',
  $ENV{'form.mime'},%mimetag);   $ENV{'form.mime'},
    'any','Any type',
    \&{Apache::loncommon::filedescriptionex},
    (&Apache::loncommon::fileextensions));
   
     $ENV{'form.language'}='any' unless length($ENV{'form.language'});      $ENV{'form.language'}='any' unless length($ENV{'form.language'});
   
     $scrout.=&selectbox('Limit by language','language',      $scrout.=&selectbox('Limit by language','language',
  $ENV{'form.language'},%language);   $ENV{'form.language'},'any','Any Language',
        \&{Apache::loncommon::languagedescription},
    (&Apache::loncommon::languageids),
    );
   
 # ------------------------------------------------ Compute date selection boxes  # ------------------------------------------------ Compute date selection boxes
     $scrout.=<<CREATIONDATESTART;      $scrout.=<<CREATIONDATESTART;
Line 327  LASTREVISIONDATEEND Line 367  LASTREVISIONDATEEND
   
     $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});      $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
     $scrout.=&selectbox('Limit by copyright/distribution','copyright',      $scrout.=&selectbox('Limit by copyright/distribution','copyright',
  $ENV{'form.copyright'},%cprtag);   $ENV{'form.copyright'},
    'any','Any copyright/distribution',
    \&{Apache::loncommon::copyrightdescription},
    (&Apache::loncommon::copyrightids),
    );
   
 # ------------------------------------------- Compute customized metadata field  # ------------------------------------------- Compute customized metadata field
     $scrout.=<<CUSTOMMETADATA;      $scrout.=<<CUSTOMMETADATA;
Line 335  LASTREVISIONDATEEND Line 379  LASTREVISIONDATEEND
 <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>  <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
 </font>  </font>
 For resource-specific metadata, enter in an expression in the form of   For resource-specific metadata, enter in an expression in the form of 
 <i>key</i>=<i>value</i> separated by operators such as AND or OR.<br />  <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
 <b>Example:</b> grandmother=75 OR grandfather=85  <b>Example:</b> grandmother=75 OR grandfather=85
 <br />  <br />
 CUSTOMMETADATA  CUSTOMMETADATA
Line 358  $scrout.=' <i>initial users of this syst Line 402  $scrout.=' <i>initial users of this syst
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
   <script type="text/javascript">
       function openhelp(val) {
    openhelpwin=open('/adm/help/searchcat.html','helpscreen',
        'scrollbars=1,width=600,height=300');
    openhelpwin.focus();
       }
   </script>
 </head>  </head>
 <body bgcolor="#FFFFFF">  <body bgcolor="#FFFFFF">
 <img align='right' src='/adm/lonIcons/lonlogos.gif' />  <img align='right' src='/adm/lonIcons/lonlogos.gif' />
Line 368  $hidden Line 419  $hidden
 <h3>Basic Search</h3>  <h3>Basic Search</h3>
 <p>  <p>
 Enter terms or phrases separated by search operators  Enter terms or phrases separated by search operators
 such as AND or OR then press SEARCH below.  Terms should be specific  such as AND, OR, or NOT then press SEARCH below.  Terms should be specific
 to the title, author, subject, notes, or abstract information associated  to the title, author, subject, notes, or abstract information associated
 with a resource.  with a resource.
 <br />  <br />
Line 384  ENDDOCUMENT Line 435  ENDDOCUMENT
 <input type="submit" name="basicsubmit" value='SEARCH' />  <input type="submit" name="basicsubmit" value='SEARCH' />
 <input type="reset" name="reset" value='RESET' />  <input type="reset" name="reset" value='RESET' />
 $closebutton  $closebutton
 $basicviewselect  <!-- basic view selection -->
   <select name='basicviewselect'>
   <option value='Detailed Citation View' selected="true">
   Detailed Citation View</option>
   <option value='Summary View'>Summary View</option>
   <option value='Fielded Format'>Fielded Format</option>
   <option value='XML/SGML'>XML/SGML</option>
   </select>
   <!-- end of basic view selection -->
   <input type="button" value="HELP" onClick="openhelp()" />
 </p>  </p>
 <hr />  <hr />
 <h3>Advanced Search</h3>  <h3>Advanced Search</h3>
Line 393  $scrout Line 453  $scrout
 <input type="submit" name="advancedsubmit" value='SEARCH' />  <input type="submit" name="advancedsubmit" value='SEARCH' />
 <input type="reset" name="reset" value='RESET' />  <input type="reset" name="reset" value='RESET' />
 $closebutton  $closebutton
 $advancedviewselect  <!-- advance view select -->
   <select name='advancedviewselect'>
   <option value='Detailed Citation View' selected="true">
   Detailed Citation View</option>
   <option value='Summary View'>Summary View</option>
   <option value='Fielded Format'>Fielded Format</option>
   <option value='XML/SGML'>XML/SGML</option>
   </select>
   <!-- end of advanced view select -->
   <input type="button" value="HELP" onClick="openhelp()" />
 </p>  </p>
 </form>  </form>
 </body>  </body>
Line 402  ENDDOCUMENT Line 471  ENDDOCUMENT
     return OK;      return OK;
 }   } 
   
 # ----------- grab unprocessed CGI variables that may have been appended to URL  ######################################################################
 sub get_unprocessed_cgi {  ######################################################################
     map {  
        my ($name, $value) = split(/=/,$_);  =pod 
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  =item &make_persistent() 
        if ($name eq 'catalogmode') {  
    $ENV{'form.'.$name}=$value;  Returns a scalar which holds the current ENV{'form.*'} values in
        }  a 'hidden' html input tag.  
     } (split(/&/,$ENV{'QUERY_STRING'}));  
 }  =cut
   
   ######################################################################
   ######################################################################
   
 # ------------------------------------------------------------- make persistent  
 sub make_persistent {  sub make_persistent {
     my $persistent='';      my $persistent='';
           
     map {      foreach (keys %ENV) {
  if (/^form\./ && !/submit/) {   if (/^form\./ && !/submit/) {
     my $name=$_;      my $name=$_;
     my $key=$name;      my $key=$name;
Line 428  sub make_persistent { Line 499  sub make_persistent {
 <input type='hidden' name='$name' value='$ENV{$key}' />  <input type='hidden' name='$name' value='$ENV{$key}' />
 END  END
         }          }
     } (keys %ENV);      }
     return $persistent;      return $persistent;
 }  }
   
 # --------------------------------------------------------- Various form fields  
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item HTML form building functions
   
   =over 4
   
   =item &simpletextfield() 
   
   Inputs: $name,$value,$size
   
   Returns a text input field with the given name, value, and size.  
   If size is not specified, a value of 20 is used.
   
   =item &simplecheckbox()
   
   Inputs: $name,$value
   
   Returns a simple check box with the given $name.
   If $value eq 'on' the box is checked.
   
   =item &searchphrasefield()
   
   Inputs: $title,$name,$value
   
   Returns html for a title line and an input field for entering search terms.
   the instructions "Enter terms or phrases separated by search operators such 
   as AND, OR, or NOT." are given following the title.  The entry field (which
   is where the $name and $value are used) is an 80 column simpletextfield.
   
   =item &dateboxes()
   
   =item &selectbox()
   
   =back 
   
   =cut
   
   ######################################################################
   ######################################################################
   
 sub simpletextfield {  sub simpletextfield {
     my ($name,$value)=@_;      my ($name,$value,$size)=@_;
     return '<input type=text name=\''.$name.      $size = 20 if (! defined($size));
    '\' size=20 value=\''.$value.'\' />';      return '<input type="text" name="'.$name.
           '" size="'.$size.'" value="'.$value.'" />';
 }  }
   
 sub simplecheckbox {  sub simplecheckbox {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     my $checked='';      my $checked='';
     $checked="CHECKED" if $value eq 'on';      $checked="CHECKED" if $value eq 'on';
     return '<input type=checkbox name=\''.$name.'\' '. $checked . '>';      return '<input type="checkbox" name="'.$name.'" '. $checked . ' />';
 }  }
   
 sub searchphrasefield {  sub searchphrasefield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value)=@_;
     my $instruction=<<END;      my $instruction=<<END;
 Enter terms or phrases separated by search operators such  Enter terms or phrases separated by search operators such as AND, OR, or NOT.
 as AND or OR.  
 END  END
     my $uctitle=uc($title);      my $uctitle=uc($title);
     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>".      return "\n".
    "</FONT> $instruction<br />".          '<p><font color="#800000" face="helvetica"><b>'.$uctitle.':</b>'.
            '<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>';          "</FONT> $instruction<br />".&simpletextfield($name,$value,80);
 }  }
   
 sub dateboxes {  sub dateboxes {
     my ($name,$defaultmonth,$defaultday,$defaultyear,      my ($name,$defaultmonth,$defaultday,$defaultyear,
  $currentmonth,$currentday,$currentyear)=@_;   $currentmonth,$currentday,$currentyear)=@_;
     ($defaultmonth,$defaultday,$defaultyear)=('','','');      ($defaultmonth,$defaultday,$defaultyear)=('','','');
     my $month=<<END;      #
 <select name="${name}_month">      # Day
 <option value='$defaultmonth'> </option>  
 <option value="1">January</option>  
 <option value="2">February</option>  
 <option value="3">March</option>  
 <option value="4">April</option>  
 <option value="5">May</option>  
 <option value="6">June</option>  
 <option value="7">July</option>  
 <option value="8">August</option>  
 <option value="9">September</option>  
 <option value="10">October</option>  
 <option value="11">November</option>  
 <option value="12">December</option>  
 </select>  
 END  
     $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);  
     my $day=<<END;      my $day=<<END;
 <select name="${name}_day">  <select name="${name}_day">
 <option value='$defaultday'> </option>  <option value='$defaultday'> </option>
 <option value="1">1</option>  
 <option value="2">2</option>  
 <option value="3">3</option>  
 <option value="4">4</option>  
 <option value="5">5</option>  
 <option value="6">6</option>  
 <option value="7">7</option>  
 <option value="8">8</option>  
 <option value="9">9</option>  
 <option value="10">10</option>  
 <option value="11">11</option>  
 <option value="12">12</option>  
 <option value="13">13</option>  
 <option value="14">14</option>  
 <option value="15">15</option>  
 <option value="16">16</option>  
 <option value="17">17</option>  
 <option value="18">18</option>  
 <option value="19">19</option>  
 <option value="20">20</option>  
 <option value="21">21</option>  
 <option value="22">22</option>  
 <option value="23">23</option>  
 <option value="24">24</option>  
 <option value="25">25</option>  
 <option value="26">26</option>  
 <option value="27">27</option>  
 <option value="28">28</option>  
 <option value="29">29</option>  
 <option value="30">30</option>  
 <option value="31">31</option>  
 </select>  
 END  END
       for (my $i = 1; $i<=31; $i++) {
    $day.="<option value=\"$i\">$i</option>\n";
       }
       $day.="</select>\n";
     $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);      $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
       #
       # Month
       my $month=<<END;
   <select name="${name}_month">
   <option value='$defaultmonth'> </option>
   END
       my $i = 1;
       foreach (qw/January February March April May June 
        July August September October November December /){
    $month .="<option value=\"$i\">$_</option>\n";
    $i++;
       }
       $month.="</select>\n";
       $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
       #
       # Year (obviously)
     my $year=<<END;      my $year=<<END;
 <select name="${name}_year">  <select name="${name}_year">
 <option value='$defaultyear'> </option>  <option value='$defaultyear'> </option>
 <option value="1976">1976</option>  
 <option value="1977">1977</option>  
 <option value="1978">1978</option>  
 <option value="1979">1979</option>  
 <option value="1980">1980</option>  
 <option value="1981">1981</option>  
 <option value="1982">1982</option>  
 <option value="1983">1983</option>  
 <option value="1984">1984</option>  
 <option value="1985">1985</option>  
 <option value="1986">1986</option>  
 <option value="1987">1987</option>  
 <option value="1988">1988</option>  
 <option value="1989">1989</option>  
 <option value="1990">1990</option>  
 <option value="1991">1991</option>  
 <option value="1992">1992</option>  
 <option value="1993">1993</option>  
 <option value="1994">1994</option>  
 <option value="1995">1995</option>  
 <option value="1996">1996</option>  
 <option value="1997">1997</option>  
 <option value="1998">1998</option>  
 <option value="1999">1999</option>  
 <option value="2000">2000</option>  
 <option value="2001">2001</option>  
 <option value="2002">2002</option>  
 <option value="2003">2003</option>  
 <option value="2004">2004</option>  
 <option value="2005">2005</option>  
 <option value="2006">2006</option>  
 <option value="2007">2007</option>  
 <option value="2008">2008</option>  
 <option value="2009">2009</option>  
 <option value="2010">2010</option>  
 <option value="2011">2011</option>  
 <option value="2012">2012</option>  
 <option value="2013">2013</option>  
 <option value="2014">2014</option>  
 <option value="2015">2015</option>  
 <option value="2016">2016</option>  
 <option value="2017">2017</option>  
 <option value="2018">2018</option>  
 <option value="2019">2019</option>  
 <option value="2020">2020</option>  
 <option value="2021">2021</option>  
 <option value="2022">2022</option>  
 <option value="2023">2023</option>  
 <option value="2024">2024</option>  
 <option value="2025">2025</option>  
 <option value="2026">2026</option>  
 <option value="2027">2027</option>  
 <option value="2028">2028</option>  
 <option value="2029">2029</option>  
 <option value="2030">2030</option>  
 <option value="2031">2031</option>  
 <option value="2032">2032</option>  
 <option value="2033">2033</option>  
 <option value="2034">2034</option>  
 <option value="2035">2035</option>  
 <option value="2036">2036</option>  
 <option value="2037">2037</option>  
 <option value="2038">2038</option>  
 <option value="2039">2039</option>  
 <option value="2040">2040</option>  
 <option value="2041">2041</option>  
 <option value="2042">2042</option>  
 <option value="2043">2043</option>  
 <option value="2044">2044</option>  
 <option value="2045">2045</option>  
 <option value="2046">2046</option>  
 <option value="2047">2047</option>  
 <option value="2048">2048</option>  
 <option value="2049">2049</option>  
 <option value="2050">2050</option>  
 <option value="2051">2051</option>  
 </select>  
 END  END
       my $maxyear = 2051; 
       for (my $i = 1976; $i<=$maxyear; $i++) {
    $year.="<option value=\"$i\">$i</option>\n";
       }
       $year.="</select>\n";
     $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);      $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
     return "$month$day$year";      return "$month$day$year";
 }  }
   
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,%options)=@_;      my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_;
     my $uctitle=uc($title);      my $uctitle=uc($title);
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".      my $selout="\n".'<p><font color="#800000" face="helvetica">'.
  "</b></font><br />".'<select name="'.$name.'">';          '<b>'.$uctitle.':</b></font><br /><select name="'.$name.'">';
     map {      foreach ($anyvalue,@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value="'.$_.'"';
         if ($_ eq $value) { $selout.=' selected'; }          if ($_ eq $value and !/^any$/) {
         $selout.='>'.$options{$_}.'</option>';      $selout.=' selected >'.&{$functionref}($_).'</option>';
     } sort keys %options;   }
    elsif ($_ eq $value and /^$anyvalue$/) {
       $selout.=' selected >'.$anytag.'</option>';
    }
           else {$selout.='>'.&{$functionref}($_).'</option>';}
       }
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
 # ----------------------------------------------- Performing an advanced search  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &advancedsearch() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub advancedsearch {  sub advancedsearch {
     my ($r,$envhash)=@_;      my ($r,$envhash)=@_;
     my %ENV=%{$envhash};      my %ENV=%{$envhash};
   
     my $fillflag=0;      my $fillflag=0;
     # Clean up fields for safety      # Clean up fields for safety
     for my $field ('title','author','subject','keywords','url','version',      for my $field ('title','author','subject','keywords','url','version',
Line 632  sub advancedsearch { Line 659  sub advancedsearch {
    'lastrevisiondateend_day','lastrevisiondateend_year',     'lastrevisiondateend_day','lastrevisiondateend_year',
    'notes','abstract','mime','language','owner',     'notes','abstract','mime','language','owner',
    'custommetadata','customshow') {     'custommetadata','customshow') {
  $ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g;   $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
       }
       foreach ('mode','form','element') {
    # is this required?  Hmmm.
    next unless (exists($ENV{"form.$_"}));
    $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
    $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
     }      }
   
     # Check to see if enough information was filled in      # Check to see if enough information was filled in
     for my $field ('title','author','subject','keywords','url','version',      for my $field ('title','author','subject','keywords','url','version',
    'notes','abstract','mime','language','owner',     'notes','abstract','mime','language','owner',
Line 647  sub advancedsearch { Line 679  sub advancedsearch {
  &output_blank_field_error($r);   &output_blank_field_error($r);
  return OK;   return OK;
     }      }
   
   
     # Turn the form input into a SQL-based query      # Turn the form input into a SQL-based query
     my $query='';      my $query='';
   
     my @queries;      my @queries;
     # Evaluate logical expression AND/OR/NOT phrase fields.      # Evaluate logical expression AND/OR/NOT phrase fields.
     foreach my $field ('title','author','subject','notes','abstract','url',      foreach my $field ('title','author','subject','notes','abstract','url',
Line 693  sub advancedsearch { Line 722  sub advancedsearch {
     elsif ($datequery) {      elsif ($datequery) {
  push @queries,$datequery;   push @queries,$datequery;
     }      }
   
     # Process form information for custom metadata querying      # Process form information for custom metadata querying
     my $customquery='';      my $customquery='';
     if ($ENV{'form.custommetadata'}) {      if ($ENV{'form.custommetadata'}) {
Line 733  sub advancedsearch { Line 761  sub advancedsearch {
     return 'Error.  Should not have gone to this point.';      return 'Error.  Should not have gone to this point.';
 }  }
   
 # --------------------------------------------------- Performing a basic search  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &basicsearch() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub basicsearch {  sub basicsearch {
     my ($r,$envhash)=@_;      my ($r,$envhash)=@_;
     my %ENV=%{$envhash};      my %ENV=%{$envhash};
Line 741  sub basicsearch { Line 779  sub basicsearch {
     for my $field ('basicexp') {      for my $field ('basicexp') {
  $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;   $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
     }      }
       foreach ('mode','form','element') {
    # is this required?  Hmmm.
    next unless (exists($ENV{"form.$_"}));
    $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
    $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
       }
   
     # Check to see if enough is filled in      # Check to see if enough is filled in
     unless (&filled($ENV{'form.basicexp'})) {      unless (&filled($ENV{'form.basicexp'})) {
Line 766  sub basicsearch { Line 810  sub basicsearch {
     return OK;      return OK;
 }  }
   
 # ------------------------------------------------------------- build_SQL_query  
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item &build_SQL_query() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub build_SQL_query {  sub build_SQL_query {
     my ($field_name,$logic_statement)=@_;      my ($field_name,$logic_statement)=@_;
     my $q=new Text::Query('abc',      my $q=new Text::Query('abc',
Line 778  sub build_SQL_query { Line 833  sub build_SQL_query {
     return $sql_query;      return $sql_query;
 }  }
   
 # ------------------------------------------------- build custom metadata query  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &build_custommetadata_query() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub build_custommetadata_query {  sub build_custommetadata_query {
     my ($field_name,$logic_statement)=@_;      my ($field_name,$logic_statement)=@_;
       &Apache::lonnet::logthis("Entered build_custommetadata_query:".
                                $field_name.':'.$logic_statement);
     my $q=new Text::Query('abc',      my $q=new Text::Query('abc',
   -parse => 'Text::Query::ParseAdvanced',    -parse => 'Text::Query::ParseAdvanced',
   -build => 'Text::Query::BuildAdvancedString');    -build => 'Text::Query::BuildAdvancedString');
Line 788  sub build_custommetadata_query { Line 855  sub build_custommetadata_query {
     my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};      my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
     # quick fix to change literal into xml tag-matching      # quick fix to change literal into xml tag-matching
     # will eventually have to write a separate builder module      # will eventually have to write a separate builder module
     my $oldmatchexp=$matchexp;      # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
     $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g;      $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to 
                    /\\<$1\\>?#           \<wordone\>
                      \[\^\\<\]?#        [^\<]         
                      \*$2\[\^\\<\]?#           *wordtwo[^\<]
                      \*\\<\\\/$1\\>?#                        *\<\/wordone\>
                      /g;
       &Apache::lonnet::logthis("match expression: ".$matchexp);
     return $matchexp;      return $matchexp;
 }  }
   
 # - Recursively parse a reverse notation expression into a SQL query expression  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &recursive_SQL_query_build() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub recursive_SQL_query_build {  sub recursive_SQL_query_build {
     my ($dkey,$pattern)=@_;      my ($dkey,$pattern)=@_;
     my @matches=($pattern=~/(\[[^\]|\[]*\])/g);      my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
Line 827  sub recursive_SQL_query_build { Line 910  sub recursive_SQL_query_build {
     &recursive_SQL_query_build($dkey,$pattern);      &recursive_SQL_query_build($dkey,$pattern);
 }  }
   
 # ------------------------------------------------------------ Build date query  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &build_date_queries() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub build_date_queries {  sub build_date_queries {
     my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,      my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
  $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;   $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
Line 876  sub build_date_queries { Line 969  sub build_date_queries {
     return '';      return '';
 }  }
   
 # ----------------------------- format and output results based on a reply list  ######################################################################
 # There are two windows that this function writes to.  The main search  ######################################################################
 # window ("srch") has a listing of the results.  A secondary window ("popwin")  
 # gives the status of the network search (time elapsed, number of machines  =pod 
 # contacted, etc.)  
   =item &output_results() 
   
   Format and output results based on a reply list.
   There are two windows that this function writes to.  The main search
   window ("srch") has a listing of the results.  A secondary window ("popwin")
   gives the status of the network search (time elapsed, number of machines
   contacted, etc.)
   
   =cut
   
   ######################################################################
   ######################################################################
 sub output_results {  sub output_results {
       my $fnum; # search result counter
     my ($mode,$r,$envhash,$query,$replyref)=@_;      my ($mode,$r,$envhash,$query,$replyref)=@_;
     my %ENV=%{$envhash};      my %ENV=%{$envhash};
     my %rhash=%{$replyref};      my %rhash=%{$replyref};
     my $compiledresult='';      my $compiledresult='';
     my $timeremain=30;      my $timeremain=300;
     my $elapsetime=0;      my $elapsetime=0;
     my $resultflag=0;      my $resultflag=0;
     my $tflag=1;      my $tflag=1;
Line 903  BEGINNING Line 1009  BEGINNING
   
     # conditional output of script functions dependent on the mode in      # conditional output of script functions dependent on the mode in
     # which the search was invoked      # which the search was invoked
         $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'interactive';      if ($ENV{'form.catalogmode'} eq 'interactive'){
 <script>   if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') {
               $r->print(<<SCRIPT) 
   <script type="text/javascript">
     function select_data(title,url) {      function select_data(title,url) {
  changeTitle(title);   changeTitle(title);
  changeURL(url);   changeURL(url);
Line 922  BEGINNING Line 1030  BEGINNING
     }      }
 </script>  </script>
 SCRIPT  SCRIPT
         $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'groupsearch';          } elsif ($ENV{'form.mode'} eq 'edit') {
 <script>              my $form = $ENV{'form.form'};
               my $element = $ENV{'form.element'};
               $r->print(<<SCRIPT) 
   <script type="text/javascript">
   function select_data(title,url) {
       changeURL(url);
       self.close();
   }
   function changeTitle(val) {
   }
   function changeURL(val) {
       if (window.opener.document) {
           window.opener.document.forms["$form"].elements["$element"].value=val;
       } else {
    var url = 'forms[\"$form\"].elements[\"$element\"].value';
           alert("Unable to transfer data to "+url);
       }
   }
   </script>
   SCRIPT
           }
       }
       $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'groupsearch';
   <script type="text/javascript">
     function select_data(title,url) {      function select_data(title,url) {
  alert('DEBUG: Should be storing '+title+' and '+url);  // alert('DEBUG: Should be storing '+title+' and '+url);
     }      }
     function queue(val) {      function queue(val) {
  if (eval("document.forms."+val+".filelink.checked")) {   if (eval("document.forms.results.returnvalues["+val+"].checked")) {
     document.forms.results.acts.value+='1a'+val+'b';      document.forms.results.acts.value+='1a'+val+'b';
  }   }
  else {   else {
Line 936  SCRIPT Line 1067  SCRIPT
  }   }
     }      }
     function select_group() {      function select_group() {
  alert('DEBUG: Should be moving on to group sorting stage'+' acts');   window.location=
       "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+
       document.forms.results.acts.value;
     }      }
 </script>  </script>
 SCRIPT  SCRIPT
         $r->print(<<SCRIPT);                                            ;      $r->print(<<SCRIPT);
 <script>  <script type="text/javascript">
     function displayinfo(val) {      function displayinfo(val) {
  popwin.document.forms.popremain.sdetails.value=val;   popwin.document.forms.popremain.sdetails.value=val;
     }      }
       function openhelp(val) {
    openhelpwin=open('/adm/help/searchcat.html','helpscreen',
        'scrollbars=1,width=400,height=300');
    openhelpwin.focus();
       }
       function abortsearch(val) {
    popwin.close();
       }
 </script>  </script>
 SCRIPT  SCRIPT
     $r->rflush();      $r->rflush();
Line 958  SCRIPT Line 1099  SCRIPT
 CATALOGBEGIN  CATALOGBEGIN
         $r->print(<<CATALOGCONTROLS);          $r->print(<<CATALOGCONTROLS);
 <form name='results' method="post" action="/adm/searchcat">  <form name='results' method="post" action="/adm/searchcat">
   $hidden
 <input type='hidden' name='acts' value='' />  <input type='hidden' name='acts' value='' />
 <input type='button' value='Revise search request'  <input type='button' value='Revise search request'
 onClick='this.form.submit();' />  onClick='this.form.submit();' />
Line 998  RESULTS Line 1140  RESULTS
  $grid.="javascript:opener.displayinfo('+";   $grid.="javascript:opener.displayinfo('+";
  # "'"+'key   # "'"+'key
  $grid.="\"'\"+'";   $grid.="\"'\"+'";
  $grid.=$sk." domain=".$hostdomains{$sk};   $grid.=$sk;
  my $hc;   my $hc;
  if ($rhash{$sk} eq 'con_lost') {   if ($rhash{$sk} eq 'con_lost') {
     $hc="!!!BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR!!!";      $hc="BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR ";
  }   }
  else {   else {
     $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'";      $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'";
     $hcinit.="hc[\"$sk\"]=0;";      $hcinit.="hc[\"$sk\"]=\"not yet connected...\";";
  }   }
  $grid.=" hitcount=".$hc;   $grid.=" hitcount=".$hc;
    $grid.=" domain=".$hostdomains{$sk};
  $grid.=" IP=".$hostips{$sk};   $grid.=" IP=".$hostips{$sk};
  # '+"'"+'">'+   # '+"'"+'">'+
  $grid.="'+\"'\"+')\">'+";   $grid.="'+\"'\"+')\">'+";
  $grid.="\n";   $grid.="\n";
  $grid.="'<img border=\"0\" name=\"img".$sn."\"".   $grid.="'<img border=\"0\" name=\"img".$sn."\"".
     " src=\"/adm/lonIcons/srvbad.gif\" alt=\"".$sk."\" /></a>'+\n";      " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" /></a>'+\n";
  $grid.="'<br />'+\n" unless $sn%10;   $grid.="'<br />'+\n" unless $sn%10;
         $sn++;          $sn++;
     }      }
     $r->print(<<ENDPOP);      $r->print(<<ENDPOP);
 <script>  <script type="text/javascript">
     popwin=open('','popwin','scrollbars=1,width=400,height=200');      popwin=open('','popwin','scrollbars=1,width=400,height=220');
     popwin.focus();      popwin.focus();
     popwin.document.writeln('<'+'html>');      popwin.document.writeln('<'+'html>');
     popwin.document.writeln('<'+'head>');      popwin.document.writeln('<'+'head>');
Line 1028  RESULTS Line 1171  RESULTS
     popwin.document.writeln('<'+'/script>');      popwin.document.writeln('<'+'/script>');
     popwin.document.writeln('<'+'/head>'+      popwin.document.writeln('<'+'/head>'+
         '<'+'body bgcolor="#FFFFFF">'+          '<'+'body bgcolor="#FFFFFF">'+
    '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+
    'lonanim.gif" '+
    'alt="animated logo" />'+
  '<'+'h3>Search Results Progress<'+'/h3>'+   '<'+'h3>Search Results Progress<'+'/h3>'+
         '<'+'form name="popremain">'+          '<'+'form name="popremain">'+
         '<'+'br />Server space <'+'input type=text size=25 name=space value="">'+  
         '<'+'br />Status <'+'input type=text size=25 name=status value="">'+  
         '<'+'br />Maximum remaining time <'+'input type=text size=25 name=timeout '+  
  'value="30">'+  
         '<'+'tt>'+          '<'+'tt>'+
  '<'+'image align="right" src="/adm/lonIcons/'+   '<'+'br clear="all"/><i>PLEASE BE PATIENT</i>'+
  'lonanim.gif" '+  
  'alt="animated logo" />'+  
  '<'+'br /><i>PLEASE BE PATIENT</i>'+  
  '<'+'br />SCANNING $servernum SERVERS'+   '<'+'br />SCANNING $servernum SERVERS'+
  '<'+'br clear="all" />Number of record hits found '+   '<'+'br clear="all" />Number of record hits found '+
  '<'+'input type="text" size="10" name="numhits"'+   '<'+'input type="text" size="10" name="numhits"'+
Line 1051  RESULTS Line 1190  RESULTS
         $grid          $grid
         '<'+'br />'+          '<'+'br />'+
  'Server details '+   'Server details '+
  '<'+'input type="text" size="25" name="sdetails"'+   '<'+'input type="text" size="35" name="sdetails"'+
  ' value="" />'+   ' value="" />'+
  '<'+'br />'+   '<'+'br />'+
  '<'+'input type="button" name="button"'+  
  ' value="revise search" />'+  
  ' <'+'input type="button" name="button"'+   ' <'+'input type="button" name="button"'+
  ' value="view results" />'+   ' value="close this window" '+
    ' onClick="javascript:opener.abortsearch()" />'+
  ' <'+'input type="button" name="button"'+   ' <'+'input type="button" name="button"'+
  ' value="help" />'+   ' value="help" onClick="javascript:opener.openhelp()" />'+
  '<'+'/tt>'+   '<'+'/tt>'+
         '<'+'/form>'+          '<'+'/form>'+
         '<'+'/body><'+'/html>');          '<'+'/body><'+'/html>');
Line 1068  RESULTS Line 1206  RESULTS
 ENDPOP  ENDPOP
     $r->rflush();      $r->rflush();
   
     $r->print('<script>popwin.document.popremain.space.value="'.  
       $servernum.', 0%, count=0/'.$servernum.'";</script>');  
     $r->rflush();   
     my $servercount=0;      my $servercount=0;
     $sn=0;  
     my $hitcountsum=0;      my $hitcountsum=0;
     foreach my $rkey (sort keys %rhash) {      my $bloop=$servernum;
       my %orkey;
     BLOOP: while(1) {
         my $sn=0;
         last BLOOP unless $bloop;
         last BLOOP unless $timeremain;
       RLOOP: foreach my $rkey (sort keys %rhash) {
  $sn++;   $sn++;
    next RLOOP if $orkey{$rkey};
  $servercount++;   $servercount++;
  $tflag=1;   $tflag=1;
  $compiledresult='';   $compiledresult='';
  my $hostname=$rkey;   my $hostname=$rkey;
  $r->print('<script>popwin.document.popremain.status.value="'.  
   $rkey.', trying contact";</script>'."\n");  
  $r->rflush();  
  my $reply=$rhash{$rkey};   my $reply=$rhash{$rkey};
  my @results;   my @results;
   
  my $replyfile='';   my $replyfile='';
   
  if ($reply eq 'con_lost') {   if ($reply eq 'con_lost') {
     my $percent=sprintf('%3.0f',($servercount/$servernum*100));      &popwin_imgupdate($r,$sn,"srvbad.gif");
     $r->print('<script>popwin.document.popremain.space.value="'.      $bloop--;
       $servernum.', '.$percent.'%, count='.$servercount.      $orkey{$rkey}=1;
       '/'.$servernum.'";</script>');  
  }   }
  else {   else {
     $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting      $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting
Line 1102  ENDPOP Line 1239  ENDPOP
  my $temp=0;   my $temp=0;
       WLOOP: while (1) {        WLOOP: while (1) {
   if (-e $replyfile && $tflag) {    if (-e $replyfile && $tflag) {
       $r->print('<script>popwin.document.popremain.status.'.        &popwin_imgupdate($r,$sn,"srvhalf.gif");
  'value="'.$rkey.', transmitting";</script>'.        &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
  "\n");   '"still transferring..."'.';');
       $r->rflush();  
       $r->print('<script>popwin.document.img'.$sn.'.'.  
  'src="/adm/lonIcons/srvempty.gif";</script>'.  
  "\n");  
       $r->rflush();  
       $tflag=0;        $tflag=0;
   }    }
   last WLOOP if $temp>5;  
   if (-e "$replyfile.end") {    if (-e "$replyfile.end") {
         $bloop--;
         $orkey{$rkey}=1;
       if (-s $replyfile) {        if (-s $replyfile) {
   $r->print('<script>popwin.document.img'.$sn.'.'.    &popwin_imgupdate($r,$sn,"srvgood.gif");
  'src="/adm/lonIcons/srvgood.gif";</script>'.  
  "\n");  
   $r->rflush();  
   my $fh=Apache::File->new($replyfile) or     my $fh=Apache::File->new($replyfile) or 
       ($r->print('ERROR: file '.        ($r->print('ERROR: file '.
  $replyfile.' cannot be opened') and   $replyfile.' cannot be opened') and
        return OK);         return OK);
   @results=<$fh> if $fh;    @results=<$fh> if $fh;
   $hitcount{$rkey}=@results+0;    $hitcount{$rkey}=@results+0;
   $r->print('<script>popwin.hc["'.$rkey.'"]='.    &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
     $hitcount{$rkey}.';</script>'.      $hitcount{$rkey}.';');
     "\n");  
   $r->rflush();  
   $hitcountsum+=$hitcount{$rkey};    $hitcountsum+=$hitcount{$rkey};
   $r->print('<script>popwin.document.forms.popremain.'.    &popwin_js($r,'popwin.document.forms.popremain.'.
     'numhits.value='.$hitcountsum.      'numhits.value='.$hitcountsum.';');
     ';</script>'.  
     "\n");  
   $r->rflush();  
       }        }
         else {
     &popwin_imgupdate($r,$sn,"srvempty.gif");
     &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;');
         }
         last WLOOP;
     }
     if ($temp>1) {
         sleep 1;
         $timeremain--;
         $elapsetime++;
       last WLOOP;        last WLOOP;
   }    }
   last WLOOP unless $timeremain;    last WLOOP unless $timeremain;
   sleep 1;    sleep 1;
   $timeremain--;    $timeremain--;
   $elapsetime++;    $elapsetime++;
   $r->print('<script>popwin.document.popremain.timeout.'.    &popwin_js($r,"popwin.document.popremain.".
     'value="'.$timeremain.'";</script>'."\n");         "elapsetime.value=$elapsetime;");
   $r->rflush();  
   $r->print('<script>popwin.document.popremain.elapsetime.'.  
     'value="'.$elapsetime.'";</script>'."\n");  
   $r->rflush();  
   $temp++;    $temp++;
       }        }
     }      }
       &popwin_js($r,'popwin.document.whirly.'.
          'src="/adm/lonIcons/lonanimend.gif";');
  }   }
  my $customshow='';   my $customshow='';
  my $extrashow='';   my $extrashow='';
Line 1176  ENDPOP Line 1309  ENDPOP
  $customhash{$k}=$v;   $customhash{$k}=$v;
     }      }
  }   }
  foreach my $result (@results) {   if (keys %hash) {
     next if $result=~/^custom\=/;      untie %hash;
     chomp $result;   }
     next unless $result;   if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
     my @fields=map      if ($ENV{'form.launch'} eq '1') {
     {&Apache::lonnet::unescape($_)}   &start_fresh_session();
     (split(/\,/,$result));      }
     my ($title,$author,$subject,$url,$keywords,$version,      foreach my $result (@results) {
  $notes,$abstract,$mime,$lang,   next if $result=~/^custom\=/;
  $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;   chomp $result;
     my $shortabstract=$abstract;   next unless $result;
     $shortabstract=substr($abstract,0,200) if length($abstract)>200;   my @fields=map
     $fields[7]=$shortabstract;   {&Apache::lonnet::unescape($_)}
     my $extrashow2=$extrashow;   (split(/\,/,$result));
     if ($extrashow) {   my ($title,$author,$subject,$url,$keywords,$version,
  foreach my $field (@customfields) {      $notes,$abstract,$mime,$lang,
     my $value='';      $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
     if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) {  
         $value=$1;                  unless ($title) { $title='<i>Untitled</i>'; }
     }   unless ($ENV{'user.adv'}) {
             $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g;      $keywords='<i>- not displayed -</i>';
         }      $fields[4]=$keywords;
             }      $notes='<i>- not displayed -</i>';
       $fields[6]=$notes;
       $abstract='<i>- not displayed -</i>';
       $fields[7]=$abstract;
       $subject='<i>- not displayed -</i>';
       $fields[2]=$subject;
    }
   
    my $shortabstract=$abstract;
    $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200;
    $fields[7]=$shortabstract;
    my $shortkeywords=$keywords;
    $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200;
    $fields[4]=$shortkeywords;
   
    my $extrashow2=$extrashow;
    if ($extrashow) {
       foreach my $field (@customfields) {
    my $value='';
    if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) {
               $value=$1;
    }
           $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g;
               }
                   }
   
             $compiledresult.=<<END if $compiledresult or $servercount!=$servernum;          $compiledresult.=<<END if $compiledresult or $servercount!=$servernum;
 <hr align='left' width='200' noshade />  <hr align='left' width='200' noshade />
 END  END
             $compiledresult.=<<END;                  $compiledresult.=<<END;
 <p>  <p>
 END  END
             $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'interactive';                 if ($ENV{'form.catalogmode'} eq 'interactive') {
      my $titleesc=$title;
      $titleesc=~s/\'/\\'/; # '
   
                      $compiledresult.=<<END if ($ENV{'form.catalogmode'} eq 'interactive');
 <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"  <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
 onClick="javascript:select_data('$title','$url')">  onClick="javascript:select_data('$titleesc','$url')">
 </font>  </font>
 <br />  <br />
 END  END
             $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'groupsearch';                  }
 <font size='-1'><input type="checkbox" name="returnvalues" value="SELECT"                  if ($ENV{'form.catalogmode'} eq 'groupsearch') {
       $fnum+=0;
       $hash{"pre_${fnum}_link"}=$url;
       $hash{"pre_${fnum}_title"}=$title;
       $compiledresult.=<<END;
   <font size='-1'>
   <input type="checkbox" name="returnvalues" value="SELECT"
 onClick="javascript:queue($fnum)" />  onClick="javascript:queue($fnum)" />
 </font>  </font>
 <input type="hidden" name="title$fnum" value="$title" />  
 <input type="hidden" name="url$fnum" value="$url" />  
 <br />  <br />
 END  END
             my $httphost=$ENV{'HTTP_HOST'};  # <input type="hidden" name="title$fnum" value="$title" />
   # <input type="hidden" name="url$fnum" value="$url" />
                       $fnum++;
    }
           my $httphost=$ENV{'HTTP_HOST'};
   
           my $viewselect;
           if ($mode eq 'Basic') {
       $viewselect=$ENV{'form.basicviewselect'};
    }
           elsif ($mode eq 'Advanced') {
       $viewselect=$ENV{'form.advancedviewselect'};
    }
   
             my $viewselect;          if ($viewselect eq 'Detailed Citation View') {
             if ($mode eq 'Basic') {      $compiledresult.=&detailed_citation_view(@fields,
  $viewselect=$ENV{'form.basicviewselect'};  
     }  
             elsif ($mode eq 'Advanced') {  
         $viewselect=$ENV{'form.advancedviewselect'};  
             }  
   
             if ($viewselect eq 'Detailed Citation View') {  
         $compiledresult.=&detailed_citation_view(@fields,  
  $hostname,$httphost,   $hostname,$httphost,
  $extrashow2);   $extrashow2);
     }   }
             elsif ($viewselect eq 'Summary View') {                  elsif ($viewselect eq 'Summary View') {
  $compiledresult.=&summary_view(@fields,$hostname,$httphost,      $compiledresult.=&summary_view(@fields,$hostname,$httphost,
        $extrashow2);         $extrashow2);
     }          }
             elsif ($viewselect eq 'Fielded Format') {                  elsif ($viewselect eq 'Fielded Format') {
  $compiledresult.=&fielded_format_view(@fields,$hostname,      $compiledresult.=&fielded_format_view(@fields,$hostname,
       $httphost,$extrashow2);        $httphost,$extrashow2);
     }          }
             elsif ($viewselect eq 'XML/SGML') {                  elsif ($viewselect eq 'XML/SGML') {
  $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost,      $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost,
  $extrashow2);   $extrashow2);
     }   }
           
         }              }
   
               untie %hash;
           }
           else {
       $r->print('<html><head></head><body>Unable to tie hash to db '.
     'file</body></html>');
    }
  if ($compiledresult) {   if ($compiledresult) {
     $resultflag=1;      $resultflag=1;
  }   }
Line 1258  END Line 1433  END
 $compiledresult  $compiledresult
 RESULTS  RESULTS
         my $percent=sprintf('%3.0f',($servercount/$servernum*100));          my $percent=sprintf('%3.0f',($servercount/$servernum*100));
  $r->print('<script>popwin.document.popremain.space.value="'.  
           $servernum.', '.$percent.'%, count='.$servercount.  
   '/'.$servernum.'";</script>'."\n");  
     }      }
     }
     unless ($resultflag) {      unless ($resultflag) {
         $r->print("\nThere were no results that matched your query\n");          $r->print("\nThere were no results that matched your query\n");
     }      }
 #    $r->print('<script>popwin.close()</script>'."\n"); $r->rflush();   #    $r->print('<script type="text/javascript">'.'popwin.close()</script>'."\n"); $r->rflush(); 
     $r->print(<<RESULTS);      $r->print(<<RESULTS);
 </body>  </body>
 </html>  </html>
 RESULTS  RESULTS
 }  }
   
 # ------------------------------------------------------ Detailed Citation View  ######################################################################
   ######################################################################
   
   =pod 
   
   =item Metadata Viewing Functions
   
   Output is a HTML-ified string.
   Input arguments are title, author, subject, url, keywords, version,
   notes, short abstract, mime, language, creation date,
   last revision date, owner, copyright, hostname, httphost, and
   extra custom metadata to show.
   
   =over 4
   
   =item &detailed_citation_view() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub detailed_citation_view {  sub detailed_citation_view {
     my ($title,$author,$subject,$url,$keywords,$version,      my ($title,$author,$subject,$url,$keywords,$version,
  $notes,$shortabstract,$mime,$lang,   $notes,$shortabstract,$mime,$lang,
Line 1287  sub detailed_citation_view { Line 1480  sub detailed_citation_view {
 <b>Subject:</b> $subject<br />  <b>Subject:</b> $subject<br />
 <b>Keyword(s):</b> $keywords<br />  <b>Keyword(s):</b> $keywords<br />
 <b>Notes:</b> $notes<br />  <b>Notes:</b> $notes<br />
 <b>MIME Type:</b> $mimetag{$mime}<br />  <b>MIME Type:</b>
 <b>Language:</b> $language{$lang}<br />  END
 <b>Copyright/Distribution:</b> $cprtag{$copyright}<br />      $result.=&Apache::loncommon::filedescription($mime);
       $result.=<<END;
   <br />
   <b>Language:</b> 
   END
       $result.=&Apache::loncommon::languagedescription($lang);
       $result.=<<END;
   <br />
   <b>Copyright/Distribution:</b> 
   END
       $result.=&Apache::loncommon::copyrightdescription($copyright);
       $result.=<<END;
   <br />
 </p>  </p>
 $extrashow  $extrashow
 <p>  <p>
Line 1299  END Line 1504  END
     return $result;      return $result;
 }  }
   
 # ---------------------------------------------------------------- Summary View  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &summary_view() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub summary_view {  sub summary_view {
     my ($title,$author,$subject,$url,$keywords,$version,      my ($title,$author,$subject,$url,$keywords,$version,
  $notes,$shortabstract,$mime,$lang,   $notes,$shortabstract,$mime,$lang,
  $creationdate,$lastrevisiondate,$owner,$copyright,   $creationdate,$lastrevisiondate,$owner,$copyright,
  $hostname,$httphost,$extrashow)=@_;   $hostname,$httphost,$extrashow)=@_;
       my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
     my $result=<<END;      my $result=<<END;
 <a href="http://$httphost$url" TARGET='search_preview'>$author</a><br />  <a href="http://$httphost$url" TARGET='search_preview'>$author</a><br />
 $title<br />  $title<br />
 $owner -- $lastrevisiondate<br />  $owner -- $lastrevisiondate<br />
 $cprtag{$copyright}<br />  $cprtag<br />
 $extrashow  $extrashow
 </p>  </p>
 END  END
     return $result;      return $result;
 }  }
   
 # -------------------------------------------------------------- Fielded Format  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &fielded_format_view() 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub fielded_format_view {  sub fielded_format_view {
     my ($title,$author,$subject,$url,$keywords,$version,      my ($title,$author,$subject,$url,$keywords,$version,
  $notes,$shortabstract,$mime,$lang,   $notes,$shortabstract,$mime,$lang,
  $creationdate,$lastrevisiondate,$owner,$copyright,   $creationdate,$lastrevisiondate,$owner,$copyright,
  $hostname,$httphost,$extrashow)=@_;   $hostname,$httphost,$extrashow)=@_;
       my $mimetag=&Apache::loncommon::filedescription($mime);
       my $language=&Apache::loncommon::languagedescription($lang);
       my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
     my $result=<<END;      my $result=<<END;
 <b>URL: </b> <A HREF="http://$httphost$url" TARGET='search_preview'>$url</A>  <b>URL: </b> <A HREF="http://$httphost$url" TARGET='search_preview'>$url</A>
 <br />  <br />
Line 1330  sub fielded_format_view { Line 1559  sub fielded_format_view {
 <b>Subject:</b> $subject<br />  <b>Subject:</b> $subject<br />
 <b>Keyword(s):</b> $keywords<br />  <b>Keyword(s):</b> $keywords<br />
 <b>Notes:</b> $notes<br />  <b>Notes:</b> $notes<br />
 <b>MIME Type:</b> $mimetag{$mime}<br />  <b>MIME Type:</b> $mimetag<br />
 <b>Language:</b> $language{$lang}<br />  <b>Language:</b> $language<br />
 <b>Creation Date:</b> $creationdate<br />  <b>Creation Date:</b> $creationdate<br />
 <b>Last Revision Date:</b> $lastrevisiondate<br />  <b>Last Revision Date:</b> $lastrevisiondate<br />
 <b>Publisher/Owner:</b> $owner<br />  <b>Publisher/Owner:</b> $owner<br />
 <b>Copyright/Distribution:</b> $cprtag{$copyright}<br />  <b>Copyright/Distribution:</b> $cprtag<br />
 <b>Repository Location:</b> $hostname<br />  <b>Repository Location:</b> $hostname<br />
 <b>Abstract:</b> $shortabstract<br />  <b>Abstract:</b> $shortabstract<br />
 $extrashow  $extrashow
Line 1344  END Line 1573  END
     return $result;      return $result;
 }  }
   
 # -------------------------------------------------------------------- XML/SGML  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &xml_sgml_view() 
   
   =back 
   
   =cut
   
   ######################################################################
   ######################################################################
 sub xml_sgml_view {  sub xml_sgml_view {
     my ($title,$author,$subject,$url,$keywords,$version,      my ($title,$author,$subject,$url,$keywords,$version,
  $notes,$shortabstract,$mime,$lang,   $notes,$shortabstract,$mime,$lang,
  $creationdate,$lastrevisiondate,$owner,$copyright,   $creationdate,$lastrevisiondate,$owner,$copyright,
  $hostname,$httphost,$extrashow)=@_;   $hostname,$httphost,$extrashow)=@_;
       my $cprtag=&Apache::loncommon::copyrightdescription($copyright);
       my $mimetag=&Apache::loncommon::filedescription($mime);
       my $language=&Apache::loncommon::languagedescription($lang);
     my $result=<<END;      my $result=<<END;
 <pre>  <pre>
 &lt;LonCapaResource&gt;  &lt;LonCapaResource&gt;
Line 1361  sub xml_sgml_view { Line 1605  sub xml_sgml_view {
 &lt;notes&gt;$notes&lt;/notes&gt;  &lt;notes&gt;$notes&lt;/notes&gt;
 &lt;mimeInfo&gt;  &lt;mimeInfo&gt;
 &lt;mime&gt;$mime&lt;/mime&gt;  &lt;mime&gt;$mime&lt;/mime&gt;
 &lt;mimetag&gt;$mimetag{$mime}&lt;/mimetag&gt;  &lt;mimetag&gt;$mimetag&lt;/mimetag&gt;
 &lt;/mimeInfo&gt;  &lt;/mimeInfo&gt;
 &lt;languageInfo&gt;  &lt;languageInfo&gt;
 &lt;language&gt;$lang&lt;/language&gt;  &lt;language&gt;$lang&lt;/language&gt;
 &lt;languagetag&gt;$language{$lang}&lt;/languagetag&gt;  &lt;languagetag&gt;$language&lt;/languagetag&gt;
 &lt;/languageInfo&gt;  &lt;/languageInfo&gt;
 &lt;creationdate&gt;$creationdate&lt;/creationdate&gt;  &lt;creationdate&gt;$creationdate&lt;/creationdate&gt;
 &lt;lastrevisiondate&gt;$lastrevisiondate&lt;/lastrevisiondate&gt;  &lt;lastrevisiondate&gt;$lastrevisiondate&lt;/lastrevisiondate&gt;
 &lt;owner&gt;$owner&lt;/owner&gt;  &lt;owner&gt;$owner&lt;/owner&gt;
 &lt;copyrightInfo&gt;  &lt;copyrightInfo&gt;
 &lt;copyright&gt;$copyright&lt;/copyright&gt;  &lt;copyright&gt;$copyright&lt;/copyright&gt;
 &lt;copyrighttag&gt;$cprtag{$copyright}&lt;/copyrighttag&gt;  &lt;copyrighttag&gt;$cprtag&lt;/copyrighttag&gt;
 &lt;/copyrightInfo&gt;  &lt;/copyrightInfo&gt;
 &lt;repositoryLocation&gt;$hostname&lt;/repositoryLocation&gt;  &lt;repositoryLocation&gt;$hostname&lt;/repositoryLocation&gt;
 &lt;shortabstract&gt;$shortabstract&lt;/shortabstract&gt;  &lt;shortabstract&gt;$shortabstract&lt;/shortabstract&gt;
Line 1383  END Line 1627  END
     return $result;      return $result;
 }  }
   
 # ---------------------------------------------------- see if a field is filled  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &filled() see if field is filled.
   
   =cut
   
   ######################################################################
   ######################################################################
 sub filled {  sub filled {
     my ($field)=@_;      my ($field)=@_;
     if ($field=~/\S/ && $field ne 'any') {      if ($field=~/\S/ && $field ne 'any') {
Line 1394  sub filled { Line 1648  sub filled {
     }      }
 }  }
   
 # ---------------- Message to output when there are not enough fields filled in  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &output_blank_field_error()
   
   =cut
   
   ######################################################################
   ######################################################################
 sub output_blank_field_error {  sub output_blank_field_error {
     my ($r)=@_;      my ($r)=@_;
     # make query information persistent to allow for subsequent revision      # make query information persistent to allow for subsequent revision
Line 1428  processed. Line 1692  processed.
 RESULTS  RESULTS
 }  }
   
 # ----------------------------------------------------------- Output date error  ######################################################################
   ######################################################################
   
   =pod 
   
   =item &output_date_error()
   
   Output a full html page with an error message.
   
   =cut
   
   ######################################################################
   ######################################################################
 sub output_date_error {  sub output_date_error {
     my ($r,$message)=@_;      my ($r,$message)=@_;
     # make query information persistent to allow for subsequent revision      # make query information persistent to allow for subsequent revision
     my $persistent=&make_persistent();      my $persistent=&make_persistent();
   
     $r->print(<<BEGINNING);      $r->print(<<RESULTS);
 <html>  <html>
 <head>  <head>
 <title>The LearningOnline Network with CAPA</title>  <title>The LearningOnline Network with CAPA</title>
 BEGINNING  
     $r->print(<<RESULTS);  
 </head>  </head>
 <body bgcolor="#ffffff">  <body bgcolor="#ffffff">
 <img align='right' src='/adm/lonIcons/lonlogos.gif' />  <img align='right' src='/adm/lonIcons/lonlogos.gif' />
Line 1459  $message Line 1733  $message
 RESULTS  RESULTS
 }  }
   
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item &start_fresh_session()
   
   Cleans the global %hash by removing all fields which begin with
   'pre_' or 'store'.
   
   =cut
   
   ######################################################################
   ######################################################################
   sub start_fresh_session {
       delete $hash{'mode_catalog'};
       foreach (keys %hash) {
           if ($_ =~ /^pre_/) {
               delete $hash{$_};
           }
           if ($_ =~ /^store/) {
       delete $hash{$_};
    }
       }
   }
   
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item &popwin_js() send javascript to popwin
   
   =cut
   
   ######################################################################
   ######################################################################
   sub popwin_js {
       # Print javascript out to popwin, but make sure we dont generate
       # any javascript errors in doing so.
       my ($r,$text) = @_;
       $r->print(<<"END");
   <script type="text/javascript">
       if (! popwin.closed) {
    $text
       }
   </script>
   END
       $r->rflush();
   }
   
   ######################################################################
   ######################################################################
   
   =pod 
   
   =item &popwin_imgupdate()
   
   =cut
   
   ######################################################################
   ######################################################################
   sub popwin_imgupdate {
       my ($r,$imgnum,$icon) = @_;
       &popwin_js($r,'popwin.document.img'.$imgnum.'.'.
          'src="/adm/lonIcons/'.$icon.'";');
   }    
   
 1;  1;
   
 __END__  __END__
   
   =pod
   
   =back 
   
   =over 4
   
   =head1 HANDLER SUBROUTINE
   
   This routine is called by Apache and mod_perl.
   
   =over 4
   
   =item *
   
   configure dynamic components of interface
   
   =item *
   
   determine current user
   
   =item *
   
   see if a search invocation should be done
   
   =item *
   
   else, begin building search interface to output
   
   =item *
   
   compute date selection boxes
   
   =item *
   
   compute customized metadata field
   
   =item *
   
   print screen
   
   =back
   
   =head1 OTHER SUBROUTINES
   
   =over 4
   
   =item *
   
   get_unprocessed_cgi() : reads in critical name/value pairs that may have not
   been processed and passed into %ENV by the web server
   
   =item *
   
   make_persistent() : makes a set of hidden HTML fields to make
   SQL search interface information to be persistent
   
   =back
   
   WEB INTERFACE COMPONENT FUNCTIONS
   
   =over 4
   
   =item *
   
   simpletextfield(name,value) : returns HTML formatted string for simple text
   field
   
   =item *
   
   simplecheckbox(name,value) : returns HTML formatted string for simple
   checkbox
   
   =item *
   
   searchphrasefield(title,name,value) : returns HTML formatted string for
   a search expression phrase field
   
   =item *
   
   dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML
   formatted string for a calendar date
   
   =item *
   
   selectbox(title,name,value,%HASH=options) : returns HTML formatted string for
   a selection box field
   
   =back
   
   SEARCH FUNCTIONS
   
   =over 4
   
   =item *
   
   advancedsearch(server reference, environment reference) : perform a complex
   multi-field logical query
   
   =item *
   
   basicsearch(server reference, environment reference) : perform a simple
   single-field logical query
   
   =item *
   
   build_SQL_query(field name, logic) : builds a SQL query string from a
   logical expression with AND/OR keywords
   
   =item *
   
   build_custommetadata_query(field_name, logic_statement) : builds a perl
   regular expression from a logical expression with AND/OR keywords
   
   =item *
   
   recursive_SQL_query_build(field name, reverse notation expression) : 
   builds a SQL query string from a reverse notation expression
   logical expression with AND/OR keywords
   
   =item *
   
   build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2,
   lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) :
   Builds a SQL logic query to check time/date entries.
   
   =back
   
   OUTPUTTING RESULTS FUNCTION
   
   =over 4
   
   =item *
   
   output_results(output mode, server reference, environment reference,
   reply list reference) : outputs results from search
   
   =back
   
   DIFFERENT WAYS TO VIEW METADATA RECORDS
   
   =over 4
   
   =item *
   
   detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   see metadata viewing notes below 
   
   =item *
   
   summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   see metadata viewing notes below 
   
   =item *
   
   fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   see metadata viewing notes below 
   
   =item *
   
   xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   see metadata viewing notes below 
   
   =back
   
     _____________________________________________________________________
    | * Metadata viewing notes                                            |
    | Output is a HTML-ified string.                                      |
    | Input arguments are title, author, subject, url, keywords, version, |
    | notes, short abstract, mime, language, creation date,               |
    | last revision date, owner, copyright, hostname, httphost, and       |
    | extra custom metadata to show.                                      |
     ---------------------------------------------------------------------
   
   TEST CONDITIONAL FUNCTIONS
   
   =over 4
   
   =item *
   
   filled(field) : determines whether a given field has been filled
   
   =back
   
   ERROR FUNCTIONS
   
   =over 4
   
   =item *
   
   output_blank_field_error(server reference) : outputs a message saying that
   more fields need to be filled in
   
   =item *
   
   output_date_error(server reference, error message) : 
   
   
   =back
   
   =cut
Removed from v.1.98  
changed lines
  Added in v.1.123

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