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

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