loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.117: download - view: text, annotated - select for diffs
Fri Mar 8 18:36:00 2002 UTC (22 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: stable_2002_april, HEAD

Changes to support calling from construction space (see edit::search and
lonxml for javascript hooks).  Many code cleanups, including the utility
functions popwin_js and popwin_imgupdate, for communicating with the
search status window.

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