loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.119: download - view: text, annotated - select for diffs
Wed May 22 16:21:50 2002 UTC (22 years ago) by www
Branches: MAIN
CVS tags: HEAD

Stupid hack to keep people from pressing "Search", "Search", "Search", ...
when slow in response

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