loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.67: download - view: text, annotated - select for diffs
Thu Mar 22 13:33:07 2001 UTC (23 years, 2 months ago) by harris41
Branches: MAIN
CVS tags: HEAD

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