loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.120: download - view: text, annotated - select for diffs
Mon Jun 10 23:55:47 2002 UTC (22 years ago) by harris41
Branches: MAIN
CVS tags: HEAD

adding selected="true" to the view selection lists (basic and
advanced)

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