File:  [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.44: download - view: text, annotated - select for diffs
Tue Mar 20 17:49:03 2001 UTC (23 years, 2 months ago) by harris41
Branches: MAIN
CVS tags: HEAD
advanced search is working to the point of hovering 1 inch of the ground
for a brief period of time, or something like that -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: 
   40: package Apache::lonsearchcat;
   41: 
   42: use strict;
   43: use Apache::Constants qw(:common);
   44: use Apache::lonnet();
   45: use Apache::File();
   46: use CGI qw(:standard);
   47: use Text::Query;
   48: 
   49: my %language;
   50: my $scrout;
   51: my %metadatafields;
   52: my %cprtag;
   53: my %mimetag;
   54: 
   55: sub handler {
   56:     my $r = shift;
   57: 
   58: # -------------------------------------- see if called from an interactive mode
   59:     map {
   60:        my ($name, $value) = split(/=/,$_);
   61:        $value =~ tr/+/ /;
   62:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   63:        if ($name eq 'catalogmode') {
   64: 	   $ENV{'form.'.$name}=$value;
   65:        }
   66:     } (split(/&/,$ENV{'QUERY_STRING'}));
   67: 
   68:     $r->content_type('text/html');
   69:     $r->send_http_header;
   70:     return OK if $r->header_only;
   71: 
   72:     %metadatafields=();
   73: 
   74:     my $hidden='';
   75:     $hidden=<<END if $ENV{'form.catalogmode'} eq 'interactive';
   76: <input type='hidden' name='catalogmode' value='interactive'>
   77: END
   78: 
   79: # ------------------------------------------------ First, check out environment
   80:     $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
   81: 
   82: # --------------------------------- Compute various listings of metadata values
   83:     
   84:     %language=();
   85:     $language{'any'}='Any language';
   86:     {
   87: 	my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
   88: 	map {
   89: 	    $_=~/(\w+)\s+([\w\s\-]+)/;
   90: 	    $language{$1}=$2;
   91: 	} <$fh>;
   92:     }
   93: 
   94:     %cprtag=();
   95:     $cprtag{'any'}='Any copyright/distribution';
   96:     {
   97: 	my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
   98: 	map {
   99: 	    $_=~/(\w+)\s+([\w\s\-]+)/;
  100: 	    $cprtag{$1}=$2;
  101: 	} <$fh>;
  102:     }
  103: 
  104:     %mimetag=();
  105:     $mimetag{'any'}='Any type';
  106:     {
  107: 	my $fh=Apache::File->new($r->dir_config('lonTabDir').'/filetypes.tab');
  108: 	map {
  109: 	    $_=~/(\w+)\s+(\w+)\s+([\w\s\-]+)/;
  110: 	    $mimetag{$1}=".$1 $3";
  111: 	} <$fh>;
  112:     }
  113: 
  114:     if ($ENV{'form.basicsubmit'} eq 'SEARCH') {
  115: 	return &basicsearch($r,\%ENV);
  116:     }
  117:     elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
  118: 	return &advancedsearch($r,\%ENV);
  119:     }
  120: 
  121:     $scrout=''; # building a part of screen output
  122:     $scrout.=&searchphrasefield('Limit by title','title',
  123: 			$ENV{'form.title'});
  124: 
  125:     $scrout.=&searchphrasefield('Limit by author','author',
  126: 			$ENV{'form.author'});
  127: 
  128:     $scrout.=&searchphrasefield('Limit by subject','subject',
  129: 			$ENV{'form.subject'});
  130: 
  131:     $scrout.=&searchphrasefield('Limit by keywords','keywords',
  132: 			$ENV{'form.keywords'});
  133: 
  134:     $scrout.=&searchphrasefield('Limit by URL','url',
  135: 			$ENV{'form.url'});
  136: 
  137:     $scrout.=&searchphrasefield('Limit by version','version',
  138: 			$ENV{'form.version'});
  139: 
  140:     $scrout.=&searchphrasefield('Limit by notes','notes',
  141: 			$ENV{'form.notes'});
  142: 
  143:     $scrout.=&searchphrasefield('Limit by abstract','abstract',
  144: 			$ENV{'form.abstract'});
  145: 
  146:     $ENV{'form.mime'}='notxxx' unless length($ENV{'form.mime'});
  147:     $scrout.=&selectbox('Limit by MIME type','mime',
  148: 			$ENV{'form.mime'},%mimetag);
  149: 
  150:     $ENV{'form.language'}='any' unless length($ENV{'form.language'});
  151: 
  152:     $scrout.=&selectbox('Limit by language','language',
  153: 			$ENV{'form.language'},%language);
  154:     
  155: 
  156: # ------------------------------------------------ Compute date selection boxes
  157:     $scrout.=<<CREATIONDATESTART;
  158: <p>
  159: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
  160: </font>
  161: <br>
  162: between:
  163: CREATIONDATESTART
  164:     $scrout.=&dateboxes('creationdatestart',1,1,1976,
  165: 			$ENV{'form.creationdatestart_month'},
  166: 			$ENV{'form.creationdatestart_day'},
  167: 			$ENV{'form.creationdatestart_year'},
  168: 			);
  169:     $scrout.=<<CREATIONDATEEND;
  170: and:
  171: CREATIONDATEEND
  172:     $scrout.=&dateboxes('creationdateend',12,31,2051,
  173: 			$ENV{'form.creationdateend_month'},
  174: 			$ENV{'form.creationdateend_day'},
  175: 			$ENV{'form.creationdateend_year'},
  176: 			);
  177:     $scrout.="</p>";
  178: 
  179:     $scrout.=<<LASTREVISIONDATESTART;
  180: <p>
  181: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
  182: </b></font>
  183: <br>between:
  184: LASTREVISIONDATESTART
  185:     $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
  186: 			$ENV{'form.lastrevisiondatestart_month'},
  187: 			$ENV{'form.lastrevisiondatestart_day'},
  188: 			$ENV{'form.lastrevisiondatestart_year'},
  189: 			);
  190:     $scrout.=<<LASTREVISIONDATEEND;
  191: and:
  192: LASTREVISIONDATEEND
  193:     $scrout.=&dateboxes('lastrevisiondateend',12,31,2051,
  194: 			$ENV{'form.lastrevisiondateend_month'},
  195: 			$ENV{'form.lastrevisiondateend_day'},
  196: 			$ENV{'form.lastrevisiondateend_year'},
  197: 			);
  198:     $scrout.='</p>';
  199: 
  200:     $scrout.=&searchphrasefield('Limit by publisher/owner','owner',
  201: 				$ENV{'form.owner'});
  202: #			$metadatafields{'owner'});
  203: 
  204:     $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
  205:     $scrout.=&selectbox('Limit by copyright/distribution','copyright',
  206: 			$ENV{'form.copyright'},%cprtag);
  207: 
  208: # ------------------------------------------- Compute customized metadata field
  209:     $scrout.=<<CUSTOMMETADATA;
  210: <p>
  211: <font color="#800000" face="helvetica"><b>LIMIT BY OTHER METADATA FIELDS:</b>
  212: </font>
  213: For author-specific metadata, enter in an expression in the form of 
  214: <i>key</i>=<i>value</i> separated by operators such as AND or OR.<br>
  215: <b>Example:</b> grandmother=75 OR grandfather=85
  216: <br>
  217: CUSTOMMETADATA
  218: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
  219: $scrout.=' <i>initial users of this system do not need to worry about this option</i>';
  220: 
  221: # ---------------------------------------------------------------- Print screen
  222:     $r->print(<<ENDDOCUMENT);
  223: <html>
  224: <head>
  225: <title>The LearningOnline Network with CAPA</title>
  226: </head>
  227: <body bgcolor="#FFFFFF">
  228: <img align=right src=/adm/lonIcons/lonlogos.gif>
  229: <h1>Search Catalog</h1>
  230: <form method="post" action="/adm/searchcat">
  231: $hidden
  232: <hr>
  233: <h3>Basic Search</h3>
  234: <p>
  235: Enter terms or phrases separated by search operators
  236: such as AND or OR then press SEARCH below.  Terms should be specific
  237: to the title, author, subject, notes, or abstract information associated
  238: with a resource.
  239: <br>
  240: ENDDOCUMENT
  241:     $r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'}));
  242:     $r->print(' ');
  243:     $r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'}));
  244:     $r->print('<font color="#800000">Title only</font> ');
  245:     $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'}));
  246:     $r->print(<<ENDDOCUMENT);
  247: <font color="#800000">Search historic archives</font>
  248: <br>
  249: <input type="submit" name="basicsubmit" value="SEARCH">
  250: <input type="reset" name="reset" value="RESET">
  251: <input type="button" name="close" value="CLOSE" onClick="self.close()">
  252: </p>
  253: <hr>
  254: <h3>Advanced Search</h3>
  255: $scrout
  256: <p>
  257: <input type="submit" name="advancedsubmit" value="SEARCH">
  258: <input type="reset" name="reset" value="RESET">
  259: <input type="button" name="close" value="CLOSE" onClick="self.close()">
  260: </p>
  261: </form>
  262: </body>
  263: </html>
  264: ENDDOCUMENT
  265:     return OK;
  266: } 
  267: 
  268: # --------------------------------------------------------- Various form fields
  269: 
  270: sub simpletextfield {
  271:     my ($name,$value)=@_;
  272:     return '<input type=text name="'.$name.'" size=20 value="'.$value.'">';
  273: }
  274: 
  275: sub simplecheckbox {
  276:     my ($name,$value)=@_;
  277:     my $checked='';
  278:     $checked="CHECKED" if $value eq 'on';
  279:     return '<input type=checkbox name="'.$name.'" '. $checked . '>';
  280: }
  281: 
  282: sub searchphrasefield {
  283:     my ($title,$name,$value)=@_;
  284:     my $instruction=<<END;
  285: Enter terms or phrases separated by search operators such
  286: as AND or OR.
  287: END
  288:     my $uctitle=uc($title);
  289:     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>".
  290: 	   "</FONT> $instruction<br>".
  291:            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
  292: }
  293: 
  294: sub dateboxes {
  295:     my ($name,$defaultmonth,$defaultday,$defaultyear,
  296: 	$currentmonth,$currentday,$currentyear)=@_;
  297:     ($defaultmonth,$defaultday,$defaultyear)=('','','');
  298:     my $month=<<END;
  299: <select name="${name}_month">
  300: <option value='$defaultmonth'> </option>
  301: <option value="1">January</option>
  302: <option value="2">February</option>
  303: <option value="3">March</option>
  304: <option value="4">April</option>
  305: <option value="5">May</option>
  306: <option value="6">June</option>
  307: <option value="7">July</option>
  308: <option value="8">August</option>
  309: <option value="9">September</option>
  310: <option value="10">October</option>
  311: <option value="11">November</option>
  312: <option value="12">December</option>
  313: </select>
  314: END
  315:     $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
  316:     my $day=<<END;
  317: <select name="${name}_day">
  318: <option value='$defaultday'> </option>
  319: <option value="1">1</option>
  320: <option value="2">2</option>
  321: <option value="3">3</option>
  322: <option value="4">4</option>
  323: <option value="5">5</option>
  324: <option value="6">6</option>
  325: <option value="7">7</option>
  326: <option value="8">8</option>
  327: <option value="9">9</option>
  328: <option value="10">10</option>
  329: <option value="11">11</option>
  330: <option value="12">12</option>
  331: <option value="13">13</option>
  332: <option value="14">14</option>
  333: <option value="15">15</option>
  334: <option value="16">16</option>
  335: <option value="17">17</option>
  336: <option value="18">18</option>
  337: <option value="19">19</option>
  338: <option value="20">20</option>
  339: <option value="21">21</option>
  340: <option value="22">22</option>
  341: <option value="23">23</option>
  342: <option value="24">24</option>
  343: <option value="25">25</option>
  344: <option value="26">26</option>
  345: <option value="27">27</option>
  346: <option value="28">28</option>
  347: <option value="29">29</option>
  348: <option value="30">30</option>
  349: <option value="31">31</option>
  350: </select>
  351: END
  352:     $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
  353:     my $year=<<END;
  354: <select name="${name}_year">
  355: <option value='$defaultyear'> </option>
  356: <option value="1976">1976</option>
  357: <option value="1977">1977</option>
  358: <option value="1978">1978</option>
  359: <option value="1979">1979</option>
  360: <option value="1980">1980</option>
  361: <option value="1981">1981</option>
  362: <option value="1982">1982</option>
  363: <option value="1983">1983</option>
  364: <option value="1984">1984</option>
  365: <option value="1985">1985</option>
  366: <option value="1986">1986</option>
  367: <option value="1987">1987</option>
  368: <option value="1988">1988</option>
  369: <option value="1989">1989</option>
  370: <option value="1990">1990</option>
  371: <option value="1991">1991</option>
  372: <option value="1992">1992</option>
  373: <option value="1993">1993</option>
  374: <option value="1994">1994</option>
  375: <option value="1995">1995</option>
  376: <option value="1996">1996</option>
  377: <option value="1997">1997</option>
  378: <option value="1998">1998</option>
  379: <option value="1999">1999</option>
  380: <option value="2000">2000</option>
  381: <option value="2001">2001</option>
  382: <option value="2002">2002</option>
  383: <option value="2003">2003</option>
  384: <option value="2004">2004</option>
  385: <option value="2005">2005</option>
  386: <option value="2006">2006</option>
  387: <option value="2007">2007</option>
  388: <option value="2008">2008</option>
  389: <option value="2009">2009</option>
  390: <option value="2010">2010</option>
  391: <option value="2011">2011</option>
  392: <option value="2012">2012</option>
  393: <option value="2013">2013</option>
  394: <option value="2014">2014</option>
  395: <option value="2015">2015</option>
  396: <option value="2016">2016</option>
  397: <option value="2017">2017</option>
  398: <option value="2018">2018</option>
  399: <option value="2019">2019</option>
  400: <option value="2020">2020</option>
  401: <option value="2021">2021</option>
  402: <option value="2022">2022</option>
  403: <option value="2023">2023</option>
  404: <option value="2024">2024</option>
  405: <option value="2025">2025</option>
  406: <option value="2026">2026</option>
  407: <option value="2027">2027</option>
  408: <option value="2028">2028</option>
  409: <option value="2029">2029</option>
  410: <option value="2030">2030</option>
  411: <option value="2031">2031</option>
  412: <option value="2032">2032</option>
  413: <option value="2033">2033</option>
  414: <option value="2034">2034</option>
  415: <option value="2035">2035</option>
  416: <option value="2036">2036</option>
  417: <option value="2037">2037</option>
  418: <option value="2038">2038</option>
  419: <option value="2039">2039</option>
  420: <option value="2040">2040</option>
  421: <option value="2041">2041</option>
  422: <option value="2042">2042</option>
  423: <option value="2043">2043</option>
  424: <option value="2044">2044</option>
  425: <option value="2045">2045</option>
  426: <option value="2046">2046</option>
  427: <option value="2047">2047</option>
  428: <option value="2048">2048</option>
  429: <option value="2049">2049</option>
  430: <option value="2050">2050</option>
  431: <option value="2051">2051</option>
  432: </select>
  433: END
  434:     $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
  435:     return "$month$day$year";
  436: }
  437: 
  438: sub selectbox {
  439:     my ($title,$name,$value,%options)=@_;
  440:     my $uctitle=uc($title);
  441:     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
  442: 	"</b></font><br>".'<select name="'.$name.'">';
  443:     map {
  444:         $selout.='<option value="'.$_.'"';
  445:         if ($_ eq $value) { $selout.=' selected'; }
  446:         $selout.='>'.$options{$_}.'</option>';
  447:     } sort keys %options;
  448:     return $selout.'</select>';
  449: }
  450: 
  451: # ------------------------------------------------ Performing a advanced search
  452: sub advancedsearch {
  453:     my ($r,$envhash)=@_;
  454:     my %ENV=%{$envhash};
  455: 
  456:     my $fillflag=0;
  457:     for my $field ('title','author','subject','keywords','url','version',
  458: 		   'notes','abstract','mime','language','owner',
  459: 		   'custommetadata') {
  460: 	if (&filled($ENV{"form.$field"})) {
  461: 	    $fillflag++;
  462: 	}
  463:     }
  464: 
  465:     unless ($fillflag) {
  466: 	&output_blank_field_error($r);
  467: 	return OK;
  468:     }
  469: 
  470:     my $query='';
  471: 
  472:     my $testquery='';
  473:     # Go through logical expression AND/OR/NOT phrase fields.
  474:     foreach my $field ('title','author','subject','notes','abstract') {
  475: 	if ($ENV{'form.'.$field}) {
  476: 	    $testquery=build_SQL_query($field,$ENV{'form.'.$field});
  477: 	}
  478:     }
  479: 
  480: #    my $concatarg=join(',"    ",',
  481: #		       ('title', 'author', 'subject', 'notes', 'abstract'));
  482: 
  483:     $query="select * from metadata where $testquery";
  484: 
  485:     my $reply=&Apache::lonnet::metadata_query($query);
  486: 
  487:     &output_results('Advanced',$r,$envhash,$query,$reply);
  488:     return OK;
  489: }
  490: 
  491: # ---------------------------------------------------- see if a field is filled
  492: sub filled {
  493:     my ($field)=@_;
  494:     if ($field=~/\S/) {
  495: 	return 1;
  496:     }
  497:     else {
  498: 	return 0;
  499:     }
  500: }
  501: 
  502: # --------------------------------------------------- Performing a basic search
  503: sub basicsearch {
  504:     my ($r,$envhash)=@_;
  505:     my %ENV=%{$envhash};
  506: 
  507:     unless (&filled($ENV{'form.basicexp'})) {
  508: 	&output_blank_field_error($r);
  509: 	return OK;
  510:     }
  511: 
  512:     my $query='';
  513:     my $concatarg=join(',"    ",',
  514: 		       ('title', 'author', 'subject', 'notes', 'abstract'));
  515: 
  516:     $query="select * from metadata where concat($concatarg) like '\%$ENV{'form.basicexp'}\%'";
  517:     my $reply=&Apache::lonnet::metadata_query($query);
  518:     &output_results('Basic',$r,$envhash,$query,$reply);
  519:     return OK;
  520: }
  521: 
  522: # ---------------- Message to output when there are not enough fields filled in
  523: sub output_blank_field_error {
  524:     my ($r)=@_;
  525:     # make query information persistent to allow for subsequent revision
  526:     my $persistent='';
  527:     map {
  528: 	if (/^form\./ && !/submit/) {
  529: 	    my $name=$_;
  530: 	    my $key=$name;
  531: 	    $name=~s/^form\.//;
  532: 	    $persistent.=<<END;
  533: <INPUT TYPE='hidden' NAME='$name' VALUE='$ENV{$key}'>
  534: END
  535:         }
  536:     } (keys %ENV);
  537: 
  538:     $r->print(<<BEGINNING);
  539: <html>
  540: <head>
  541: <title>The LearningOnline Network with CAPA</title>
  542: BEGINNING
  543:     $r->print(<<RESULTS);
  544: </head>
  545: <body bgcolor="#ffffff">
  546: <img align=right src=/adm/lonIcons/lonlogos.gif>
  547: <h1>Search Catalog</h1>
  548: <form method="post" action="/adm/searchcat">
  549: $persistent
  550: <input type='button' value='Revise search request'
  551: onClick='this.form.submit();'>
  552: <input type='button' value='CLOSE'
  553: onClick='self.close();'>
  554: <hr>
  555: <h3>Helpful Message</h3>
  556: <p>
  557: Incorrect search query due to blank entry fields.
  558: You need to fill in the relevant
  559: fields on the search page in order for a query to be
  560: processed.
  561: </p>
  562: </body>
  563: </html>
  564: RESULTS
  565: }
  566: 
  567: # ----------------------------- format and output results based on a reply list
  568: sub output_results {
  569:     my ($mode,$r,$envhash,$query,@replylist)=@_;
  570:     my %ENV=%{$envhash};
  571:     my $compiledresult='';
  572: 
  573:     foreach my $reply (@replylist) {
  574: 
  575: 	my @results;
  576: 
  577: 	my $replyfile='';
  578: 	$reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting
  579: 	$replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
  580: 	$reply=~/(.*?)\_/;
  581: 	my $hostname=$1;
  582: 
  583: 	{
  584: 	    while (1) {
  585: 		last if -e $replyfile;
  586: 		sleep 1;
  587: 	    }
  588: 	    # QUESTION: how should I handle this error condition..
  589: 	    # I'm sure there is syntax elsewhere I can use..
  590: 	    my $fh=Apache::File->new($replyfile) or
  591: 		($r->print('file cannot be opened') and return OK);
  592: 	    @results=<$fh>;
  593: 	}
  594: 
  595: 	foreach my $result (@results) {
  596: 	    my ($title,$author,$subject,$url,$keywords,$version,
  597: 		$notes,$abstract,$mime,$lang,
  598: 		$creationdate,$lastrevisiondate,$owner,$copyright
  599: 		)=map {&Apache::lonnet::unescape($_)} (split(/\,/,$result));
  600: 	    my $shortabstract=$abstract;
  601: 	    $shortabstract=substr($abstract,0,200) if length($abstract)>200;
  602: 	    $compiledresult.=<<END;
  603: <p>
  604: END
  605:             $compiledresult.=<<END if $ENV{'form.catalogmode'} eq 'interactive';
  606: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
  607: onClick="javascript:select_data('$title','$url')">
  608: </font>
  609: <br>
  610: END
  611:             $compiledresult.=<<END;
  612: <b>URL: </b> <A HREF="http://$ENV{'HTTP_HOST'}$url" TARGET='search_preview'>$url</A>
  613: <br>
  614: <b>Title:</b> $title<br>
  615: <b>Author(s):</b> $author<br>
  616: <b>Subject:</b> $subject<br>
  617: <b>Keyword(s):</b> $keywords<br>
  618: <b>Notes:</b> $notes<br>
  619: <b>Abstract:</b> $shortabstract<br>
  620: <b>MIME Type:</b> $mimetag{$mime}<br>
  621: <b>Language:</b> $language{$lang}<br>
  622: <b>Creation Date:</b> $creationdate<br>
  623: <b>Last Revision Date:</b> $lastrevisiondate<br>
  624: <b>Publisher/Owner:</b> $owner<br>
  625: <b>Copyright/Distribution:</b> $copyright<br>
  626: <b>Repository Location:</b> $hostname
  627: </p>
  628: END
  629:         }
  630: 
  631: 	unless ($compiledresult) {
  632: 	    $compiledresult="There were no results that matched your query";
  633: 	}
  634: 
  635: 	# make query information persistent to allow for subsequent revision
  636: 	my $persistent='';
  637: 	map {
  638: 	    if (/^form\./ && !/submit/) {
  639: 		my $name=$_;
  640: 		my $key=$name;
  641: 		$name=~s/^form\.//;
  642: 		$persistent.=<<END;
  643: <INPUT TYPE='hidden' NAME='$name' VALUE='$ENV{$key}'>
  644: END
  645:             }
  646: 	} (keys %ENV);
  647: 
  648: 	$r->print(<<BEGINNING);
  649: <html>
  650: <head>
  651: <title>The LearningOnline Network with CAPA</title>
  652: BEGINNING
  653:         $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'interactive';
  654: <script>
  655:     function select_data(title,url) {
  656: 	changeTitle(title);
  657: 	changeURL(url);
  658:     }
  659:     function changeTitle(val) {
  660: 	if (opener.inf.document.forms.resinfo.elements.t) {
  661: 	    opener.inf.document.forms.resinfo.elements.t.value=val;
  662: 	}
  663:     }
  664:     function changeURL(val) {
  665: 	if (opener.inf.document.forms.resinfo.elements.u) {
  666: 	    opener.inf.document.forms.resinfo.elements.u.value=val;
  667: 	}
  668:     }
  669: </script>
  670: SCRIPT
  671:         $r->print(<<RESULTS);
  672: </head>
  673: <body bgcolor="#ffffff">
  674: <img align=right src=/adm/lonIcons/lonlogos.gif>
  675: <h1>Search Catalog</h1>
  676: <form method="post" action="/adm/searchcat">
  677: <input type='button' value='Revise search request'
  678: onClick='this.form.submit();'>
  679: <input type='button' value='CLOSE'
  680: onClick='self.close();'>
  681: $persistent
  682: <hr>
  683: <h3>Search Query</h3>
  684: RESULTS
  685:     if ($mode eq 'Basic') {
  686: 	$r->print(<<RESULTS);
  687: <p>
  688: <b>Basic search:</b> $ENV{'form.basicexp'}
  689: </p>
  690: RESULTS
  691:     }
  692:     elsif ($mode eq 'Advanced') {
  693: 	$r->print(<<RESULTS);
  694: <p>
  695: <b>Advanced search</b>
  696: $query
  697: </p>
  698: RESULTS
  699:     }
  700: 	$r->print(<<RESULTS);
  701: <h3>Search Results</h3>
  702: $compiledresult
  703: </body>
  704: </html>
  705: RESULTS
  706:     }
  707: }
  708: 
  709: # ------------------------------------------------------------- build_SQL_query
  710: sub build_SQL_query {
  711:     my ($field_name,$logic_statement)=@_;
  712:     my $q=new Text::Query('abc',
  713: 			  -parse => 'Text::Query::ParseAdvanced',
  714: 			  -build => 'Text::Query::Build');
  715:     $q->prepare($logic_statement);
  716:     my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
  717:     my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
  718:     return $sql_query;
  719: }
  720: 
  721: # - Recursively parse a reverse notation expression into a SQL query expression
  722: sub recursive_SQL_query_build {
  723:     my ($dkey,$pattern)=@_;
  724:     my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
  725:     return $pattern unless @matches;
  726:     foreach my $match (@matches) {
  727: 	$match=~/\[ (\w+)\s(.*) \]/;
  728: 	my ($key,$value)=($1,$2);
  729: 	my $replacement='';
  730: 	if ($key eq 'literal') {
  731: 	    $replacement="($dkey like \"\%$value\%\")";
  732: 	}
  733: 	elsif ($key eq 'and') {
  734: 	    $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
  735: 	    $replacement="($1 AND $2)";
  736: 	}
  737: 	elsif ($key eq 'or') {
  738: 	    $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
  739: 	    $replacement="($1 OR $2)";
  740: 	}
  741: 	substr($pattern,
  742: 	       index($pattern,$match),
  743: 	       length($match),
  744: 	       $replacement
  745: 	       );
  746:     }
  747:     &recursive_SQL_query_build($dkey,$pattern);
  748: }
  749: 
  750: 1;
  751: __END__

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