File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.97: download - view: text, annotated - select for diffs
Thu Aug 16 02:20:01 2001 UTC (22 years, 9 months ago) by harris41
Branches: MAIN
CVS tags: HEAD
causing window to close upon selection

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

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