File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.90: download - view: text, annotated - select for diffs
Mon Apr 2 13:13:17 2001 UTC (23 years, 2 months ago) by harris41
Branches: MAIN
CVS tags: HEAD
adding comments throughout code as well as function descriptions
at top of code -Scott

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

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