loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.115: download - view: text, annotated - select for diffs
Thu Jan 17 13:53:45 2002 UTC (22 years, 4 months ago) by harris41
Branches: MAIN
CVS tags: stable_2002_spring, HEAD

fixing handling of metadata title so that it gets passed through

1: # The LearningOnline Network with CAPA 2: # Search Catalog 3: # 4: # $Id: lonsearchcat.pm,v 1.115 2002/01/17 13:53:45 harris41 Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: # YEAR=2001 29: # 3/8, 3/12, 3/13, 3/14, 3/15, 3/19 Scott Harrison 30: # 3/20, 3/21, 3/22, 3/26, 3/27, 4/2, 8/15, 8/24, 8/25 Scott Harrison 31: # 10/12,10/14,10/15,10/16,11/28,11/29,12/10,12/12,12/16 Scott Harrison 32: # YEAR=2002 33: # 1/17 Scott Harrison 34: # 35: ### 36: 37: ############################################################################### 38: ## ## 39: ## ORGANIZATION OF THIS PERL MODULE ## 40: ## ## 41: ## 1. Modules used by this module ## 42: ## 2. Choices for different output views (detailed, summary, xml, etc) ## 43: ## 3. BEGIN block (to be run once after compilation) ## 44: ## 4. Handling routine called via Apache and mod_perl ## 45: ## 5. Other subroutines ## 46: ## ## 47: ############################################################################### 48: 49: package Apache::lonsearchcat; 50: 51: # ------------------------------------------------- modules used by this module 52: use strict; 53: use Apache::Constants qw(:common); 54: use Apache::lonnet(); 55: use Apache::File(); 56: use CGI qw(:standard); 57: use Text::Query; 58: use GDBM_File; 59: use Apache::loncommon(); 60: 61: # ---------------------------------------- variables used throughout the module 62: 63: # -- information holders 64: my %hostdomains; # matches host name to host domain 65: my %hostips; # matches host name to host ip 66: my %hitcount; # stores number of hits per host 67: 68: # -- dynamically rendered interface components 69: my $closebutton; # button that closes the search window 70: my $importbutton; # button to take the selected results and go to group sorting 71: 72: # -- miscellaneous variables 73: my $scrout; # string that holds portions of the screen output 74: my $yourself; # allows for quickly limiting to oneself 75: my %hash; 76: 77: # ------------------------------------------ choices for different output views 78: # Detailed Citation View ---> sub detailed_citation_view 79: # Summary View ---> sub summary_view 80: # Fielded Format ---> sub fielded_format_view 81: # XML/SGML ---> sub xml_sgml_view 82: my $basicviewselect=<<END; 83: <select name='basicviewselect'> 84: <option value='Detailed Citation View'>Detailed Citation View</option> 85: <option value='Summary View'>Summary View</option> 86: <option value='Fielded Format'>Fielded Format</option> 87: <option value='XML/SGML'>XML/SGML</option> 88: </select> 89: END 90: my $advancedviewselect=<<END; 91: <select name='advancedviewselect'> 92: <option value='Detailed Citation View'>Detailed Citation View</option> 93: <option value='Summary View'>Summary View</option> 94: <option value='Fielded Format'>Fielded Format</option> 95: <option value='XML/SGML'>XML/SGML</option> 96: </select> 97: END 98: 99: # ----------------------------------------------------------------------- BEGIN 100: BEGIN { 101: { 102: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. 103: '/hosts.tab'); 104: while (<$fh>) { 105: $_=~/(\w+?)\:(\w+?)\:(\w+?)\:(.*)/; chomp; 106: if ($3 eq 'library') { 107: $hostdomains{$1}=$2; 108: $hostips{$1}=$4; 109: } 110: } 111: } 112: } 113: 114: my $diropendb = ""; 115: my $domain = ""; 116: 117: # ----------------------------- Handling routine called via Apache and mod_perl 118: sub handler { 119: my $r = shift; 120: untie %hash; 121: &get_unprocessed_cgi(); 122: 123: $r->content_type('text/html'); 124: $r->send_http_header; 125: return OK if $r->header_only; 126: 127: $domain = $r->dir_config('lonDefDomain'); 128: 129: $diropendb= "/home/httpd/perl/tmp/$domain\_$ENV{'user.name'}_searchcat.db"; 130: 131: if ($ENV{'form.launch'} eq '1') { 132: if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { 133: &start_fresh_session(); 134: untie %hash; 135: } 136: else { 137: $r->print('<html><head></head><body>Unable to tie hash to db '. 138: 'file</body></html>'); 139: return OK; 140: } 141: } 142: 143: # ----------------------------------- configure dynamic components of interface 144: my $hidden=''; 145: if ($ENV{'form.catalogmode'} eq 'interactive') { 146: $hidden="<input type='hidden' name='catalogmode' value='interactive'>". 147: "\n"; 148: $closebutton="<input type='button' name='close' value='CLOSE' ". 149: "onClick='self.close()'>"."\n"; 150: } 151: elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { 152: $hidden=<<END; 153: <input type='hidden' name='catalogmode' value='groupsearch'> 154: END 155: $closebutton=<<END; 156: <input type='button' name='close' value='CLOSE' onClick='self.close()'> 157: END 158: $importbutton=<<END; 159: <input type='button' name='import' value='IMPORT' 160: onClick='javascript:select_group()'> 161: END 162: } 163: 164: # ------------------------------------------------------ Determine current user 165: $yourself=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; 166: 167: # --- Now, depending on the interface actions, do one of three things here: 168: # --- 1. a basic search 169: # --- 2. an advanced search 170: # --- 3. output a search interface 171: 172: # ----------------------------------- See if a search invocation should be done 173: if ($ENV{'form.basicsubmit'} eq 'SEARCH') { 174: untie %hash; return &basicsearch($r,\%ENV); 175: } 176: elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { 177: untie %hash; return &advancedsearch($r,\%ENV); 178: } 179: 180: # ----------------------------- Else, begin building search interface to output 181: $scrout=''; # building a part of screen output 182: $scrout.=&searchphrasefield('Limit by title','title', 183: $ENV{'form.title'}); 184: 185: $scrout.=&searchphrasefield('Limit by author','author', 186: $ENV{'form.author'}); 187: 188: $scrout.=&searchphrasefield('Limit by subject','subject', 189: $ENV{'form.subject'}); 190: 191: $scrout.=&searchphrasefield('Limit by keywords','keywords', 192: $ENV{'form.keywords'}); 193: 194: $scrout.=&searchphrasefield('Limit by URL','url', 195: $ENV{'form.url'}); 196: 197: # $scrout.=&searchphrasefield('Limit by version','version', 198: # $ENV{'form.version'}); 199: 200: $scrout.=&searchphrasefield('Limit by notes','notes', 201: $ENV{'form.notes'}); 202: 203: $scrout.=&searchphrasefield('Limit by abstract','abstract', 204: $ENV{'form.abstract'}); 205: 206: $ENV{'form.mime'}='any' unless length($ENV{'form.mime'}); 207: $scrout.=&selectbox('Limit by MIME type','mime', 208: $ENV{'form.mime'}, 209: 'any','Any type', 210: \&{Apache::loncommon::filedescriptionex}, 211: (&Apache::loncommon::fileextensions)); 212: 213: $ENV{'form.language'}='any' unless length($ENV{'form.language'}); 214: 215: $scrout.=&selectbox('Limit by language','language', 216: $ENV{'form.language'},'any','Any Language', 217: \&{Apache::loncommon::languagedescription}, 218: (&Apache::loncommon::languageids), 219: ); 220: 221: # ------------------------------------------------ Compute date selection boxes 222: $scrout.=<<CREATIONDATESTART; 223: <p> 224: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b> 225: </font> 226: <br /> 227: between: 228: CREATIONDATESTART 229: $scrout.=&dateboxes('creationdatestart',1,1,1976, 230: $ENV{'form.creationdatestart_month'}, 231: $ENV{'form.creationdatestart_day'}, 232: $ENV{'form.creationdatestart_year'}, 233: ); 234: $scrout.=<<CREATIONDATEEND; 235: and: 236: CREATIONDATEEND 237: $scrout.=&dateboxes('creationdateend',12,31,2051, 238: $ENV{'form.creationdateend_month'}, 239: $ENV{'form.creationdateend_day'}, 240: $ENV{'form.creationdateend_year'}, 241: ); 242: $scrout.="</p>"; 243: 244: $scrout.=<<LASTREVISIONDATESTART; 245: <p> 246: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE: 247: </b></font> 248: <br />between: 249: LASTREVISIONDATESTART 250: $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, 251: $ENV{'form.lastrevisiondatestart_month'}, 252: $ENV{'form.lastrevisiondatestart_day'}, 253: $ENV{'form.lastrevisiondatestart_year'}, 254: ); 255: $scrout.=<<LASTREVISIONDATEEND; 256: and: 257: LASTREVISIONDATEEND 258: $scrout.=&dateboxes('lastrevisiondateend',12,31,2051, 259: $ENV{'form.lastrevisiondateend_month'}, 260: $ENV{'form.lastrevisiondateend_day'}, 261: $ENV{'form.lastrevisiondateend_year'}, 262: ); 263: $scrout.='</p>'; 264: 265: $scrout.=&searchphrasefield('Limit by publisher/owner','owner', 266: $ENV{'form.owner'}); 267: 268: $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); 269: $scrout.=&selectbox('Limit by copyright/distribution','copyright', 270: $ENV{'form.copyright'}, 271: 'any','Any copyright/distribution', 272: \&{Apache::loncommon::copyrightdescription}, 273: (&Apache::loncommon::copyrightids), 274: ); 275: 276: # ------------------------------------------- Compute customized metadata field 277: $scrout.=<<CUSTOMMETADATA; 278: <p> 279: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b> 280: </font> 281: For resource-specific metadata, enter in an expression in the form of 282: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br /> 283: <b>Example:</b> grandmother=75 OR grandfather=85 284: <br /> 285: CUSTOMMETADATA 286: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); 287: $scrout.=' <i>initial users of this system do not need to worry about this option</i>'; 288: 289: $scrout.=<<CUSTOMSHOW; 290: <p> 291: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b> 292: </font> 293: Enter in a space-separated list of special metadata fields to show 294: in a fielded listing for each record result. 295: <br /> 296: CUSTOMSHOW 297: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); 298: $scrout.=' <i>initial users of this system do not need to worry about this option</i>'; 299: 300: # ---------------------------------------------------------------- Print screen 301: $r->print(<<ENDDOCUMENT); 302: <html> 303: <head> 304: <title>The LearningOnline Network with CAPA</title> 305: <script type="text/javascript"> 306: function openhelp(val) { 307: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 308: 'scrollbars=1,width=400,height=300'); 309: openhelpwin.focus(); 310: } 311: </script> 312: </head> 313: <body bgcolor="#FFFFFF"> 314: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 315: <h1>Search Catalog</h1> 316: <form method="post" action="/adm/searchcat"> 317: $hidden 318: <hr /> 319: <h3>Basic Search</h3> 320: <p> 321: Enter terms or phrases separated by search operators 322: such as AND, OR, or NOT then press SEARCH below. Terms should be specific 323: to the title, author, subject, notes, or abstract information associated 324: with a resource. 325: <br /> 326: ENDDOCUMENT 327: $r->print(&simpletextfield('basicexp',$ENV{'form.basicexp'})); 328: $r->print(' '); 329: $r->print(&simplecheckbox('titleonly',$ENV{'form.titleonly'})); 330: $r->print('<font color="#800000">Title only</font> '); 331: # $r->print(&simplecheckbox('allversions',$ENV{'form.allversions'})); 332: # <font color="#800000">Search historic archives</font> 333: $r->print(<<ENDDOCUMENT); 334: <br /> 335: <input type="submit" name="basicsubmit" value='SEARCH' /> 336: <input type="reset" name="reset" value='RESET' /> 337: $closebutton 338: $basicviewselect 339: <input type="button" value="HELP" onClick="openhelp()" /> 340: </p> 341: <hr /> 342: <h3>Advanced Search</h3> 343: $scrout 344: <p> 345: <input type="submit" name="advancedsubmit" value='SEARCH' /> 346: <input type="reset" name="reset" value='RESET' /> 347: $closebutton 348: $advancedviewselect 349: <input type="button" value="HELP" onClick="openhelp()" /> 350: </p> 351: </form> 352: </body> 353: </html> 354: ENDDOCUMENT 355: return OK; 356: } 357: 358: # ----------- grab unprocessed CGI variables that may have been appended to URL 359: sub get_unprocessed_cgi { 360: foreach (split(/&/,$ENV{'QUERY_STRING'})) { 361: my ($name, $value) = split(/=/,$_); 362: $value =~ tr/+/ /; 363: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 364: if ($name eq 'catalogmode' or $name eq 'launch' or $name eq 'acts') { 365: $ENV{'form.'.$name}=$value; 366: } 367: } 368: } 369: 370: # ------------------------------------------------------------- make persistent 371: sub make_persistent { 372: my $persistent=''; 373: 374: foreach (keys %ENV) { 375: if (/^form\./ && !/submit/) { 376: my $name=$_; 377: my $key=$name; 378: $ENV{$key}=~s/\'//g; # do not mess with html field syntax 379: $name=~s/^form\.//; 380: $persistent.=<<END; 381: <input type='hidden' name='$name' value='$ENV{$key}' /> 382: END 383: } 384: } 385: return $persistent; 386: } 387: 388: # --------------------------------------------------------- Various form fields 389: 390: sub simpletextfield { 391: my ($name,$value)=@_; 392: return '<input type=text name=\''.$name. 393: '\' size=20 value=\''.$value.'\' />'; 394: } 395: 396: sub simplecheckbox { 397: my ($name,$value)=@_; 398: my $checked=''; 399: $checked="CHECKED" if $value eq 'on'; 400: return '<input type=checkbox name=\''.$name.'\' '. $checked . '>'; 401: } 402: 403: sub searchphrasefield { 404: my ($title,$name,$value)=@_; 405: my $instruction=<<END; 406: Enter terms or phrases separated by search operators such 407: as AND, OR, or NOT. 408: END 409: my $uctitle=uc($title); 410: return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>". 411: "</FONT> $instruction<br />". 412: '<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>'; 413: } 414: 415: sub dateboxes { 416: my ($name,$defaultmonth,$defaultday,$defaultyear, 417: $currentmonth,$currentday,$currentyear)=@_; 418: ($defaultmonth,$defaultday,$defaultyear)=('','',''); 419: my $month=<<END; 420: <select name="${name}_month"> 421: <option value='$defaultmonth'> </option> 422: <option value="1">January</option> 423: <option value="2">February</option> 424: <option value="3">March</option> 425: <option value="4">April</option> 426: <option value="5">May</option> 427: <option value="6">June</option> 428: <option value="7">July</option> 429: <option value="8">August</option> 430: <option value="9">September</option> 431: <option value="10">October</option> 432: <option value="11">November</option> 433: <option value="12">December</option> 434: </select> 435: END 436: $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); 437: my $day=<<END; 438: <select name="${name}_day"> 439: <option value='$defaultday'> </option> 440: <option value="1">1</option> 441: <option value="2">2</option> 442: <option value="3">3</option> 443: <option value="4">4</option> 444: <option value="5">5</option> 445: <option value="6">6</option> 446: <option value="7">7</option> 447: <option value="8">8</option> 448: <option value="9">9</option> 449: <option value="10">10</option> 450: <option value="11">11</option> 451: <option value="12">12</option> 452: <option value="13">13</option> 453: <option value="14">14</option> 454: <option value="15">15</option> 455: <option value="16">16</option> 456: <option value="17">17</option> 457: <option value="18">18</option> 458: <option value="19">19</option> 459: <option value="20">20</option> 460: <option value="21">21</option> 461: <option value="22">22</option> 462: <option value="23">23</option> 463: <option value="24">24</option> 464: <option value="25">25</option> 465: <option value="26">26</option> 466: <option value="27">27</option> 467: <option value="28">28</option> 468: <option value="29">29</option> 469: <option value="30">30</option> 470: <option value="31">31</option> 471: </select> 472: END 473: $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); 474: my $year=<<END; 475: <select name="${name}_year"> 476: <option value='$defaultyear'> </option> 477: <option value="1976">1976</option> 478: <option value="1977">1977</option> 479: <option value="1978">1978</option> 480: <option value="1979">1979</option> 481: <option value="1980">1980</option> 482: <option value="1981">1981</option> 483: <option value="1982">1982</option> 484: <option value="1983">1983</option> 485: <option value="1984">1984</option> 486: <option value="1985">1985</option> 487: <option value="1986">1986</option> 488: <option value="1987">1987</option> 489: <option value="1988">1988</option> 490: <option value="1989">1989</option> 491: <option value="1990">1990</option> 492: <option value="1991">1991</option> 493: <option value="1992">1992</option> 494: <option value="1993">1993</option> 495: <option value="1994">1994</option> 496: <option value="1995">1995</option> 497: <option value="1996">1996</option> 498: <option value="1997">1997</option> 499: <option value="1998">1998</option> 500: <option value="1999">1999</option> 501: <option value="2000">2000</option> 502: <option value="2001">2001</option> 503: <option value="2002">2002</option> 504: <option value="2003">2003</option> 505: <option value="2004">2004</option> 506: <option value="2005">2005</option> 507: <option value="2006">2006</option> 508: <option value="2007">2007</option> 509: <option value="2008">2008</option> 510: <option value="2009">2009</option> 511: <option value="2010">2010</option> 512: <option value="2011">2011</option> 513: <option value="2012">2012</option> 514: <option value="2013">2013</option> 515: <option value="2014">2014</option> 516: <option value="2015">2015</option> 517: <option value="2016">2016</option> 518: <option value="2017">2017</option> 519: <option value="2018">2018</option> 520: <option value="2019">2019</option> 521: <option value="2020">2020</option> 522: <option value="2021">2021</option> 523: <option value="2022">2022</option> 524: <option value="2023">2023</option> 525: <option value="2024">2024</option> 526: <option value="2025">2025</option> 527: <option value="2026">2026</option> 528: <option value="2027">2027</option> 529: <option value="2028">2028</option> 530: <option value="2029">2029</option> 531: <option value="2030">2030</option> 532: <option value="2031">2031</option> 533: <option value="2032">2032</option> 534: <option value="2033">2033</option> 535: <option value="2034">2034</option> 536: <option value="2035">2035</option> 537: <option value="2036">2036</option> 538: <option value="2037">2037</option> 539: <option value="2038">2038</option> 540: <option value="2039">2039</option> 541: <option value="2040">2040</option> 542: <option value="2041">2041</option> 543: <option value="2042">2042</option> 544: <option value="2043">2043</option> 545: <option value="2044">2044</option> 546: <option value="2045">2045</option> 547: <option value="2046">2046</option> 548: <option value="2047">2047</option> 549: <option value="2048">2048</option> 550: <option value="2049">2049</option> 551: <option value="2050">2050</option> 552: <option value="2051">2051</option> 553: </select> 554: END 555: $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); 556: return "$month$day$year"; 557: } 558: 559: sub selectbox { 560: my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; 561: my $uctitle=uc($title); 562: my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:". 563: "</b></font><br />".'<select name="'.$name.'">'; 564: foreach ($anyvalue,@idlist) { 565: $selout.='<option value=\''.$_.'\''; 566: if ($_ eq $value and !/^any$/) { 567: $selout.=' selected>'.&{$functionref}($_).'</option>'; 568: } 569: elsif ($_ eq $value and /^$anyvalue$/) { 570: $selout.=' selected>'.$anytag.'</option>'; 571: } 572: else {$selout.='>'.&{$functionref}($_).'</option>';} 573: } 574: return $selout.'</select>'; 575: } 576: 577: sub testf { 578: return @_[0]; 579: } 580: 581: # ----------------------------------------------- Performing an advanced search 582: sub advancedsearch { 583: my ($r,$envhash)=@_; 584: my %ENV=%{$envhash}; 585: 586: my $fillflag=0; 587: # Clean up fields for safety 588: for my $field ('title','author','subject','keywords','url','version', 589: 'creationdatestart_month','creationdatestart_day', 590: 'creationdatestart_year','creationdateend_month', 591: 'creationdateend_day','creationdateend_year', 592: 'lastrevisiondatestart_month','lastrevisiondatestart_day', 593: 'lastrevisiondatestart_year','lastrevisiondateend_month', 594: 'lastrevisiondateend_day','lastrevisiondateend_year', 595: 'notes','abstract','mime','language','owner', 596: 'custommetadata','customshow') { 597: $ENV{"form.$field"}=~s/[^\w\/\s\=\-\"\']//g; 598: } 599: 600: # Check to see if enough information was filled in 601: for my $field ('title','author','subject','keywords','url','version', 602: 'notes','abstract','mime','language','owner', 603: 'custommetadata') { 604: if (&filled($ENV{"form.$field"})) { 605: $fillflag++; 606: } 607: } 608: unless ($fillflag) { 609: &output_blank_field_error($r); 610: return OK; 611: } 612: 613: 614: # Turn the form input into a SQL-based query 615: my $query=''; 616: 617: my @queries; 618: # Evaluate logical expression AND/OR/NOT phrase fields. 619: foreach my $field ('title','author','subject','notes','abstract','url', 620: 'keywords','version','owner') { 621: if ($ENV{'form.'.$field}) { 622: push @queries,&build_SQL_query($field,$ENV{'form.'.$field}); 623: } 624: } 625: # Evaluate option lists 626: if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { 627: push @queries,"(language like \"$ENV{'form.language'}\")"; 628: } 629: if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') { 630: push @queries,"(mime like \"$ENV{'form.mime'}\")"; 631: } 632: if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { 633: push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; 634: } 635: # Evaluate date windows 636: my $datequery=&build_date_queries( 637: $ENV{'form.creationdatestart_month'}, 638: $ENV{'form.creationdatestart_day'}, 639: $ENV{'form.creationdatestart_year'}, 640: $ENV{'form.creationdateend_month'}, 641: $ENV{'form.creationdateend_day'}, 642: $ENV{'form.creationdateend_year'}, 643: $ENV{'form.lastrevisiondatestart_month'}, 644: $ENV{'form.lastrevisiondatestart_day'}, 645: $ENV{'form.lastrevisiondatestart_year'}, 646: $ENV{'form.lastrevisiondateend_month'}, 647: $ENV{'form.lastrevisiondateend_day'}, 648: $ENV{'form.lastrevisiondateend_year'}, 649: ); 650: # Test to see if date windows are legitimate 651: if ($datequery=~/^Incorrect/) { 652: &output_date_error($r,$datequery); 653: return OK; 654: } 655: elsif ($datequery) { 656: push @queries,$datequery; 657: } 658: 659: # Process form information for custom metadata querying 660: my $customquery=''; 661: if ($ENV{'form.custommetadata'}) { 662: $customquery=&build_custommetadata_query('custommetadata', 663: $ENV{'form.custommetadata'}); 664: } 665: my $customshow=''; 666: if ($ENV{'form.customshow'}) { 667: $customshow=$ENV{'form.customshow'}; 668: $customshow=~s/[^\w\s]//g; 669: my @fields=split(/\s+/,$customshow); 670: $customshow=join(" ",@fields); 671: } 672: # Send query statements over the network to be processed by either the SQL 673: # database or a recursive scheme of 'grep'-like actions (for custom 674: # metadata). 675: if (@queries) { 676: $query=join(" AND ",@queries); 677: $query="select * from metadata where $query"; 678: my $reply; # reply hash reference 679: unless ($customquery or $customshow) { 680: $reply=&Apache::lonnet::metadata_query($query); 681: } 682: else { 683: $reply=&Apache::lonnet::metadata_query($query, 684: $customquery,$customshow); 685: } 686: &output_results('Advanced',$r,$envhash,$customquery,$reply); 687: } 688: elsif ($customquery) { 689: my $reply; # reply hash reference 690: $reply=&Apache::lonnet::metadata_query('', 691: $customquery,$customshow); 692: &output_results('Advanced',$r,$envhash,$customquery,$reply); 693: } 694: # should not get to this point 695: return 'Error. Should not have gone to this point.'; 696: } 697: 698: # --------------------------------------------------- Performing a basic search 699: sub basicsearch { 700: my ($r,$envhash)=@_; 701: my %ENV=%{$envhash}; 702: # Clean up fields for safety 703: for my $field ('basicexp') { 704: $ENV{"form.$field"}=~s/[^\w\s\-]//g; 705: } 706: 707: # Check to see if enough is filled in 708: unless (&filled($ENV{'form.basicexp'})) { 709: &output_blank_field_error($r); 710: return OK; 711: } 712: 713: # Build SQL query string based on form page 714: my $query=''; 715: my $concatarg=join('," ",', 716: ('title', 'author', 'subject', 'notes', 'abstract')); 717: $concatarg='title' if $ENV{'form.titleonly'}; 718: 719: $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); 720: 721: # Get reply (either a hash reference to filehandles or bad connection) 722: my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query); 723: 724: # Output search results 725: 726: &output_results('Basic',$r,$envhash,$query,$reply); 727: 728: return OK; 729: } 730: 731: # ------------------------------------------------------------- build_SQL_query 732: sub build_SQL_query { 733: my ($field_name,$logic_statement)=@_; 734: my $q=new Text::Query('abc', 735: -parse => 'Text::Query::ParseAdvanced', 736: -build => 'Text::Query::Build'); 737: $q->prepare($logic_statement); 738: my $matchexp=${$q}{'matchexp'}; chomp $matchexp; 739: my $sql_query=&recursive_SQL_query_build($field_name,$matchexp); 740: return $sql_query; 741: } 742: 743: # ------------------------------------------------- build custom metadata query 744: sub build_custommetadata_query { 745: my ($field_name,$logic_statement)=@_; 746: my $q=new Text::Query('abc', 747: -parse => 'Text::Query::ParseAdvanced', 748: -build => 'Text::Query::BuildAdvancedString'); 749: $q->prepare($logic_statement); 750: my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; 751: # quick fix to change literal into xml tag-matching 752: # will eventually have to write a separate builder module 753: my $oldmatchexp=$matchexp; 754: $matchexp=~s/(\w+)\\\=([\w\\\+]+)/\\\<$1\\\>\[\^\\\<\]\*$2\[\^\\\<\]\*\\\<\\\/$1\\\>/g; 755: return $matchexp; 756: } 757: 758: # - Recursively parse a reverse notation expression into a SQL query expression 759: sub recursive_SQL_query_build { 760: my ($dkey,$pattern)=@_; 761: my @matches=($pattern=~/(\[[^\]|\[]*\])/g); 762: return $pattern unless @matches; 763: foreach my $match (@matches) { 764: $match=~/\[ (\w+)\s(.*) \]/; 765: my ($key,$value)=($1,$2); 766: my $replacement=''; 767: if ($key eq 'literal') { 768: $replacement="($dkey like \"\%$value\%\")"; 769: } 770: elsif ($key eq 'not') { 771: $value=~s/like/not like/; 772: # $replacement="($dkey not like $value)"; 773: $replacement="$value"; 774: } 775: elsif ($key eq 'and') { 776: $value=~/(.*[\"|\)]) ([|$|\^].*)/; 777: $replacement="($1 AND $2)"; 778: } 779: elsif ($key eq 'or') { 780: $value=~/(.*[\"|$]) ([|\(|\^].*)/; 781: $replacement="($1 OR $2)"; 782: } 783: substr($pattern, 784: index($pattern,$match), 785: length($match), 786: $replacement 787: ); 788: } 789: &recursive_SQL_query_build($dkey,$pattern); 790: } 791: 792: # ------------------------------------------------------------ Build date query 793: sub build_date_queries { 794: my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, 795: $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; 796: my @queries; 797: if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) { 798: unless ($cmonth1 and $cday1 and $cyear1 and 799: $cmonth2 and $cday2 and $cyear2) { 800: return "Incorrect entry for the creation date. You must specify ". 801: "a starting month, day, and year and an ending month, ". 802: "day, and year."; 803: } 804: my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1); 805: $cnumeric1+=0; 806: my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2); 807: $cnumeric2+=0; 808: if ($cnumeric1>$cnumeric2) { 809: return "Incorrect entry for the creation date. The starting ". 810: "date must occur before the ending date."; 811: } 812: my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '". 813: "$cyear2-$cmonth2-$cday2 23:59:59')"; 814: push @queries,$cquery; 815: } 816: if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) { 817: unless ($lmonth1 and $lday1 and $lyear1 and 818: $lmonth2 and $lday2 and $lyear2) { 819: return "Incorrect entry for the last revision date. You must ". 820: "specify a starting month, day, and year and an ending ". 821: "month, day, and year."; 822: } 823: my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1); 824: $lnumeric1+=0; 825: my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2); 826: $lnumeric2+=0; 827: if ($lnumeric1>$lnumeric2) { 828: return "Incorrect entry for the last revision date. The ". 829: "starting date must occur before the ending date."; 830: } 831: my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '". 832: "$lyear2-$lmonth2-$lday2 23:59:59')"; 833: push @queries,$lquery; 834: } 835: if (@queries) { 836: return join(" AND ",@queries); 837: } 838: return ''; 839: } 840: 841: # ----------------------------- format and output results based on a reply list 842: # There are two windows that this function writes to. The main search 843: # window ("srch") has a listing of the results. A secondary window ("popwin") 844: # gives the status of the network search (time elapsed, number of machines 845: # contacted, etc.) 846: sub output_results { 847: my $fnum; # search result counter 848: my ($mode,$r,$envhash,$query,$replyref)=@_; 849: my %ENV=%{$envhash}; 850: my %rhash=%{$replyref}; 851: my $compiledresult=''; 852: my $timeremain=300; 853: my $elapsetime=0; 854: my $resultflag=0; 855: my $tflag=1; 856: 857: # make query information persistent to allow for subsequent revision 858: my $persistent=&make_persistent(); 859: 860: # output beginning of search page 861: $r->print(<<BEGINNING); 862: <html> 863: <head> 864: <title>The LearningOnline Network with CAPA</title> 865: BEGINNING 866: 867: # conditional output of script functions dependent on the mode in 868: # which the search was invoked 869: $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'interactive'; 870: <script type="text/javascript"> 871: function select_data(title,url) { 872: changeTitle(title); 873: changeURL(url); 874: self.close(); 875: } 876: function changeTitle(val) { 877: if (opener.inf.document.forms.resinfo.elements.t) { 878: opener.inf.document.forms.resinfo.elements.t.value=val; 879: } 880: } 881: function changeURL(val) { 882: if (opener.inf.document.forms.resinfo.elements.u) { 883: opener.inf.document.forms.resinfo.elements.u.value=val; 884: } 885: } 886: </script> 887: SCRIPT 888: $r->print(<<SCRIPT) if $ENV{'form.catalogmode'} eq 'groupsearch'; 889: <script type="text/javascript"> 890: function select_data(title,url) { 891: // alert('DEBUG: Should be storing '+title+' and '+url); 892: } 893: function queue(val) { 894: if (eval("document.forms.results.returnvalues["+val+"].checked")) { 895: document.forms.results.acts.value+='1a'+val+'b'; 896: } 897: else { 898: document.forms.results.acts.value+='0a'+val+'b'; 899: } 900: } 901: function select_group() { 902: window.location="/adm/groupsort?catalogmode=groupsearch&acts="+ 903: document.forms.results.acts.value; 904: } 905: </script> 906: SCRIPT 907: $r->print(<<SCRIPT); 908: <script type="text/javascript"> 909: function displayinfo(val) { 910: popwin.document.forms.popremain.sdetails.value=val; 911: } 912: function openhelp(val) { 913: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 914: 'scrollbars=1,width=400,height=300'); 915: openhelpwin.focus(); 916: } 917: function abortsearch(val) { 918: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 919: 'scrollbars=1,width=400,height=300'); 920: openhelpwin.focus(); 921: } 922: </script> 923: SCRIPT 924: $r->rflush(); 925: 926: # begin showing the cataloged results 927: $r->print(<<CATALOGBEGIN); 928: </head> 929: <body bgcolor="#ffffff"> 930: <img align=right src=/adm/lonIcons/lonlogos.gif> 931: <h1>Search Catalog</h1> 932: CATALOGBEGIN 933: $r->print(<<CATALOGCONTROLS); 934: <form name='results' method="post" action="/adm/searchcat"> 935: <input type='hidden' name='acts' value='' /> 936: <input type='button' value='Revise search request' 937: onClick='this.form.submit();' /> 938: $importbutton 939: $closebutton 940: $persistent 941: <hr /> 942: <h3>Search Query</h3> 943: CATALOGCONTROLS 944: if ($mode eq 'Basic') { 945: $r->print(<<RESULTS); 946: <p> 947: <b>Basic search:</b> $ENV{'form.basicexp'} 948: </p> 949: RESULTS 950: } 951: elsif ($mode eq 'Advanced') { 952: $r->print(<<RESULTS); 953: <p> 954: <b>Advanced search</b> 955: $query 956: </p> 957: RESULTS 958: } 959: $r->print('<h3>Search Results</h3>'); 960: $r->rflush(); 961: my $servernum=(keys %rhash)+0; 962: 963: # define server grid (shows status of multiple machines) 964: my $hcinit; 965: my $grid="'<br />'+"; 966: $grid.="\n"; 967: my $sn=1; 968: for my $sk (sort keys %rhash) { 969: # '<a href=" 970: $grid.="'<a href=\""; 971: # javascript:displayinfo('+ 972: $grid.="javascript:opener.displayinfo('+"; 973: # "'"+'key 974: $grid.="\"'\"+'"; 975: $grid.=$sk; 976: my $hc; 977: if ($rhash{$sk} eq 'con_lost') { 978: $hc="!!!BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR!!!"; 979: } 980: else { 981: $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'"; 982: $hcinit.="hc[\"$sk\"]=\"not yet connected...\";"; 983: } 984: $grid.=" hitcount=".$hc; 985: $grid.=" domain=".$hostdomains{$sk}; 986: $grid.=" IP=".$hostips{$sk}; 987: # '+"'"+'">'+ 988: $grid.="'+\"'\"+')\">'+"; 989: $grid.="\n"; 990: $grid.="'<img border=\"0\" name=\"img".$sn."\"". 991: " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" /></a>'+\n"; 992: $grid.="'<br />'+\n" unless $sn%10; 993: $sn++; 994: } 995: $r->print(<<ENDPOP); 996: <script type="text/javascript"> 997: popwin=open('','popwin','scrollbars=1,width=400,height=200'); 998: popwin.focus(); 999: popwin.document.writeln('<'+'html>'); 1000: popwin.document.writeln('<'+'head>'); 1001: popwin.document.writeln('<'+'script>'); 1002: popwin.document.writeln('hc=new Array();$hcinit'); 1003: popwin.document.writeln('<'+'/script>'); 1004: popwin.document.writeln('<'+'/head>'+ 1005: '<'+'body bgcolor="#FFFFFF">'+ 1006: '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+ 1007: 'lonanim.gif" '+ 1008: 'alt="animated logo" />'+ 1009: '<'+'h3>Search Results Progress<'+'/h3>'+ 1010: '<'+'form name="popremain">'+ 1011: '<'+'tt>'+ 1012: '<'+'br clear="all"/><i>PLEASE BE PATIENT</i>'+ 1013: '<'+'br />SCANNING $servernum SERVERS'+ 1014: '<'+'br clear="all" />Number of record hits found '+ 1015: '<'+'input type="text" size="10" name="numhits"'+ 1016: ' value="0" />'+ 1017: '<'+'br clear="all" />Time elapsed '+ 1018: '<'+'input type="text" size="10" name="elapsetime"'+ 1019: ' value="0" />'+ 1020: '<'+'br />'+ 1021: 'SERVER GRID (click on any cell for details)'+ 1022: $grid 1023: '<'+'br />'+ 1024: 'Server details '+ 1025: '<'+'input type="text" size="25" name="sdetails"'+ 1026: ' value="" />'+ 1027: '<'+'br />'+ 1028: ' <'+'input type="button" name="button"'+ 1029: ' value="abort search and view current results" '+ 1030: ' onClick="javascript:opener.abortsearch()" />'+ 1031: ' <'+'input type="button" name="button"'+ 1032: ' value="help" onClick="javascript:opener.openhelp()" />'+ 1033: '<'+'/tt>'+ 1034: '<'+'/form>'+ 1035: '<'+'/body><'+'/html>'); 1036: popwin.document.close(); 1037: </script> 1038: ENDPOP 1039: $r->rflush(); 1040: 1041: my $servercount=0; 1042: my $hitcountsum=0; 1043: my $bloop=$servernum; 1044: my %orkey; 1045: BLOOP: while(1) { 1046: my $sn=0; 1047: last BLOOP unless $bloop; 1048: last BLOOP unless $timeremain; 1049: RLOOP: foreach my $rkey (sort keys %rhash) { 1050: $sn++; 1051: next RLOOP if $orkey{$rkey}; 1052: $servercount++; 1053: $tflag=1; 1054: $compiledresult=''; 1055: my $hostname=$rkey; 1056: my $reply=$rhash{$rkey}; 1057: my @results; 1058: 1059: my $replyfile=''; 1060: 1061: if ($reply eq 'con_lost') { 1062: $r->print('<script type="text/javascript">popwin.document.img'. 1063: $sn.'.'. 1064: 'src="/adm/lonIcons/srvbad.gif";</script>'. 1065: "\n"); 1066: $r->rflush(); 1067: $bloop--; 1068: $orkey{$rkey}=1; 1069: } 1070: else { 1071: $reply=~/^([\.\w]+)$/; # must do since 'use strict' checks for tainting 1072: $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; 1073: $reply=~/(.*?)\_/; 1074: { 1075: my $temp=0; 1076: WLOOP: while (1) { 1077: if (-e $replyfile && $tflag) { 1078: $r->print('<script type="text/javascript">'. 1079: 'popwin.document.img'.$sn.'.'. 1080: 'src="/adm/lonIcons/srvhalf.gif";</script>'. 1081: "\n"); 1082: $r->rflush(); 1083: $r->print('<script type="text/javascript">'. 1084: 'popwin.hc["'.$rkey.'"]='. 1085: '"still transferring..."'.';</script>'. 1086: "\n"); 1087: $r->rflush(); 1088: $tflag=0; 1089: } 1090: if (-e "$replyfile.end") { 1091: $bloop--; 1092: $orkey{$rkey}=1; 1093: if (-s $replyfile) { 1094: $r->print('<script type="text/javascript">'. 1095: 'popwin.document.img'.$sn.'.'. 1096: 'src="/adm/lonIcons/srvgood.gif";'. 1097: '</script>'."\n"); 1098: $r->rflush(); 1099: my $fh=Apache::File->new($replyfile) or 1100: ($r->print('ERROR: file '. 1101: $replyfile.' cannot be opened') and 1102: return OK); 1103: @results=<$fh> if $fh; 1104: $hitcount{$rkey}=@results+0; 1105: $r->print('<script type="text/javascript">'. 1106: 'popwin.hc["'.$rkey.'"]='. 1107: $hitcount{$rkey}.';</script>'. 1108: "\n"); 1109: $r->rflush(); 1110: $hitcountsum+=$hitcount{$rkey}; 1111: $r->print('<script type="text/javascript">'. 1112: 'popwin.document.forms.popremain.'. 1113: 'numhits.value='.$hitcountsum. 1114: ';</script>'. 1115: "\n"); 1116: $r->rflush(); 1117: } 1118: else { 1119: $r->print('<script type="text/javascript">'. 1120: 'popwin.document.img'.$sn.'.'. 1121: 'src="/adm/lonIcons/srvempty.gif";'. 1122: '</script>'. 1123: "\n"); 1124: $r->rflush(); 1125: $r->print('<script type="text/javascript">'. 1126: 'popwin.hc["'.$rkey.'"]=0'. 1127: ';</script>'. 1128: "\n"); 1129: $r->rflush(); 1130: } 1131: last WLOOP; 1132: } 1133: if ($temp>1) { 1134: sleep 1; 1135: $timeremain--; 1136: $elapsetime++; 1137: last WLOOP; 1138: } 1139: last WLOOP unless $timeremain; 1140: sleep 1; 1141: $timeremain--; 1142: $elapsetime++; 1143: $r->print('<script type="text/javascript">'. 1144: 'popwin.document.popremain.elapsetime.'. 1145: 'value="'.$elapsetime.'";</script>'."\n"); 1146: $r->rflush(); 1147: $temp++; 1148: } 1149: } 1150: $r->print('<script type="text/javascript">'. 1151: 'popwin.document.whirly.'. 1152: 'src="'.'/adm/lonIcons/lonanimend.gif'. 1153: '";</script>'."\n"); 1154: $r->rflush(); 1155: } 1156: my $customshow=''; 1157: my $extrashow=''; 1158: my @customfields; 1159: if ($ENV{'form.customshow'}) { 1160: $customshow=$ENV{'form.customshow'}; 1161: $customshow=~s/[^\w\s]//g; 1162: my @fields=map {"<font color=\"#008000\">$_:</font>"} 1163: split(/\s+/,$customshow); 1164: @customfields=split(/\s+/,$customshow); 1165: if ($customshow) { 1166: $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n"; 1167: } 1168: } 1169: my $customdata=''; 1170: my %customhash; 1171: foreach my $result (@results) { 1172: if ($result=~/^(custom\=.*)$/) { # grab all custom metadata 1173: my $tmp=$result; 1174: $tmp=~s/^custom\=//; 1175: my ($k,$v)=map {&Apache::lonnet::unescape($_); 1176: } split(/\,/,$tmp); 1177: $customhash{$k}=$v; 1178: } 1179: } 1180: if (keys %hash) { 1181: untie %hash; 1182: } 1183: if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { 1184: if ($ENV{'form.launch'} eq '1') { 1185: &start_fresh_session(); 1186: } 1187: foreach my $result (@results) { 1188: next if $result=~/^custom\=/; 1189: chomp $result; 1190: next unless $result; 1191: my @fields=map 1192: {&Apache::lonnet::unescape($_)} 1193: (split(/\,/,$result)); 1194: my ($title,$author,$subject,$url,$keywords,$version, 1195: $notes,$abstract,$mime,$lang, 1196: $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; 1197: 1198: unless ($ENV{'user.adv'}) { 1199: $keywords='<i>- not displayed -</i>'; 1200: $fields[4]=$keywords; 1201: $notes='<i>- not displayed -</i>'; 1202: $fields[6]=$notes; 1203: $abstract='<i>- not displayed -</i>'; 1204: $fields[7]=$abstract; 1205: $subject='<i>- not displayed -</i>'; 1206: $fields[2]=$subject; 1207: } 1208: 1209: my $shortabstract=$abstract; 1210: $shortabstract=substr($abstract,0,200).'...' if length($abstract)>200; 1211: $fields[7]=$shortabstract; 1212: my $shortkeywords=$keywords; 1213: $shortkeywords=substr($keywords,0,200).'...' if length($keywords)>200; 1214: $fields[4]=$shortkeywords; 1215: 1216: my $extrashow2=$extrashow; 1217: if ($extrashow) { 1218: foreach my $field (@customfields) { 1219: my $value=''; 1220: if ($customhash{$url}=~/\<${field}[^\>]*\>(.*?)\<\/${field}[^\>]*\>/s) { 1221: $value=$1; 1222: } 1223: $extrashow2=~s/\<\!\-\- $field \-\-\>/ $value/g; 1224: } 1225: } 1226: 1227: $compiledresult.=<<END if $compiledresult or $servercount!=$servernum; 1228: <hr align='left' width='200' noshade /> 1229: END 1230: $compiledresult.=<<END; 1231: <p> 1232: END 1233: if ($ENV{'form.catalogmode'} eq 'interactive') { 1234: my $titleesc=$title; 1235: $titleesc=~s/\'/\\'/; 1236: 1237: $compiledresult.=<<END 1238: if $ENV{'form.catalogmode'} eq 'interactive'; 1239: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT" 1240: onClick="javascript:select_data('$titleesc','$url')"> 1241: </font> 1242: <br /> 1243: END 1244: } 1245: if ($ENV{'form.catalogmode'} eq 'groupsearch') { 1246: $fnum+=0; 1247: $hash{"pre_${fnum}_link"}=$url; 1248: $hash{"pre_${fnum}_title"}=$title; 1249: $compiledresult.=<<END; 1250: <font size='-1'><input type="checkbox" name="returnvalues" value="SELECT" 1251: onClick="javascript:queue($fnum)" /> 1252: </font> 1253: <br /> 1254: END 1255: # <input type="hidden" name="title$fnum" value="$title" /> 1256: # <input type="hidden" name="url$fnum" value="$url" /> 1257: $fnum++; 1258: } 1259: my $httphost=$ENV{'HTTP_HOST'}; 1260: 1261: my $viewselect; 1262: if ($mode eq 'Basic') { 1263: $viewselect=$ENV{'form.basicviewselect'}; 1264: } 1265: elsif ($mode eq 'Advanced') { 1266: $viewselect=$ENV{'form.advancedviewselect'}; 1267: } 1268: 1269: if ($viewselect eq 'Detailed Citation View') { 1270: $compiledresult.=&detailed_citation_view(@fields, 1271: $hostname,$httphost, 1272: $extrashow2); 1273: } 1274: elsif ($viewselect eq 'Summary View') { 1275: $compiledresult.=&summary_view(@fields,$hostname,$httphost, 1276: $extrashow2); 1277: } 1278: elsif ($viewselect eq 'Fielded Format') { 1279: $compiledresult.=&fielded_format_view(@fields,$hostname, 1280: $httphost,$extrashow2); 1281: } 1282: elsif ($viewselect eq 'XML/SGML') { 1283: $compiledresult.=&xml_sgml_view(@fields,$hostname,$httphost, 1284: $extrashow2); 1285: } 1286: 1287: } 1288: 1289: untie %hash; 1290: } 1291: else { 1292: $r->print('<html><head></head><body>Unable to tie hash to db '. 1293: 'file</body></html>'); 1294: } 1295: if ($compiledresult) { 1296: $resultflag=1; 1297: } 1298: 1299: $r->print(<<RESULTS); 1300: $compiledresult 1301: RESULTS 1302: my $percent=sprintf('%3.0f',($servercount/$servernum*100)); 1303: } 1304: } 1305: unless ($resultflag) { 1306: $r->print("\nThere were no results that matched your query\n"); 1307: } 1308: # $r->print('<script type="text/javascript">'.'popwin.close()</script>'."\n"); $r->rflush(); 1309: $r->print(<<RESULTS); 1310: </body> 1311: </html> 1312: RESULTS 1313: } 1314: 1315: # ------------------------------------------------------ Detailed Citation View 1316: sub detailed_citation_view { 1317: my ($title,$author,$subject,$url,$keywords,$version, 1318: $notes,$shortabstract,$mime,$lang, 1319: $creationdate,$lastrevisiondate,$owner,$copyright, 1320: $hostname,$httphost,$extrashow)=@_; 1321: my $result=<<END; 1322: <i>$owner</i>, last revised $lastrevisiondate 1323: <h3><A HREF="http://$httphost$url" TARGET='search_preview'>$title</A></h3> 1324: <h3>$author</h3> 1325: </p> 1326: <p> 1327: <b>Subject:</b> $subject<br /> 1328: <b>Keyword(s):</b> $keywords<br /> 1329: <b>Notes:</b> $notes<br /> 1330: <b>MIME Type:</b> 1331: END 1332: $result.=&Apache::loncommon::filedescription($mime); 1333: $result.=<<END; 1334: <br /> 1335: <b>Language:</b> 1336: END 1337: $result.=&Apache::loncommon::languagedescription($lang); 1338: $result.=<<END; 1339: <br /> 1340: <b>Copyright/Distribution:</b> 1341: END 1342: $result.=&Apache::loncommon::copyrightdescription($copyright); 1343: $result.=<<END; 1344: <br /> 1345: </p> 1346: $extrashow 1347: <p> 1348: $shortabstract 1349: </p> 1350: END 1351: return $result; 1352: } 1353: 1354: # ---------------------------------------------------------------- Summary View 1355: sub summary_view { 1356: my ($title,$author,$subject,$url,$keywords,$version, 1357: $notes,$shortabstract,$mime,$lang, 1358: $creationdate,$lastrevisiondate,$owner,$copyright, 1359: $hostname,$httphost,$extrashow)=@_; 1360: my $cprtag=&Apache::loncommon::copyrightdescription($copyright); 1361: my $result=<<END; 1362: <a href="http://$httphost$url" TARGET='search_preview'>$author</a><br /> 1363: $title<br /> 1364: $owner -- $lastrevisiondate<br /> 1365: $cprtag<br /> 1366: $extrashow 1367: </p> 1368: END 1369: return $result; 1370: } 1371: 1372: # -------------------------------------------------------------- Fielded Format 1373: sub fielded_format_view { 1374: my ($title,$author,$subject,$url,$keywords,$version, 1375: $notes,$shortabstract,$mime,$lang, 1376: $creationdate,$lastrevisiondate,$owner,$copyright, 1377: $hostname,$httphost,$extrashow)=@_; 1378: my $mimetag=&Apache::loncommon::filedescription($mime); 1379: my $language=&Apache::loncommon::languagedescription($lang); 1380: my $cprtag=&Apache::loncommon::copyrightdescription($copyright); 1381: my $result=<<END; 1382: <b>URL: </b> <A HREF="http://$httphost$url" TARGET='search_preview'>$url</A> 1383: <br /> 1384: <b>Title:</b> $title<br /> 1385: <b>Author(s):</b> $author<br /> 1386: <b>Subject:</b> $subject<br /> 1387: <b>Keyword(s):</b> $keywords<br /> 1388: <b>Notes:</b> $notes<br /> 1389: <b>MIME Type:</b> $mimetag<br /> 1390: <b>Language:</b> $language<br /> 1391: <b>Creation Date:</b> $creationdate<br /> 1392: <b>Last Revision Date:</b> $lastrevisiondate<br /> 1393: <b>Publisher/Owner:</b> $owner<br /> 1394: <b>Copyright/Distribution:</b> $cprtag<br /> 1395: <b>Repository Location:</b> $hostname<br /> 1396: <b>Abstract:</b> $shortabstract<br /> 1397: $extrashow 1398: </p> 1399: END 1400: return $result; 1401: } 1402: 1403: # -------------------------------------------------------------------- XML/SGML 1404: sub xml_sgml_view { 1405: my ($title,$author,$subject,$url,$keywords,$version, 1406: $notes,$shortabstract,$mime,$lang, 1407: $creationdate,$lastrevisiondate,$owner,$copyright, 1408: $hostname,$httphost,$extrashow)=@_; 1409: my $cprtag=&Apache::loncommon::copyrightdescription($copyright); 1410: my $mimetag=&Apache::loncommon::filedescription($mime); 1411: my $language=&Apache::loncommon::languagedescription($lang); 1412: my $result=<<END; 1413: <pre> 1414: <LonCapaResource> 1415: <url>$url</url> 1416: <title>$title</title> 1417: <author>$author</author> 1418: <subject>$subject</subject> 1419: <keywords>$keywords</keywords> 1420: <notes>$notes</notes> 1421: <mimeInfo> 1422: <mime>$mime</mime> 1423: <mimetag>$mimetag</mimetag> 1424: </mimeInfo> 1425: <languageInfo> 1426: <language>$lang</language> 1427: <languagetag>$language</languagetag> 1428: </languageInfo> 1429: <creationdate>$creationdate</creationdate> 1430: <lastrevisiondate>$lastrevisiondate</lastrevisiondate> 1431: <owner>$owner</owner> 1432: <copyrightInfo> 1433: <copyright>$copyright</copyright> 1434: <copyrighttag>$cprtag</copyrighttag> 1435: </copyrightInfo> 1436: <repositoryLocation>$hostname</repositoryLocation> 1437: <shortabstract>$shortabstract</shortabstract> 1438: </LonCapaResource> 1439: </pre> 1440: $extrashow 1441: END 1442: return $result; 1443: } 1444: 1445: # ---------------------------------------------------- see if a field is filled 1446: sub filled { 1447: my ($field)=@_; 1448: if ($field=~/\S/ && $field ne 'any') { 1449: return 1; 1450: } 1451: else { 1452: return 0; 1453: } 1454: } 1455: 1456: # ---------------- Message to output when there are not enough fields filled in 1457: sub output_blank_field_error { 1458: my ($r)=@_; 1459: # make query information persistent to allow for subsequent revision 1460: my $persistent=&make_persistent(); 1461: 1462: $r->print(<<BEGINNING); 1463: <html> 1464: <head> 1465: <title>The LearningOnline Network with CAPA</title> 1466: BEGINNING 1467: $r->print(<<RESULTS); 1468: </head> 1469: <body bgcolor="#ffffff"> 1470: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 1471: <h1>Search Catalog</h1> 1472: <form method="post" action="/adm/searchcat"> 1473: $persistent 1474: <input type='button' value='Revise search request' 1475: onClick='this.form.submit();' /> 1476: $closebutton 1477: <hr /> 1478: <h3>Helpful Message</h3> 1479: <p> 1480: Incorrect search query due to blank entry fields. 1481: You need to fill in the relevant 1482: fields on the search page in order for a query to be 1483: processed. 1484: </p> 1485: </body> 1486: </html> 1487: RESULTS 1488: } 1489: 1490: # ----------------------------------------------------------- Output date error 1491: sub output_date_error { 1492: my ($r,$message)=@_; 1493: # make query information persistent to allow for subsequent revision 1494: my $persistent=&make_persistent(); 1495: 1496: $r->print(<<BEGINNING); 1497: <html> 1498: <head> 1499: <title>The LearningOnline Network with CAPA</title> 1500: BEGINNING 1501: $r->print(<<RESULTS); 1502: </head> 1503: <body bgcolor="#ffffff"> 1504: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 1505: <h1>Search Catalog</h1> 1506: <form method="post" action="/adm/searchcat"> 1507: $persistent 1508: <input type='button' value='Revise search request' 1509: onClick='this.form.submit();' /> 1510: $closebutton 1511: <hr /> 1512: <h3>Helpful Message</h3> 1513: <p> 1514: $message 1515: </p> 1516: </body> 1517: </html> 1518: RESULTS 1519: } 1520: 1521: # --------- settings whenever the user causes the search window to be launched 1522: sub start_fresh_session { 1523: delete $hash{'mode_catalog'}; 1524: foreach (keys %hash) { 1525: if ($_ =~ /^pre_/) { 1526: delete $hash{$_}; 1527: } 1528: if ($_ =~ /^store/) { 1529: delete $hash{$_}; 1530: } 1531: } 1532: } 1533: 1534: 1; 1535: 1536: __END__ 1537: 1538: =head1 NAME 1539: 1540: Apache::lonsearchcat - mod_perl module for handling a searchable catalog 1541: 1542: =head1 SYNOPSIS 1543: 1544: Invoked by /etc/httpd/conf/srm.conf: 1545: 1546: <Location /adm/searchcat> 1547: PerlAccessHandler Apache::lonacc 1548: SetHandler perl-script 1549: PerlHandler Apache::lonsearchcat 1550: ErrorDocument 403 /adm/login 1551: ErrorDocument 500 /adm/errorhandler 1552: </Location> 1553: 1554: =head1 INTRODUCTION 1555: 1556: This module enables searching for a distributed browseable catalog. 1557: 1558: This is part of the LearningOnline Network with CAPA project 1559: described at http://www.lon-capa.org. 1560: 1561: =head1 BEGIN SUBROUTINE 1562: 1563: This routine is only run once after compilation. 1564: 1565: =over 4 1566: 1567: =item * 1568: 1569: Initializes %hostdomains and hostips hash table (for hosts.tab). 1570: 1571: =back 1572: 1573: =head1 HANDLER SUBROUTINE 1574: 1575: This routine is called by Apache and mod_perl. 1576: 1577: =over 4 1578: 1579: =item * 1580: 1581: configure dynamic components of interface 1582: 1583: =item * 1584: 1585: determine current user 1586: 1587: =item * 1588: 1589: see if a search invocation should be done 1590: 1591: =item * 1592: 1593: else, begin building search interface to output 1594: 1595: =item * 1596: 1597: compute date selection boxes 1598: 1599: =item * 1600: 1601: compute customized metadata field 1602: 1603: =item * 1604: 1605: print screen 1606: 1607: =back 1608: 1609: =head1 OTHER SUBROUTINES 1610: 1611: =over 4 1612: 1613: =item * 1614: 1615: get_unprocessed_cgi() : reads in critical name/value pairs that may have not 1616: been processed and passed into %ENV by the web server 1617: 1618: =item * 1619: 1620: make_persistent() : makes a set of hidden HTML fields to make 1621: SQL search interface information to be persistent 1622: 1623: =back 1624: 1625: WEB INTERFACE COMPONENT FUNCTIONS 1626: 1627: =over 4 1628: 1629: =item * 1630: 1631: simpletextfield(name,value) : returns HTML formatted string for simple text 1632: field 1633: 1634: =item * 1635: 1636: simplecheckbox(name,value) : returns HTML formatted string for simple 1637: checkbox 1638: 1639: =item * 1640: 1641: searchphrasefield(title,name,value) : returns HTML formatted string for 1642: a search expression phrase field 1643: 1644: =item * 1645: 1646: dateboxes(name, defaultmonth, defaultday, defaultyear) : returns HTML 1647: formatted string for a calendar date 1648: 1649: =item * 1650: 1651: selectbox(title,name,value,%HASH=options) : returns HTML formatted string for 1652: a selection box field 1653: 1654: =back 1655: 1656: SEARCH FUNCTIONS 1657: 1658: =over 4 1659: 1660: =item * 1661: 1662: advancedsearch(server reference, environment reference) : perform a complex 1663: multi-field logical query 1664: 1665: =item * 1666: 1667: basicsearch(server reference, environment reference) : perform a simple 1668: single-field logical query 1669: 1670: =item * 1671: 1672: build_SQL_query(field name, logic) : builds a SQL query string from a 1673: logical expression with AND/OR keywords 1674: 1675: =item * 1676: 1677: build_custommetadata_query(field_name, logic_statement) : builds a perl 1678: regular expression from a logical expression with AND/OR keywords 1679: 1680: =item * 1681: 1682: recursive_SQL_query_build(field name, reverse notation expression) : 1683: builds a SQL query string from a reverse notation expression 1684: logical expression with AND/OR keywords 1685: 1686: =item * 1687: 1688: build_date_queries(cmonth1, cday1, cyear1, cmonth2, cday2, cyear2, 1689: lmonth1, lday1, lyear1, lmonth2, lday2, lyear2) : 1690: Builds a SQL logic query to check time/date entries. 1691: 1692: =back 1693: 1694: OUTPUTTING RESULTS FUNCTION 1695: 1696: =over 4 1697: 1698: =item * 1699: 1700: output_results(output mode, server reference, environment reference, 1701: reply list reference) : outputs results from search 1702: 1703: =back 1704: 1705: DIFFERENT WAYS TO VIEW METADATA RECORDS 1706: 1707: =over 4 1708: 1709: =item * 1710: 1711: detailed_citation_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : 1712: see metadata viewing notes below 1713: 1714: =item * 1715: 1716: summary_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : 1717: see metadata viewing notes below 1718: 1719: =item * 1720: 1721: fielded_format_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : 1722: see metadata viewing notes below 1723: 1724: =item * 1725: 1726: xml_sgml_view(ORDERED METADATA LIST FOR A RESULT OBJECT INSTANCE) : 1727: see metadata viewing notes below 1728: 1729: =back 1730: 1731: _____________________________________________________________________ 1732: | * Metadata viewing notes | 1733: | Output is a HTML-ified string. | 1734: | Input arguments are title, author, subject, url, keywords, version, | 1735: | notes, short abstract, mime, language, creation date, | 1736: | last revision date, owner, copyright, hostname, httphost, and | 1737: | extra custom metadata to show. | 1738: --------------------------------------------------------------------- 1739: 1740: TEST CONDITIONAL FUNCTIONS 1741: 1742: =over 4 1743: 1744: =item * 1745: 1746: filled(field) : determines whether a given field has been filled 1747: 1748: =back 1749: 1750: ERROR FUNCTIONS 1751: 1752: =over 4 1753: 1754: =item * 1755: 1756: output_blank_field_error(server reference) : outputs a message saying that 1757: more fields need to be filled in 1758: 1759: =item * 1760: 1761: output_date_error(server reference, error message) : outputs 1762: an error message specific to bad date format. 1763: 1764: =back 1765: 1766: =cut