File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.100: download - view: text, annotated - select for diffs
Tue Aug 28 12:12:38 2001 UTC (22 years, 9 months ago) by harris41
Branches: MAIN
CVS tags: HEAD
debugging and improving interface

    1: # The LearningOnline Network with CAPA
    2: #
    3: # Search Catalog
    4: #
    5: # YEAR=2001
    6: # 03/08/2001 Scott Harrison
    7: # Scott Harrison: 03/12/2001, 03/13/2001, 03/14/2001, 03/15/2001, 03/19/2001
    8: # Scott Harrison: 03/20/2001, 03/21/2001, 03/22/2001, 03/26/2001, 03/27/2001
    9: # Scott Harrison: 04/02/2001, 08/15/2001, 08/24/2001, 08/25/2001
   10: 
   11: ###############################################################################
   12: ##                                                                           ##
   13: ## ORGANIZATION OF THIS PERL MODULE                                          ##
   14: ##                                                                           ##
   15: ## 1. Description of functions                                               ##
   16: ## 2. Modules used by this module                                            ##
   17: ## 3. Choices for different output views (detailed, summary, xml, etc)       ##
   18: ## 4. BEGIN block (to be run once after compilation)                         ##
   19: ## 5. Handling routine called via Apache and mod_perl                        ##
   20: ## 6. Other subroutines                                                      ##
   21: ##                                                                           ##
   22: ###############################################################################
   23: 
   24: # ---------------------------------------------------- Description of functions
   25: #
   26: #
   27: # === WEB HANDLER FUNCTIONS
   28: # BEGIN() : run once after compilation to initialize values
   29: # handler(server reference) : interacts with the Apache server layer
   30: #                             (for /adm/searchcat URLs)
   31: # get_unprocessed_cgi() : reads in critical name/value pairs that may have not
   32: #                         been processed and passed into %ENV by the web server
   33: # make_persistent() : makes a set of hidden HTML fields to make
   34: #                     SQL search interface information to be persistent
   35: #
   36: #
   37: # === WEB INTERFACE COMPONENT FUNCTIONS
   38: # simpletextfield(name,value) : returns HTML formatted string for simple text
   39: #                               field
   40: # simplecheckbox(name,value) : returns HTML formatted string for simple
   41: #                              checkbox
   42: # searchphrasefield(title,name,value) : returns HTML formatted string for
   43: #                                       a search expression phrase field
   44: # dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML
   45: #                                                          formatted string
   46: #                                                          for a calendar date
   47: # selectbox(title,name,value,%HASH=options) : returns HTML formatted string for
   48: #                                             a selection box field
   49: #
   50: #
   51: # === SEARCH FUNCTIONS
   52: # advancedsearch(server reference, environment reference) : perform a complex
   53: #                                  multi-field logical query
   54: # basicsearch(server reference, environment reference) : perform a simple
   55: #                               single-field logical query
   56: # build_SQL_query(field name, logic) : builds a SQL query string from a
   57: #                                      logical expression with AND/OR keywords
   58: # build_custommetadata_query(field_name, logic_statement) : builds a perl
   59: #                 regular expression from a logical expression with AND/OR
   60: #                 keywords
   61: # recursive_SQL_query_build(field name, reverse notation expression) : 
   62: #                 builds a SQL query string from a reverse notation expression
   63: #                 logical expression with AND/OR keywords
   64: # build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2,
   65: #                    lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) :
   66: #                 Builds a SQL logic query to check time/date entries.
   67: #
   68: #
   69: # === OUTPUTTING RESULTS FUNCTION
   70: # output_results(output mode,
   71: #                server reference, 
   72: #                environment reference,
   73: #                reply list reference) : outputs results from search
   74: #
   75: #
   76: # === DIFFERENT WAYS TO VIEW METADATA RECORDS
   77: # detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   78: #          see metadata viewing notes below 
   79: # summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   80: #          see metadata viewing notes below 
   81: # fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   82: #          see metadata viewing notes below 
   83: # xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) :
   84: #          see metadata viewing notes below 
   85: #  ___________________________________________________________________________
   86: # | * Metadata viewing notes                                                  |
   87: # | Output is a HTML-ified string.                                            |
   88: # | Input arguments are title, author, subject, url, keywords, version, notes,|
   89: # | short abstract, mime, language, creation date, last revision date, owner, |
   90: # | copyright, hostname, httphost, and extra custom metadata to show.         |
   91: #  ---------------------------------------------------------------------------
   92: #
   93: #
   94: # === TEST CONDITIONAL FUNCTIONS
   95: # filled(field) : determines whether a given field has been filled
   96: #
   97: #
   98: # === ERROR FUNCTIONS
   99: # output_blank_field_error(server reference) : outputs a message saying that
  100: #                                              more fields need to be filled in
  101: # output_date_error(server reference, error message) : outputs
  102: #         an error message specific to bad date format.
  103: 
  104: package Apache::lonsearchcat;
  105: 
  106: # ------------------------------------------------- modules used by this module
  107: use strict;
  108: use Apache::Constants qw(:common);
  109: use Apache::lonnet();
  110: use Apache::File();
  111: use CGI qw(:standard);
  112: use Text::Query;
  113: 
  114: # ---------------------------------------- variables used throughout the module
  115: 
  116: # -- information holders
  117: my %language; # holds contents of language.tab
  118: my %cprtag; # holds contents of copyright.tab
  119: my %mimetag; # holds contents of filetypes.tab
  120: my %hostdomains; # matches host name to host domain
  121: my %hostips; # matches host name to host ip
  122: my %hitcount; # stores number of hits per host
  123: 
  124: # -- dynamically rendered interface components
  125: my $closebutton; # button that closes the search window
  126: my $importbutton; # button to take the selected results and go to group sorting
  127: 
  128: # -- miscellaneous variables
  129: my $scrout; # string that holds portions of the screen output
  130: my $fnum; # search result counter
  131: my $yourself; # allows for quickly limiting to oneself
  132: 
  133: # ------------------------------------------ choices for different output views
  134: # Detailed Citation View ---> sub detailed_citation_view
  135: # Summary View ---> sub summary_view
  136: # Fielded Format ---> sub fielded_format_view
  137: # XML/SGML ---> sub xml_sgml_view
  138: my $basicviewselect=<<END;
  139: <select name='basicviewselect'>
  140: <option value='Detailed Citation View'>Detailed Citation View</option>
  141: <option value='Summary View'>Summary View</option>
  142: <option value='Fielded Format'>Fielded Format</option>
  143: <option value='XML/SGML'>XML/SGML</option>
  144: </select>
  145: END
  146: my $advancedviewselect=<<END;
  147: <select name='advancedviewselect'>
  148: <option value='Detailed Citation View'>Detailed Citation View</option>
  149: <option value='Summary View'>Summary View</option>
  150: <option value='Fielded Format'>Fielded Format</option>
  151: <option value='XML/SGML'>XML/SGML</option>
  152: </select>
  153: END
  154: 
  155: # ----------------------------------------------------------------------- BEGIN
  156: sub BEGIN {
  157: # --------------------------------- Compute various listings of metadata values
  158:     $language{'any'}='Any language';
  159:     {
  160: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
  161: 				 '/language.tab');
  162: 	map {
  163: 	    $_=~/(\w+)\s+([\w\s\-]+)/; chomp;
  164: 	    $language{$1}=$2;
  165: 	} <$fh>;
  166:     }
  167:     $cprtag{'any'}='Any copyright/distribution';
  168:     {
  169: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
  170: 				 '/copyright.tab');
  171: 	map {
  172: 	    $_=~/(\w+)\s+([\w\s\-]+)/; chomp;
  173: 	    $cprtag{$1}=$2;
  174: 	} <$fh>;
  175:     }
  176:     $mimetag{'any'}='Any type';
  177:     {
  178: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
  179: 				 '/filetypes.tab');
  180: 	map {
  181: 	    $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/; chomp;
  182: 	    $mimetag{$1}=".$1 $3";
  183: 	} <$fh>;
  184:     }
  185:     {
  186: 	my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
  187: 				 '/hosts.tab');
  188: 	map {
  189: 	    $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp;
  190: 	    if ($3 eq 'library') {
  191: 		$hostdomains{$1}=$2;
  192: 		$hostips{$1}=$4;
  193: 	    }
  194: 	} <$fh>;
  195:     }
  196: }
  197: 
  198: # ----------------------------- Handling routine called via Apache and mod_perl
  199: sub handler {
  200:     my $r = shift;
  201: 
  202:     &get_unprocessed_cgi();
  203: 
  204:     $r->content_type('text/html');
  205:     $r->send_http_header;
  206:     return OK if $r->header_only;
  207: 
  208: # ----------------------------------- configure dynamic components of interface
  209:     my $hidden='';
  210:     if ($ENV{'form.catalogmode'} eq 'interactive') {
  211: 	$hidden="<input type='hidden' name='catalogmode' value='interactive'>".
  212: 	    "\n";
  213:         $closebutton="<input type='button' name='close' value='CLOSE' ".
  214: 	    "onClick='self.close()'>"."\n";
  215:     }
  216:     elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
  217: 	$hidden=<<END;
  218: <input type='hidden' name='catalogmode' value='groupsearch'>
  219: END
  220:         $closebutton=<<END;
  221: <input type='button' name='close' value='CLOSE' onClick='self.close()'>
  222: END
  223:         $importbutton=<<END;
  224: <input type='button' name='import' value='IMPORT'
  225: onClick='javascript:select_group()'>
  226: END
  227:     }
  228: 
  229: # ------------------------------------------------------ Determine current user
  230:     $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
  231: 
  232: # --- Now, depending on the interface actions, do one of three things here:
  233: # --- 1. a basic search
  234: # --- 2. an advanced search
  235: # --- 3. output a search interface
  236: 
  237: # ----------------------------------- See if a search invocation should be done
  238:     if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
  239: 	return &basicsearch($r,\%ENV);
  240:     }
  241:     elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
  242: 	return &advancedsearch($r,\%ENV);
  243:     }
  244: 
  245: # ----------------------------- Else, begin building search interface to output
  246:     $scrout=''; # building a part of screen output
  247:     $scrout.=&searchphrasefield('Limit by title','title',
  248: 			$ENV{'form.title'});
  249: 
  250:     $scrout.=&searchphrasefield('Limit by author','author',
  251: 			$ENV{'form.author'});
  252: 
  253:     $scrout.=&searchphrasefield('Limit by subject','subject',
  254: 			$ENV{'form.subject'});
  255: 
  256:     $scrout.=&searchphrasefield('Limit by keywords','keywords',
  257: 			$ENV{'form.keywords'});
  258: 
  259:     $scrout.=&searchphrasefield('Limit by URL','url',
  260: 			$ENV{'form.url'});
  261: 
  262: #    $scrout.=&searchphrasefield('Limit by version','version',
  263: #			$ENV{'form.version'});
  264: 
  265:     $scrout.=&searchphrasefield('Limit by notes','notes',
  266: 			$ENV{'form.notes'});
  267: 
  268:     $scrout.=&searchphrasefield('Limit by abstract','abstract',
  269: 			$ENV{'form.abstract'});
  270: 
  271:     $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'});
  272:     $scrout.=&selectbox('Limit by MIME type','mime',
  273: 			$ENV{'form.mime'},%mimetag);
  274: 
  275:     $ENV{'form.language'}='any' unless length($ENV{'form.language'});
  276: 
  277:     $scrout.=&selectbox('Limit by language','language',
  278: 			$ENV{'form.language'},%language);
  279:     
  280: 
  281: # ------------------------------------------------ Compute date selection boxes
  282:     $scrout.=<<CREATIONDATESTART;
  283: <p>
  284: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
  285: </font>
  286: <br />
  287: between:
  288: CREATIONDATESTART
  289:     $scrout.=&dateboxes('creationdatestart',1,1,1976,
  290: 			$ENV{'form.creationdatestart_month'},
  291: 			$ENV{'form.creationdatestart_day'},
  292: 			$ENV{'form.creationdatestart_year'},
  293: 			);
  294:     $scrout.=<<CREATIONDATEEND;
  295: and:
  296: CREATIONDATEEND
  297:     $scrout.=&dateboxes('creationdateend',12,31,2051,
  298: 			$ENV{'form.creationdateend_month'},
  299: 			$ENV{'form.creationdateend_day'},
  300: 			$ENV{'form.creationdateend_year'},
  301: 			);
  302:     $scrout.="</p>";
  303: 
  304:     $scrout.=<<LASTREVISIONDATESTART;
  305: <p>
  306: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
  307: </b></font>
  308: <br />between:
  309: LASTREVISIONDATESTART
  310:     $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
  311: 			$ENV{'form.lastrevisiondatestart_month'},
  312: 			$ENV{'form.lastrevisiondatestart_day'},
  313: 			$ENV{'form.lastrevisiondatestart_year'},
  314: 			);
  315:     $scrout.=<<LASTREVISIONDATEEND;
  316: and:
  317: LASTREVISIONDATEEND
  318:     $scrout.=&dateboxes('lastrevisiondateend',12,31,2051,
  319: 			$ENV{'form.lastrevisiondateend_month'},
  320: 			$ENV{'form.lastrevisiondateend_day'},
  321: 			$ENV{'form.lastrevisiondateend_year'},
  322: 			);
  323:     $scrout.='</p>';
  324: 
  325:     $scrout.=&searchphrasefield('Limit by publisher/owner','owner',
  326: 				$ENV{'form.owner'});
  327: 
  328:     $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
  329:     $scrout.=&selectbox('Limit by copyright/distribution','copyright',
  330: 			$ENV{'form.copyright'},%cprtag);
  331: 
  332: # ------------------------------------------- Compute customized metadata field
  333:     $scrout.=<<CUSTOMMETADATA;
  334: <p>
  335: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
  336: </font>
  337: For resource-specific metadata, enter in an expression in the form of 
  338: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
  339: <b>Example:</b> grandmother=75 OR grandfather=85
  340: <br />
  341: CUSTOMMETADATA
  342: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
  343: $scrout.=' <i>initial users of this system do not need to worry about this option</i>';
  344: 
  345:     $scrout.=<<CUSTOMSHOW;
  346: <p>
  347: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b>
  348: </font>
  349: Enter in a space-separated list of special metadata fields to show
  350: in a fielded listing for each record result.
  351: <br />
  352: CUSTOMSHOW
  353: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'});
  354: $scrout.=' <i>initial users of this system do not need to worry about this option</i>';
  355: 
  356: # ---------------------------------------------------------------- Print screen
  357:     $r->print(<<ENDDOCUMENT);
  358: <html>
  359: <head>
  360: <title>The LearningOnline Network with CAPA</title>
  361: <script type="text/javascript">
  362:     function openhelp(val) {
  363: 	openhelpwin=open('/adm/help/searchcat.html','helpscreen',
  364: 	     'scrollbars=1,width=400,height=300');
  365: 	openhelpwin.focus();
  366:     }
  367: </script>
  368: </head>
  369: <body bgcolor="#FFFFFF">
  370: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
  371: <h1>Search Catalog</h1>
  372: <form method="post" action="/adm/searchcat">
  373: $hidden
  374: <hr />
  375: <h3>Basic Search</h3>
  376: <p>
  377: Enter terms or phrases separated by search operators
  378: such as AND, OR, or NOT then press SEARCH below.  Terms should be specific
  379: to the title, author, subject, notes, or abstract information associated
  380: with a resource.
  381: <br />
  382: ENDDOCUMENT
  383:     $r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'}));
  384:     $r->print(' ');
  385:     $r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'}));
  386:     $r->print('<font color="#800000">Title only</font> ');
  387: #    $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'}));
  388: # <font color="#800000">Search historic archives</font>
  389:     $r->print(<<ENDDOCUMENT);
  390: <br />
  391: <input type="submit" name="basicsubmit" value='SEARCH' />
  392: <input type="reset" name="reset" value='RESET' />
  393: $closebutton
  394: $basicviewselect
  395: <input type="button" value="HELP" onClick="openhelp()" />
  396: </p>
  397: <hr />
  398: <h3>Advanced Search</h3>
  399: $scrout
  400: <p>
  401: <input type="submit" name="advancedsubmit" value='SEARCH' />
  402: <input type="reset" name="reset" value='RESET' />
  403: $closebutton
  404: $advancedviewselect
  405: <input type="button" value="HELP" onClick="openhelp()" />
  406: </p>
  407: </form>
  408: </body>
  409: </html>
  410: ENDDOCUMENT
  411:     return OK;
  412: } 
  413: 
  414: # ----------- grab unprocessed CGI variables that may have been appended to URL
  415: sub get_unprocessed_cgi {
  416:     map {
  417:        my ($name, $value) = split(/=/,$_);
  418:        $value =~ tr/+/ /;
  419:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
  420:        if ($name eq 'catalogmode') {
  421: 	   $ENV{'form.'.$name}=$value;
  422:        }
  423:     } (split(/&/,$ENV{'QUERY_STRING'}));
  424: }
  425: 
  426: # ------------------------------------------------------------- make persistent
  427: sub make_persistent {
  428:     my $persistent='';
  429:     
  430:     map {
  431: 	if (/^form\./ && !/submit/) {
  432: 	    my $name=$_;
  433: 	    my $key=$name;
  434: 	    $ENV{$key}=~s/\'//g; # do not mess with html field syntax
  435: 	    $name=~s/^form\.//;
  436: 	    $persistent.=<<END;
  437: <input type='hidden' name='$name' value='$ENV{$key}' />
  438: END
  439:         }
  440:     } (keys %ENV);
  441:     return $persistent;
  442: }
  443: 
  444: # --------------------------------------------------------- Various form fields
  445: 
  446: sub simpletextfield {
  447:     my ($name,$value)=@_;
  448:     return '<input type=text name=\''.$name.
  449: 	   '\' size=20 value=\''.$value.'\' />';
  450: }
  451: 
  452: sub simplecheckbox {
  453:     my ($name,$value)=@_;
  454:     my $checked='';
  455:     $checked="CHECKED" if $value eq 'on';
  456:     return '<input type=checkbox name=\''.$name.'\' '. $checked . '>';
  457: }
  458: 
  459: sub searchphrasefield {
  460:     my ($title,$name,$value)=@_;
  461:     my $instruction=<<END;
  462: Enter terms or phrases separated by search operators such
  463: as AND, OR, or NOT.
  464: END
  465:     my $uctitle=uc($title);
  466:     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>".
  467: 	   "</FONT> $instruction<br />".
  468:            '<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>';
  469: }
  470: 
  471: sub dateboxes {
  472:     my ($name,$defaultmonth,$defaultday,$defaultyear,
  473: 	$currentmonth,$currentday,$currentyear)=@_;
  474:     ($defaultmonth,$defaultday,$defaultyear)=('','','');
  475:     my $month=<<END;
  476: <select name="${name}_month">
  477: <option value='$defaultmonth'> </option>
  478: <option value="1">January</option>
  479: <option value="2">February</option>
  480: <option value="3">March</option>
  481: <option value="4">April</option>
  482: <option value="5">May</option>
  483: <option value="6">June</option>
  484: <option value="7">July</option>
  485: <option value="8">August</option>
  486: <option value="9">September</option>
  487: <option value="10">October</option>
  488: <option value="11">November</option>
  489: <option value="12">December</option>
  490: </select>
  491: END
  492:     $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
  493:     my $day=<<END;
  494: <select name="${name}_day">
  495: <option value='$defaultday'> </option>
  496: <option value="1">1</option>
  497: <option value="2">2</option>
  498: <option value="3">3</option>
  499: <option value="4">4</option>
  500: <option value="5">5</option>
  501: <option value="6">6</option>
  502: <option value="7">7</option>
  503: <option value="8">8</option>
  504: <option value="9">9</option>
  505: <option value="10">10</option>
  506: <option value="11">11</option>
  507: <option value="12">12</option>
  508: <option value="13">13</option>
  509: <option value="14">14</option>
  510: <option value="15">15</option>
  511: <option value="16">16</option>
  512: <option value="17">17</option>
  513: <option value="18">18</option>
  514: <option value="19">19</option>
  515: <option value="20">20</option>
  516: <option value="21">21</option>
  517: <option value="22">22</option>
  518: <option value="23">23</option>
  519: <option value="24">24</option>
  520: <option value="25">25</option>
  521: <option value="26">26</option>
  522: <option value="27">27</option>
  523: <option value="28">28</option>
  524: <option value="29">29</option>
  525: <option value="30">30</option>
  526: <option value="31">31</option>
  527: </select>
  528: END
  529:     $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
  530:     my $year=<<END;
  531: <select name="${name}_year">
  532: <option value='$defaultyear'> </option>
  533: <option value="1976">1976</option>
  534: <option value="1977">1977</option>
  535: <option value="1978">1978</option>
  536: <option value="1979">1979</option>
  537: <option value="1980">1980</option>
  538: <option value="1981">1981</option>
  539: <option value="1982">1982</option>
  540: <option value="1983">1983</option>
  541: <option value="1984">1984</option>
  542: <option value="1985">1985</option>
  543: <option value="1986">1986</option>
  544: <option value="1987">1987</option>
  545: <option value="1988">1988</option>
  546: <option value="1989">1989</option>
  547: <option value="1990">1990</option>
  548: <option value="1991">1991</option>
  549: <option value="1992">1992</option>
  550: <option value="1993">1993</option>
  551: <option value="1994">1994</option>
  552: <option value="1995">1995</option>
  553: <option value="1996">1996</option>
  554: <option value="1997">1997</option>
  555: <option value="1998">1998</option>
  556: <option value="1999">1999</option>
  557: <option value="2000">2000</option>
  558: <option value="2001">2001</option>
  559: <option value="2002">2002</option>
  560: <option value="2003">2003</option>
  561: <option value="2004">2004</option>
  562: <option value="2005">2005</option>
  563: <option value="2006">2006</option>
  564: <option value="2007">2007</option>
  565: <option value="2008">2008</option>
  566: <option value="2009">2009</option>
  567: <option value="2010">2010</option>
  568: <option value="2011">2011</option>
  569: <option value="2012">2012</option>
  570: <option value="2013">2013</option>
  571: <option value="2014">2014</option>
  572: <option value="2015">2015</option>
  573: <option value="2016">2016</option>
  574: <option value="2017">2017</option>
  575: <option value="2018">2018</option>
  576: <option value="2019">2019</option>
  577: <option value="2020">2020</option>
  578: <option value="2021">2021</option>
  579: <option value="2022">2022</option>
  580: <option value="2023">2023</option>
  581: <option value="2024">2024</option>
  582: <option value="2025">2025</option>
  583: <option value="2026">2026</option>
  584: <option value="2027">2027</option>
  585: <option value="2028">2028</option>
  586: <option value="2029">2029</option>
  587: <option value="2030">2030</option>
  588: <option value="2031">2031</option>
  589: <option value="2032">2032</option>
  590: <option value="2033">2033</option>
  591: <option value="2034">2034</option>
  592: <option value="2035">2035</option>
  593: <option value="2036">2036</option>
  594: <option value="2037">2037</option>
  595: <option value="2038">2038</option>
  596: <option value="2039">2039</option>
  597: <option value="2040">2040</option>
  598: <option value="2041">2041</option>
  599: <option value="2042">2042</option>
  600: <option value="2043">2043</option>
  601: <option value="2044">2044</option>
  602: <option value="2045">2045</option>
  603: <option value="2046">2046</option>
  604: <option value="2047">2047</option>
  605: <option value="2048">2048</option>
  606: <option value="2049">2049</option>
  607: <option value="2050">2050</option>
  608: <option value="2051">2051</option>
  609: </select>
  610: END
  611:     $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
  612:     return "$month$day$year";
  613: }
  614: 
  615: sub selectbox {
  616:     my ($title,$name,$value,%options)=@_;
  617:     my $uctitle=uc($title);
  618:     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
  619: 	"</b></font><br />".'<select name="'.$name.'">';
  620:     map {
  621:         $selout.='<option value=\''.$_.'\'';
  622:         if ($_ eq $value) { $selout.=' selected'; }
  623:         $selout.='>'.$options{$_}.'</option>';
  624:     } sort keys %options;
  625:     return $selout.'</select>';
  626: }
  627: 
  628: # ----------------------------------------------- Performing an advanced search
  629: sub advancedsearch {
  630:     my ($r,$envhash)=@_;
  631:     my %ENV=%{$envhash};
  632: 
  633:     my $fillflag=0;
  634:     # Clean up fields for safety
  635:     for my $field ('title','author','subject','keywords','url','version',
  636: 		   'creationdatestart_month','creationdatestart_day',
  637: 		   'creationdatestart_year','creationdateend_month',
  638: 		   'creationdateend_day','creationdateend_year',
  639: 		   'lastrevisiondatestart_month','lastrevisiondatestart_day',
  640: 		   'lastrevisiondatestart_year','lastrevisiondateend_month',
  641: 		   'lastrevisiondateend_day','lastrevisiondateend_year',
  642: 		   'notes','abstract','mime','language','owner',
  643: 		   'custommetadata','customshow') {
  644: 	$ENV{"form.$field"}=~s/[^\w\s\(\)\=\-\"\']//g;
  645:     }
  646: 
  647:     # Check to see if enough information was filled in
  648:     for my $field ('title','author','subject','keywords','url','version',
  649: 		   'notes','abstract','mime','language','owner',
  650: 		   'custommetadata') {
  651: 	if (&filled($ENV{"form.$field"})) {
  652: 	    $fillflag++;
  653: 	}
  654:     }
  655:     unless ($fillflag) {
  656: 	&output_blank_field_error($r);
  657: 	return OK;
  658:     }
  659: 
  660: 
  661:     # Turn the form input into a SQL-based query
  662:     my $query='';
  663: 
  664:     my @queries;
  665:     # Evaluate logical expression AND/OR/NOT phrase fields.
  666:     foreach my $field ('title','author','subject','notes','abstract','url',
  667: 		       'keywords','version','owner') {
  668: 	if ($ENV{'form.'.$field}) {
  669: 	    push @queries,&build_SQL_query($field,$ENV{'form.'.$field});
  670: 	}
  671:     }
  672:     # Evaluate option lists
  673:     if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
  674: 	push @queries,"(language like \"$ENV{'form.language'}\")";
  675:     }
  676:     if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') {
  677: 	push @queries,"(mime like \"$ENV{'form.mime'}\")";
  678:     }
  679:     if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
  680: 	push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
  681:     }
  682:     # Evaluate date windows
  683:     my $datequery=&build_date_queries(
  684: 			$ENV{'form.creationdatestart_month'},
  685: 			$ENV{'form.creationdatestart_day'},
  686: 			$ENV{'form.creationdatestart_year'},
  687: 			$ENV{'form.creationdateend_month'},
  688: 			$ENV{'form.creationdateend_day'},
  689: 			$ENV{'form.creationdateend_year'},
  690: 			$ENV{'form.lastrevisiondatestart_month'},
  691: 			$ENV{'form.lastrevisiondatestart_day'},
  692: 			$ENV{'form.lastrevisiondatestart_year'},
  693: 			$ENV{'form.lastrevisiondateend_month'},
  694: 			$ENV{'form.lastrevisiondateend_day'},
  695: 			$ENV{'form.lastrevisiondateend_year'},
  696: 			);
  697:     # Test to see if date windows are legitimate
  698:     if ($datequery=~/^Incorrect/) {
  699: 	&output_date_error($r,$datequery);
  700: 	return OK;
  701:     }
  702:     elsif ($datequery) {
  703: 	push @queries,$datequery;
  704:     }
  705: 
  706:     # Process form information for custom metadata querying
  707:     my $customquery='';
  708:     if ($ENV{'form.custommetadata'}) {
  709: 	$customquery=&build_custommetadata_query('custommetadata',
  710: 				      $ENV{'form.custommetadata'});
  711:     }
  712:     my $customshow='';
  713:     if ($ENV{'form.customshow'}) {
  714: 	$customshow=$ENV{'form.customshow'};
  715: 	$customshow=~s/[^\w\s]//g;
  716: 	my @fields=split(/\s+/,$customshow);
  717: 	$customshow=join(" ",@fields);
  718:     }
  719:     # Send query statements over the network to be processed by either the SQL
  720:     # database or a recursive scheme of 'grep'-like actions (for custom
  721:     # metadata).
  722:     if (@queries) {
  723: 	$query=join(" AND ",@queries);
  724: 	$query="select * from metadata where $query";
  725: 	my $reply; # reply hash reference
  726: 	unless ($customquery or $customshow) {
  727: 	    $reply=&Apache::lonnet::metadata_query($query);
  728: 	}
  729: 	else {
  730: 	    $reply=&Apache::lonnet::metadata_query($query,
  731: 						   $customquery,$customshow);
  732: 	}
  733: 	&output_results('Advanced',$r,$envhash,$customquery,$reply);
  734:     }
  735:     elsif ($customquery) {
  736: 	my $reply; # reply hash reference
  737: 	$reply=&Apache::lonnet::metadata_query('',
  738: 					       $customquery,$customshow);
  739: 	&output_results('Advanced',$r,$envhash,$customquery,$reply);
  740:     }
  741:     # should not get to this point
  742:     return 'Error.  Should not have gone to this point.';
  743: }
  744: 
  745: # --------------------------------------------------- Performing a basic search
  746: sub basicsearch {
  747:     my ($r,$envhash)=@_;
  748:     my %ENV=%{$envhash};
  749:     # Clean up fields for safety
  750:     for my $field ('basicexp') {
  751: 	$ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
  752:     }
  753: 
  754:     # Check to see if enough is filled in
  755:     unless (&filled($ENV{'form.basicexp'})) {
  756: 	&output_blank_field_error($r);
  757: 	return OK;
  758:     }
  759: 
  760:     # Build SQL query string based on form page
  761:     my $query='';
  762:     my $concatarg=join(',"    ",',
  763: 		       ('title', 'author', 'subject', 'notes', 'abstract'));
  764:     $concatarg='title' if $ENV{'form.titleonly'};
  765: 
  766:     $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
  767: 
  768:     # Get reply (either a hash reference to filehandles or bad connection)
  769:     my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query);
  770: 
  771:     # Output search results
  772: 
  773:     &output_results('Basic',$r,$envhash,$query,$reply);
  774: 
  775:     return OK;
  776: }
  777: 
  778: # ------------------------------------------------------------- build_SQL_query
  779: sub build_SQL_query {
  780:     my ($field_name,$logic_statement)=@_;
  781:     my $q=new Text::Query('abc',
  782: 			  -parse => 'Text::Query::ParseAdvanced',
  783: 			  -build => 'Text::Query::Build');
  784:     $q->prepare($logic_statement);
  785:     my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
  786:     my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
  787:     return $sql_query;
  788: }
  789: 
  790: # ------------------------------------------------- build custom metadata query
  791: sub build_custommetadata_query {
  792:     my ($field_name,$logic_statement)=@_;
  793:     my $q=new Text::Query('abc',
  794: 			  -parse => 'Text::Query::ParseAdvanced',
  795: 			  -build => 'Text::Query::BuildAdvancedString');
  796:     $q->prepare($logic_statement);
  797:     my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
  798:     # quick fix to change literal into xml tag-matching
  799:     # will eventually have to write a separate builder module
  800:     my $oldmatchexp=$matchexp;
  801:     $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g;
  802:     return $matchexp;
  803: }
  804: 
  805: # - Recursively parse a reverse notation expression into a SQL query expression
  806: sub recursive_SQL_query_build {
  807:     my ($dkey,$pattern)=@_;
  808:     my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
  809:     return $pattern unless @matches;
  810:     foreach my $match (@matches) {
  811: 	$match=~/\[ (\w+)\s(.*) \]/;
  812: 	my ($key,$value)=($1,$2);
  813: 	my $replacement='';
  814: 	if ($key eq 'literal') {
  815: 	    $replacement="($dkey like \"\%$value\%\")";
  816: 	}
  817: 	elsif ($key eq 'not') {
  818: 	    $value=~s/like/not like/;
  819: #	    $replacement="($dkey not like $value)";
  820: 	    $replacement="$value";
  821: 	}
  822: 	elsif ($key eq 'and') {
  823: 	    $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
  824: 	    $replacement="($1 AND $2)";
  825: 	}
  826: 	elsif ($key eq 'or') {
  827: 	    $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
  828: 	    $replacement="($1 OR $2)";
  829: 	}
  830: 	substr($pattern,
  831: 	       index($pattern,$match),
  832: 	       length($match),
  833: 	       $replacement
  834: 	       );
  835:     }
  836:     &recursive_SQL_query_build($dkey,$pattern);
  837: }
  838: 
  839: # ------------------------------------------------------------ Build date query
  840: sub build_date_queries {
  841:     my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
  842: 	$lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
  843:     my @queries;
  844:     if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) {
  845: 	unless ($cmonth1 and $cday1 and $cyear1 and
  846: 		$cmonth2 and $cday2 and $cyear2) {
  847: 	    return "Incorrect entry for the creation date.  You must specify ".
  848: 		   "a starting month, day, and year and an ending month, ".
  849: 		   "day, and year.";
  850: 	}
  851: 	my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1);
  852: 	$cnumeric1+=0;
  853: 	my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2);
  854: 	$cnumeric2+=0;
  855: 	if ($cnumeric1>$cnumeric2) {
  856: 	    return "Incorrect entry for the creation date.  The starting ".
  857: 		   "date must occur before the ending date.";
  858: 	}
  859: 	my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '".
  860: 	           "$cyear2-$cmonth2-$cday2 23:59:59')";
  861: 	push @queries,$cquery;
  862:     }
  863:     if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) {
  864: 	unless ($lmonth1 and $lday1 and $lyear1 and
  865: 		$lmonth2 and $lday2 and $lyear2) {
  866: 	    return "Incorrect entry for the last revision date.  You must ".
  867: 		   "specify a starting month, day, and year and an ending ".
  868: 		   "month, day, and year.";
  869: 	}
  870: 	my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1);
  871: 	$lnumeric1+=0;
  872: 	my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2);
  873: 	$lnumeric2+=0;
  874: 	if ($lnumeric1>$lnumeric2) {
  875: 	    return "Incorrect entry for the last revision date.  The ".
  876: 		   "starting date must occur before the ending date.";
  877: 	}
  878: 	my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '".
  879: 	           "$lyear2-$lmonth2-$lday2 23:59:59')";
  880: 	push @queries,$lquery;
  881:     }
  882:     if (@queries) {
  883: 	return join(" AND ",@queries);
  884:     }
  885:     return '';
  886: }
  887: 
  888: # ----------------------------- format and output results based on a reply list
  889: # There are two windows that this function writes to.  The main search
  890: # window ("srch") has a listing of the results.  A secondary window ("popwin")
  891: # gives the status of the network search (time elapsed, number of machines
  892: # contacted, etc.)
  893: sub output_results {
  894:     my ($mode,$r,$envhash,$query,$replyref)=@_;
  895:     my %ENV=%{$envhash};
  896:     my %rhash=%{$replyref};
  897:     my $compiledresult='';
  898:     my $timeremain=30;
  899:     my $elapsetime=0;
  900:     my $resultflag=0;
  901:     my $tflag=1;
  902: 
  903:     # make query information persistent to allow for subsequent revision
  904:     my $persistent=&make_persistent();
  905: 
  906:     # output beginning of search page
  907: 	$r->print(<<BEGINNING);
  908: <html>
  909: <head>
  910: <title>The LearningOnline Network with CAPA</title>
  911: BEGINNING
  912: 
  913:     # conditional output of script functions dependent on the mode in
  914:     # which the search was invoked
  915:         $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'interactive';
  916: <script type="text/javascript">
  917:     function select_data(title,url) {
  918: 	changeTitle(title);
  919: 	changeURL(url);
  920: 	self.close();
  921:     }
  922:     function changeTitle(val) {
  923: 	if (opener.inf.document.forms.resinfo.elements.t) {
  924: 	    opener.inf.document.forms.resinfo.elements.t.value=val;
  925: 	}
  926:     }
  927:     function changeURL(val) {
  928: 	if (opener.inf.document.forms.resinfo.elements.u) {
  929: 	    opener.inf.document.forms.resinfo.elements.u.value=val;
  930: 	}
  931:     }
  932: </script>
  933: SCRIPT
  934:         $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'groupsearch';
  935: <script type="text/javascript">
  936:     function select_data(title,url) {
  937: 	alert('DEBUG: Should be storing '+title+' and '+url);
  938:     }
  939:     function queue(val) {
  940: 	if (eval("document.forms."+val+".filelink.checked")) {
  941: 	    document.forms.results.acts.value+='1a'+val+'b';
  942: 	}
  943: 	else {
  944: 	    document.forms.results.acts.value+='0a'+val+'b';
  945: 	}
  946:     }
  947:     function select_group() {
  948: 	alert('DEBUG: Should be moving on to group sorting stage'+' acts');
  949:     }
  950: </script>
  951: SCRIPT
  952:         $r->print(<<SCRIPT);
  953: <script type="text/javascript">
  954:     function displayinfo(val) {
  955: 	popwin.document.forms.popremain.sdetails.value=val;
  956:     }
  957:     function openhelp(val) {
  958: 	openhelpwin=open('/adm/help/searchcat.html','helpscreen',
  959: 	     'scrollbars=1,width=400,height=300');
  960: 	openhelpwin.focus();
  961:     }
  962: </script>
  963: SCRIPT
  964:     $r->rflush();
  965: 
  966:     # begin showing the cataloged results
  967:     $r->print(<<CATALOGBEGIN);
  968: </head>
  969: <body bgcolor="#ffffff">
  970: <img align=right src=/adm/lonIcons/lonlogos.gif>
  971: <h1>Search Catalog</h1>
  972: CATALOGBEGIN
  973:         $r->print(<<CATALOGCONTROLS);
  974: <form name='results' method="post" action="/adm/searchcat">
  975: <input type='hidden' name='acts' value='' />
  976: <input type='button' value='Revise search request'
  977: onClick='this.form.submit();' />
  978: $importbutton
  979: $closebutton
  980: $persistent
  981: <hr />
  982: <h3>Search Query</h3>
  983: CATALOGCONTROLS
  984:     if ($mode eq 'Basic') {
  985: 	$r->print(<<RESULTS);
  986: <p>
  987: <b>Basic search:</b> $ENV{'form.basicexp'}
  988: </p>
  989: RESULTS
  990:     }
  991:     elsif ($mode eq 'Advanced') {
  992: 	$r->print(<<RESULTS);
  993: <p>
  994: <b>Advanced search</b>
  995: $query
  996: </p>
  997: RESULTS
  998:     }
  999:     $r->print('<h3>Search Results</h3>');
 1000:     $r->rflush();
 1001:     my $servernum=(keys %rhash)+0;
 1002: 
 1003:     # define server grid (shows status of multiple machines)
 1004:     my $hcinit;
 1005:     my $grid="'<br />'+";
 1006:     $grid.="\n";
 1007:     my $sn=1;
 1008:     for my $sk (sort keys %rhash) {
 1009: 	# '<a href="
 1010: 	$grid.="'<a href=\"";
 1011: 	# javascript:displayinfo('+
 1012: 	$grid.="javascript:opener.displayinfo('+";
 1013: 	# "'"+'key
 1014: 	$grid.="\"'\"+'";
 1015: 	$grid.=$sk;
 1016: 	my $hc;
 1017: 	if ($rhash{$sk} eq 'con_lost') {
 1018: 	    $hc="!!!BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR!!!";
 1019: 	}
 1020: 	else {
 1021: 	    $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'";
 1022: 	    $hcinit.="hc[\"$sk\"]=\"not yet connected...\";";
 1023: 	}
 1024: 	$grid.=" hitcount=".$hc;
 1025: 	$grid.=" domain=".$hostdomains{$sk};
 1026: 	$grid.=" IP=".$hostips{$sk};
 1027: 	# '+"'"+'">'+
 1028: 	$grid.="'+\"'\"+')\">'+";
 1029: 	$grid.="\n";
 1030: 	$grid.="'<img border=\"0\" name=\"img".$sn."\"".
 1031: 	    " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" /></a>'+\n";
 1032: 	$grid.="'<br />'+\n" unless $sn%10;
 1033:         $sn++;
 1034:     }
 1035: 	    $r->print(<<ENDPOP);
 1036: <script type="text/javascript">
 1037:     popwin=open('','popwin','scrollbars=1,width=400,height=200');
 1038:     popwin.focus();
 1039:     popwin.document.writeln('<'+'html>');
 1040:     popwin.document.writeln('<'+'head>');
 1041:     popwin.document.writeln('<'+'script>');
 1042:     popwin.document.writeln('hc=new Array();$hcinit');
 1043:     popwin.document.writeln('<'+'/script>');
 1044:     popwin.document.writeln('<'+'/head>'+
 1045:         '<'+'body bgcolor="#FFFFFF">'+
 1046: 	'<'+'image name="whirly" align="right" src="/adm/lonIcons/'+
 1047: 	'lonanim.gif" '+
 1048: 	'alt="animated logo" />'+
 1049: 	'<'+'h3>Search Results Progress<'+'/h3>'+
 1050:         '<'+'form name="popremain">'+
 1051:         '<'+'tt>'+
 1052: 	'<'+'br clear="all"/><i>PLEASE BE PATIENT</i>'+
 1053: 	'<'+'br />SCANNING $servernum SERVERS'+
 1054: 	'<'+'br clear="all" />Number of record hits found '+
 1055: 	'<'+'input type="text" size="10" name="numhits"'+
 1056: 	' value="0" />'+
 1057: 	'<'+'br clear="all" />Time elapsed '+
 1058: 	'<'+'input type="text" size="10" name="elapsetime"'+
 1059: 	' value="0" />'+
 1060: 	'<'+'br />'+
 1061: 	'SERVER GRID (click on any cell for details)'+
 1062:         $grid
 1063:         '<'+'br />'+
 1064: 	'Server details '+
 1065: 	'<'+'input type="text" size="25" name="sdetails"'+
 1066: 	' value="" />'+
 1067: 	'<'+'br />'+
 1068: 	' <'+'input type="button" name="button"'+
 1069: 	' value="abort search and view current results" '+
 1070: 	' />'+
 1071: 	' <'+'input type="button" name="button"'+
 1072: 	' value="help" onClick="javascript:opener.openhelp()" />'+
 1073: 	'<'+'/tt>'+
 1074:         '<'+'/form>'+
 1075:         '<'+'/body><'+'/html>');
 1076:     popwin.document.close();
 1077: </script>
 1078: ENDPOP
 1079:     $r->rflush();
 1080: 
 1081:     my $servercount=0;
 1082:     $sn=0;
 1083:     my $hitcountsum=0;
 1084:     foreach my $rkey (sort keys %rhash) {
 1085: 	$sn++;
 1086: 	$servercount++;
 1087: 	$tflag=1;
 1088: 	$compiledresult='';
 1089: 	my $hostname=$rkey;
 1090: 	my $reply=$rhash{$rkey};
 1091: 	my @results;
 1092: 	
 1093: 	my $replyfile='';
 1094: 
 1095: 	if ($reply eq 'con_lost') {
 1096: 	    $r->print('<script type="text/javascript">popwin.document.img'.
 1097: 		      $sn.'.'.
 1098: 		      'src="/adm/lonIcons/srvbad.gif";</script>'.
 1099: 		      "\n");
 1100: 	    $r->rflush();
 1101: 	}
 1102: 	else {
 1103: 	    $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting
 1104: 	    $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
 1105: 	    $reply=~/(.*?)\_/;
 1106: 	    {
 1107: 		my $temp=0;
 1108: 	      WLOOP: while (1) {
 1109: 		  if (-e $replyfile && $tflag) {
 1110: 		      $r->print('<script type="text/javascript">'.
 1111: 				'popwin.document.img'.$sn.'.'.
 1112: 				'src="/adm/lonIcons/srvhalf.gif";</script>'.
 1113: 				"\n");
 1114: 		      $r->rflush();
 1115: 		      $r->print('<script type="text/javascript">'.
 1116: 				'popwin.hc["'.$rkey.'"]='.
 1117: 				'"still transferring..."'.';</script>'.
 1118: 				"\n");
 1119: 		      $r->rflush();
 1120: 		      $tflag=0;
 1121: 		  }
 1122: 		  last WLOOP if $temp>5;
 1123: 		  if (-e "$replyfile.end") {
 1124: 		      if (-s $replyfile) {
 1125: 			  $r->print('<script type="text/javascript">'.
 1126: 				    'popwin.document.img'.$sn.'.'.
 1127: 				    'src="/adm/lonIcons/srvgood.gif";'.
 1128: 				    '</script>'."\n");
 1129: 			  $r->rflush();
 1130: 			  my $fh=Apache::File->new($replyfile) or 
 1131: 			      ($r->print('ERROR: file '.
 1132: 					 $replyfile.' cannot be opened') and
 1133: 			       return OK);
 1134: 			  @results=<$fh> if $fh;
 1135: 			  $hitcount{$rkey}=@results+0;
 1136: 			  $r->print('<script type="text/javascript">'.
 1137: 				    'popwin.hc["'.$rkey.'"]='.
 1138: 				    $hitcount{$rkey}.';</script>'.
 1139: 				    "\n");
 1140: 			  $r->rflush();
 1141: 			  $hitcountsum+=$hitcount{$rkey};
 1142: 			  $r->print('<script type="text/javascript">'.
 1143: 				    'popwin.document.forms.popremain.'.
 1144: 				    'numhits.value='.$hitcountsum.
 1145: 				    ';</script>'.
 1146: 				    "\n");
 1147: 			  $r->rflush();
 1148: 		      }
 1149: 		      else {
 1150: 			  $r->print('<script type="text/javascript">'.
 1151: 				    'popwin.document.img'.$sn.'.'.
 1152: 				    'src="/adm/lonIcons/srvempty.gif";'.
 1153: 				    '</script>'.
 1154: 				    "\n");
 1155: 			  $r->rflush();
 1156: 			  $r->print('<script type="text/javascript">'.
 1157: 				    'popwin.hc["'.$rkey.'"]=0'.
 1158: 				    ';</script>'.
 1159: 				    "\n");
 1160: 			  $r->rflush();
 1161: 		      }
 1162: 		      last WLOOP;
 1163: 		  }
 1164: 		  last WLOOP unless $timeremain;
 1165: 		  sleep 1;
 1166: 		  $timeremain--;
 1167: 		  $elapsetime++;
 1168: 		  $r->print('<script type="text/javascript">'.
 1169: 			    'popwin.document.popremain.elapsetime.'.
 1170: 			    'value="'.$elapsetime.'";</script>'."\n");
 1171: 		  $r->rflush();
 1172: 		  $temp++;
 1173: 	      }
 1174: 	    }
 1175: 	    $r->print('<script type="text/javascript">'.
 1176: 		      'popwin.document.whirly.'.
 1177: 		      'src="'.'/adm/lonIcons/lonanimend.gif'.
 1178: 		      '";</script>'."\n");
 1179: 	    $r->rflush();
 1180: 	}
 1181: 	my $customshow='';
 1182: 	my $extrashow='';
 1183: 	my @customfields;
 1184: 	if ($ENV{'form.customshow'}) {
 1185: 	    $customshow=$ENV{'form.customshow'};
 1186: 	    $customshow=~s/[^\w\s]//g;
 1187: 	    my @fields=map {"<font color=\"#008000\">$_:</font><!-- $_ -->"} 
 1188: 	    split(/\s+/,$customshow);
 1189: 	    @customfields=split(/\s+/,$customshow);
 1190: 	    if ($customshow) {
 1191: 		$extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
 1192: 	    }
 1193: 	}
 1194: 	my $customdata='';
 1195: 	my %customhash;
 1196: 	foreach my $result (@results) {
 1197: 	    if ($result=~/^(custom\=.*)$/) { # grab all custom metadata
 1198: 		my $tmp=$result;
 1199: 		$tmp=~s/^custom\=//;
 1200: 		my ($k,$v)=map {&Apache::lonnet::unescape($_);
 1201: 			    } split(/\,/,$tmp);
 1202: 		$customhash{$k}=$v;
 1203: 	    }
 1204: 	}
 1205: 	foreach my $result (@results) {
 1206: 	    next if $result=~/^custom\=/;
 1207: 	    chomp $result;
 1208: 	    next unless $result;
 1209: 	    my @fields=map
 1210: 	    {&Apache::lonnet::unescape($_)}
 1211: 	    (split(/\,/,$result));
 1212: 	    my ($title,$author,$subject,$url,$keywords,$version,
 1213: 		$notes,$abstract,$mime,$lang,
 1214: 		$creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
 1215: 	    my $shortabstract=$abstract;
 1216: 	    $shortabstract=substr($abstract,0,200) if length($abstract)>200;
 1217: 	    $fields[7]=$shortabstract;
 1218: 	    my $extrashow2=$extrashow;
 1219: 	    if ($extrashow) {
 1220: 		foreach my $field (@customfields) {
 1221: 		    my $value='';
 1222: 		    if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) {
 1223: 		        $value=$1;
 1224: 		    }
 1225: 	            $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g;
 1226: 	        }
 1227:             }
 1228: 	
 1229:             $compiledresult.=<<END if $compiledresult or $servercount!=$servernum;
 1230: <hr align='left' width='200' noshade />
 1231: END
 1232:             $compiledresult.=<<END;
 1233: <p>
 1234: END
 1235:             $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'interactive';
 1236: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
 1237: onClick="javascript:select_data('$title','$url')">
 1238: </font>
 1239: <br />
 1240: END
 1241:             $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'groupsearch';
 1242: <font size='-1'><input type="checkbox" name="returnvalues" value="SELECT"
 1243: onClick="javascript:queue($fnum)" />
 1244: </font>
 1245: <input type="hidden" name="title$fnum" value="$title" />
 1246: <input type="hidden" name="url$fnum" value="$url" />
 1247: <br />
 1248: END
 1249:             my $httphost=$ENV{'HTTP_HOST'};
 1250: 
 1251:             my $viewselect;
 1252:             if ($mode eq 'Basic') {
 1253: 		$viewselect=$ENV{'form.basicviewselect'};
 1254: 	    }
 1255:             elsif ($mode eq 'Advanced') {
 1256: 	        $viewselect=$ENV{'form.advancedviewselect'};
 1257:             }
 1258: 
 1259:             if ($viewselect eq 'Detailed Citation View') {
 1260: 	        $compiledresult.=&detailed_citation_view(@fields,
 1261: 						 $hostname,$httphost,
 1262: 						 $extrashow2);
 1263: 	    }
 1264:             elsif ($viewselect eq 'Summary View') {
 1265: 		$compiledresult.=&summary_view(@fields,$hostname,$httphost,
 1266: 				       $extrashow2);
 1267: 	    }
 1268:             elsif ($viewselect eq 'Fielded Format') {
 1269: 		$compiledresult.=&fielded_format_view(@fields,$hostname,
 1270: 					      $httphost,$extrashow2);
 1271: 	    }
 1272:             elsif ($viewselect eq 'XML/SGML') {
 1273: 		$compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost,
 1274: 					$extrashow2);
 1275: 	    }
 1276:     
 1277:         }
 1278: 
 1279: 	if ($compiledresult) {
 1280: 	    $resultflag=1;
 1281: 	}
 1282: 
 1283: 	$r->print(<<RESULTS);
 1284: $compiledresult
 1285: RESULTS
 1286:         my $percent=sprintf('%3.0f',($servercount/$servernum*100));
 1287:     }
 1288:     unless ($resultflag) {
 1289:         $r->print("\nThere were no results that matched your query\n");
 1290:     }
 1291: #    $r->print('<script type="text/javascript">'.'popwin.close()</script>'."\n"); $r->rflush(); 
 1292:     $r->print(<<RESULTS);
 1293: </body>
 1294: </html>
 1295: RESULTS
 1296: }
 1297: 
 1298: # ------------------------------------------------------ Detailed Citation View
 1299: sub detailed_citation_view {
 1300:     my ($title,$author,$subject,$url,$keywords,$version,
 1301: 	$notes,$shortabstract,$mime,$lang,
 1302: 	$creationdate,$lastrevisiondate,$owner,$copyright,
 1303: 	$hostname,$httphost,$extrashow)=@_;
 1304:     my $result=<<END;
 1305: <i>$owner</i>, last revised $lastrevisiondate
 1306: <h3><A HREF="http://$httphost$url" TARGET='search_preview'>$title</A></h3>
 1307: <h3>$author</h3>
 1308: </p>
 1309: <p>
 1310: <b>Subject:</b> $subject<br />
 1311: <b>Keyword(s):</b> $keywords<br />
 1312: <b>Notes:</b> $notes<br />
 1313: <b>MIME Type:</b> $mimetag{$mime}<br />
 1314: <b>Language:</b> $language{$lang}<br />
 1315: <b>Copyright/Distribution:</b> $cprtag{$copyright}<br />
 1316: </p>
 1317: $extrashow
 1318: <p>
 1319: $shortabstract
 1320: </p>
 1321: END
 1322:     return $result;
 1323: }
 1324: 
 1325: # ---------------------------------------------------------------- Summary View
 1326: sub summary_view {
 1327:     my ($title,$author,$subject,$url,$keywords,$version,
 1328: 	$notes,$shortabstract,$mime,$lang,
 1329: 	$creationdate,$lastrevisiondate,$owner,$copyright,
 1330: 	$hostname,$httphost,$extrashow)=@_;
 1331:     my $result=<<END;
 1332: <a href="http://$httphost$url" TARGET='search_preview'>$author</a><br />
 1333: $title<br />
 1334: $owner -- $lastrevisiondate<br />
 1335: $cprtag{$copyright}<br />
 1336: $extrashow
 1337: </p>
 1338: END
 1339:     return $result;
 1340: }
 1341: 
 1342: # -------------------------------------------------------------- Fielded Format
 1343: sub fielded_format_view {
 1344:     my ($title,$author,$subject,$url,$keywords,$version,
 1345: 	$notes,$shortabstract,$mime,$lang,
 1346: 	$creationdate,$lastrevisiondate,$owner,$copyright,
 1347: 	$hostname,$httphost,$extrashow)=@_;
 1348:     my $result=<<END;
 1349: <b>URL: </b> <A HREF="http://$httphost$url" TARGET='search_preview'>$url</A>
 1350: <br />
 1351: <b>Title:</b> $title<br />
 1352: <b>Author(s):</b> $author<br />
 1353: <b>Subject:</b> $subject<br />
 1354: <b>Keyword(s):</b> $keywords<br />
 1355: <b>Notes:</b> $notes<br />
 1356: <b>MIME Type:</b> $mimetag{$mime}<br />
 1357: <b>Language:</b> $language{$lang}<br />
 1358: <b>Creation Date:</b> $creationdate<br />
 1359: <b>Last Revision Date:</b> $lastrevisiondate<br />
 1360: <b>Publisher/Owner:</b> $owner<br />
 1361: <b>Copyright/Distribution:</b> $cprtag{$copyright}<br />
 1362: <b>Repository Location:</b> $hostname<br />
 1363: <b>Abstract:</b> $shortabstract<br />
 1364: $extrashow
 1365: </p>
 1366: END
 1367:     return $result;
 1368: }
 1369: 
 1370: # -------------------------------------------------------------------- XML/SGML
 1371: sub xml_sgml_view {
 1372:     my ($title,$author,$subject,$url,$keywords,$version,
 1373: 	$notes,$shortabstract,$mime,$lang,
 1374: 	$creationdate,$lastrevisiondate,$owner,$copyright,
 1375: 	$hostname,$httphost,$extrashow)=@_;
 1376:     my $result=<<END;
 1377: <pre>
 1378: &lt;LonCapaResource&gt;
 1379: &lt;url&gt;$url&lt;/url&gt;
 1380: &lt;title&gt;$title&lt;/title&gt;
 1381: &lt;author&gt;$author&lt;/author&gt;
 1382: &lt;subject&gt;$subject&lt;/subject&gt;
 1383: &lt;keywords&gt;$keywords&lt;/keywords&gt;
 1384: &lt;notes&gt;$notes&lt;/notes&gt;
 1385: &lt;mimeInfo&gt;
 1386: &lt;mime&gt;$mime&lt;/mime&gt;
 1387: &lt;mimetag&gt;$mimetag{$mime}&lt;/mimetag&gt;
 1388: &lt;/mimeInfo&gt;
 1389: &lt;languageInfo&gt;
 1390: &lt;language&gt;$lang&lt;/language&gt;
 1391: &lt;languagetag&gt;$language{$lang}&lt;/languagetag&gt;
 1392: &lt;/languageInfo&gt;
 1393: &lt;creationdate&gt;$creationdate&lt;/creationdate&gt;
 1394: &lt;lastrevisiondate&gt;$lastrevisiondate&lt;/lastrevisiondate&gt;
 1395: &lt;owner&gt;$owner&lt;/owner&gt;
 1396: &lt;copyrightInfo&gt;
 1397: &lt;copyright&gt;$copyright&lt;/copyright&gt;
 1398: &lt;copyrighttag&gt;$cprtag{$copyright}&lt;/copyrighttag&gt;
 1399: &lt;/copyrightInfo&gt;
 1400: &lt;repositoryLocation&gt;$hostname&lt;/repositoryLocation&gt;
 1401: &lt;shortabstract&gt;$shortabstract&lt;/shortabstract&gt;
 1402: &lt;/LonCapaResource&gt;
 1403: </pre>
 1404: $extrashow
 1405: END
 1406:     return $result;
 1407: }
 1408: 
 1409: # ---------------------------------------------------- see if a field is filled
 1410: sub filled {
 1411:     my ($field)=@_;
 1412:     if ($field=~/\S/ && $field ne 'any') {
 1413: 	return 1;
 1414:     }
 1415:     else {
 1416: 	return 0;
 1417:     }
 1418: }
 1419: 
 1420: # ---------------- Message to output when there are not enough fields filled in
 1421: sub output_blank_field_error {
 1422:     my ($r)=@_;
 1423:     # make query information persistent to allow for subsequent revision
 1424:     my $persistent=&make_persistent();
 1425: 
 1426:     $r->print(<<BEGINNING);
 1427: <html>
 1428: <head>
 1429: <title>The LearningOnline Network with CAPA</title>
 1430: BEGINNING
 1431:     $r->print(<<RESULTS);
 1432: </head>
 1433: <body bgcolor="#ffffff">
 1434: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
 1435: <h1>Search Catalog</h1>
 1436: <form method="post" action="/adm/searchcat">
 1437: $persistent
 1438: <input type='button' value='Revise search request'
 1439: onClick='this.form.submit();' />
 1440: $closebutton
 1441: <hr />
 1442: <h3>Helpful Message</h3>
 1443: <p>
 1444: Incorrect search query due to blank entry fields.
 1445: You need to fill in the relevant
 1446: fields on the search page in order for a query to be
 1447: processed.
 1448: </p>
 1449: </body>
 1450: </html>
 1451: RESULTS
 1452: }
 1453: 
 1454: # ----------------------------------------------------------- Output date error
 1455: sub output_date_error {
 1456:     my ($r,$message)=@_;
 1457:     # make query information persistent to allow for subsequent revision
 1458:     my $persistent=&make_persistent();
 1459: 
 1460:     $r->print(<<BEGINNING);
 1461: <html>
 1462: <head>
 1463: <title>The LearningOnline Network with CAPA</title>
 1464: BEGINNING
 1465:     $r->print(<<RESULTS);
 1466: </head>
 1467: <body bgcolor="#ffffff">
 1468: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
 1469: <h1>Search Catalog</h1>
 1470: <form method="post" action="/adm/searchcat">
 1471: $persistent
 1472: <input type='button' value='Revise search request'
 1473: onClick='this.form.submit();' />
 1474: $closebutton
 1475: <hr />
 1476: <h3>Helpful Message</h3>
 1477: <p>
 1478: $message
 1479: </p>
 1480: </body>
 1481: </html>
 1482: RESULTS
 1483: }
 1484: 
 1485: 1;
 1486: 
 1487: __END__

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