loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.126: download - view: text, annotated - select for diffs
Mon Jun 24 15:09:52 2002 UTC (21 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

More POD documentation - still not enough.
Removed some debugging code from &build_custommetatdata_query.
&output_results():
    Replaced 'WLOOP' with logically equivalent for loop.
    Changed calling structure for *_view routines - now takes a hash as
        input instead of an ordered list.
    Moved results parsing to new subroutine &parse_raw_result, which
        returns a hash to be passed to the *_view routines.
    Moved some custom field handling routines to a new subroutine
        &handle_custom_fields.
    Cleaned up a little of the HTML output.
&parse_raw_result unescapes (hopefully intelligently) its inputs.
&detailed_citation_view, &summary_view, &fielded_format_view, and
    &xml_sgm_view all use the new calling structure (hash).
Removed remainder of old POD documentation - most of this was moved to the
per-function POD documentation.

1: # The LearningOnline Network with CAPA 2: # Search Catalog 3: # 4: # $Id: lonsearchcat.pm,v 1.126 2002/06/24 15:09:52 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: # 6/17 Matthew Hall 35: # 36: ############################################################################### 37: ############################################################################### 38: 39: =pod 40: 41: =head1 NAME 42: 43: lonsearchcat 44: 45: =head1 SYNOPSIS 46: 47: Search interface to LON-CAPAs digital library 48: 49: =head1 DESCRIPTION 50: 51: This module enables searching for a distributed browseable catalog. 52: 53: This is part of the LearningOnline Network with CAPA project 54: described at http://www.lon-capa.org. 55: 56: lonsearchcat presents the user with an interface to search the LON-CAPA 57: digital library. lonsearchcat also initiates the execution of a search 58: by sending the search parameters to LON-CAPA servers. The progress of 59: search (on a server basis) is displayed to the user in a seperate window. 60: 61: =head1 Internals 62: 63: =over 4 64: 65: =cut 66: 67: ############################################################################### 68: ############################################################################### 69: 70: ## ## 71: ## ORGANIZATION OF THIS PERL MODULE ## 72: ## ## 73: ## 1. Modules used by this module ## 74: ## 2. Choices for different output views (detailed, summary, xml, etc) ## 75: ## 3. BEGIN block (to be run once after compilation) ## 76: ## 4. Handling routine called via Apache and mod_perl ## 77: ## 5. Other subroutines ## 78: ## ## 79: ############################################################################### 80: 81: package Apache::lonsearchcat; 82: 83: # ------------------------------------------------- modules used by this module 84: use strict; 85: use Apache::Constants qw(:common); 86: use Apache::lonnet(); 87: use Apache::File(); 88: use CGI qw(:standard); 89: use Text::Query; 90: use GDBM_File; 91: use Apache::loncommon(); 92: 93: # ---------------------------------------- variables used throughout the module 94: 95: ###################################################################### 96: ###################################################################### 97: 98: =pod 99: 100: =item Global variables 101: 102: =over 4 103: 104: =item %hostdomains 105: 106: matches host name to host domain 107: 108: =item %hostips 109: 110: matches host name to host ip 111: 112: =item %hitcount 113: 114: stores number of hits per host 115: 116: =item $closebutton 117: 118: button that closes the search window 119: 120: =item $importbutton 121: 122: button to take the selecte results and go to group sorting 123: 124: =item %hash 125: 126: The ubiquitous database hash 127: 128: =item $diropendb 129: 130: The full path to the (temporary) search database file. This is set and 131: used in &handler() and is also used in &output_results(). 132: 133: =back 134: 135: =cut 136: 137: ###################################################################### 138: ###################################################################### 139: 140: # -- information holders 141: my %hostdomains; # matches host name to host domain 142: my %hostips; # matches host name to host ip 143: my %hitcount; # stores number of hits per host 144: 145: # -- dynamically rendered interface components 146: my $closebutton; # button that closes the search window 147: my $importbutton; # button to take the selected results and go to group sorting 148: 149: # -- miscellaneous variables 150: my $yourself; # allows for quickly limiting to oneself 151: my %hash; # database hash 152: 153: # ------------------------------------------ choices for different output views 154: # Detailed Citation View ---> sub detailed_citation_view 155: # Summary View ---> sub summary_view 156: # Fielded Format ---> sub fielded_format_view 157: # XML/SGML ---> sub xml_sgml_view 158: 159: #------------------------------------------------------------- global variables 160: my $diropendb = ""; 161: my $domain = ""; 162: 163: # ----------------------------------------------------------------------- BEGIN 164: 165: =pod 166: 167: =item BEGIN block 168: 169: Load %hostdomains and %hostips with data from lonnet.pm. Only library 170: servers are considered. 171: 172: =cut 173: 174: BEGIN { 175: foreach (keys (%Apache::lonnet::libserv)) { 176: $hostdomains{$_}=$Apache::lonnet::hostdom{$_}; 177: $hostips{$_}=$Apache::lonnet::hostip{$_}; 178: } 179: } 180: 181: ###################################################################### 182: ###################################################################### 183: 184: =pod 185: 186: =item &handler() - main handler invoked by httpd child 187: 188: =item Variables 189: 190: =over 4 191: 192: =item $hidden 193: 194: holds 'hidden' html forms 195: 196: =item $scrout 197: 198: string that holds portions of the screen output 199: 200: =back 201: 202: =cut 203: 204: ###################################################################### 205: ###################################################################### 206: sub handler { 207: my $r = shift; 208: untie %hash; 209: 210: $r->content_type('text/html'); 211: $r->send_http_header; 212: return OK if $r->header_only; 213: 214: my $domain = $r->dir_config('lonDefDomain'); 215: $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). 216: "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db"; 217: 218: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 219: ['catalogmode','launch','acts','mode','form','element', 220: 'reqinterface']); 221: ## 222: ## Clear out old values from database 223: ## 224: if ($ENV{'form.launch'} eq '1') { 225: if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { 226: &start_fresh_session(); 227: untie %hash; 228: } else { 229: $r->print('<html><head></head><body>Unable to tie hash to db '. 230: 'file</body></html>'); 231: return OK; 232: } 233: } 234: ## 235: ## Produce some output, so people know it is working 236: ## 237: $r->print("\n"); 238: $r->rflush; 239: ## 240: ## Configure dynamic components of interface 241: ## 242: my $hidden; # Holds 'hidden' html forms 243: if ($ENV{'form.catalogmode'} eq 'interactive') { 244: $hidden="<input type='hidden' name='catalogmode' value='interactive'>". 245: "\n"; 246: $closebutton="<input type='button' name='close' value='CLOSE' ". 247: "onClick='self.close()'>"."\n"; 248: } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { 249: $hidden=<<END; 250: <input type='hidden' name='catalogmode' value='groupsearch'> 251: END 252: $closebutton=<<END; 253: <input type='button' name='close' value='CLOSE' onClick='self.close()'> 254: END 255: $importbutton=<<END; 256: <input type='button' name='import' value='IMPORT' 257: onClick='javascript:select_group()'> 258: END 259: } 260: $hidden .= <<END; 261: <input type='hidden' name='mode' value='$ENV{'form.mode'}'> 262: <input type='hidden' name='form' value='$ENV{'form.form'}'> 263: <input type='hidden' name='element' value='$ENV{'form.element'}'> 264: <input type='hidden' name='date' value='2'> 265: END 266: ## 267: ## What are we doing? 268: ## 269: if ($ENV{'form.basicsubmit'} eq 'SEARCH') { 270: # Perform basic search and give results 271: return &basicsearch($r,\%ENV,$hidden); 272: } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') { 273: # Perform advanced search and give results 274: return &advancedsearch($r,\%ENV,$hidden); 275: } elsif ($ENV{'form.reqinterface'} eq 'advanced') { 276: # Output the advanced interface 277: $r->print(&advanced_search_form($closebutton,$hidden)); 278: return OK; 279: } else { 280: # Output normal search interface 281: $r->print(&basic_search_form($closebutton,$hidden)); 282: } 283: return OK; 284: } 285: 286: ###################################################################### 287: ###################################################################### 288: 289: =pod 290: 291: =item &basic_search_form() 292: 293: Returns a scalar which holds html for the basic search form. 294: 295: =cut 296: 297: ###################################################################### 298: ###################################################################### 299: 300: sub basic_search_form{ 301: my ($closebutton,$hidden) = @_; 302: my $scrout=<<"ENDDOCUMENT"; 303: <html> 304: <head> 305: <title>The LearningOnline Network with CAPA</title> 306: <script type="text/javascript"> 307: function openhelp(val) { 308: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 309: 'scrollbars=1,width=600,height=300'); 310: openhelpwin.focus(); 311: } 312: </script> 313: </head> 314: <body bgcolor="#FFFFFF"> 315: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 316: <h1>Search Catalog</h1> 317: <form method="post" action="/adm/searchcat"> 318: $hidden 319: <h3>Basic Search</h3> 320: <p> 321: Enter terms or phrases separated by AND, OR, or NOT then press SEARCH below. 322: </p> 323: <p> 324: <table> 325: <tr><td> 326: ENDDOCUMENT 327: $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40). 328: ' '; 329: # $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'}); 330: # $scrout.='<font color="#800000">Search historic archives</font>'; 331: $scrout.=<<ENDDOCUMENT; 332: </td><td><a href="/adm/searchcat?reqinterface=advanced">Advanced Search</a></td></tr></table> 333: </p> 334: <p> 335:  <input type="submit" name="basicsubmit" value='SEARCH' />  336: $closebutton 337:  338: <select name='basicviewselect'> 339: <option value='Detailed Citation View' selected="true"> 340: Detailed Citation View</option> 341: <option value='Summary View'>Summary View</option> 342: <option value='Fielded Format'>Fielded Format</option> 343: <option value='XML/SGML'>XML/SGML</option> 344: </select> 345:  346: <input type="button" value="HELP" onClick="openhelp()" /> 347: </p> 348: </form> 349: </body> 350: </html> 351: ENDDOCUMENT 352: return $scrout; 353: } 354: ###################################################################### 355: ###################################################################### 356: 357: =pod 358: 359: =item &advanced_search_form() 360: 361: Returns a scalar which holds html for the advanced search form. 362: 363: =cut 364: 365: ###################################################################### 366: ###################################################################### 367: 368: sub advanced_search_form{ 369: my ($closebutton,$hidden) = @_; 370: my $scrout=<<"ENDHEADER"; 371: <html> 372: <head> 373: <title>The LearningOnline Network with CAPA</title> 374: <script type="text/javascript"> 375: function openhelp(val) { 376: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 377: 'scrollbars=1,width=600,height=300'); 378: openhelpwin.focus(); 379: } 380: </script> 381: </head> 382: <body bgcolor="#FFFFFF"> 383: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 384: <h1>Search Catalog</h1> 385: <form method="post" action="/adm/searchcat"> 386: $hidden 387: <hr /> 388: <h3>Advanced Search</h3> 389: ENDHEADER 390: $scrout.=&searchphrasefield('Limit by title','title', 391: $ENV{'form.title'}); 392: $scrout.=&searchphrasefield('Limit by author','author', 393: $ENV{'form.author'}); 394: $scrout.=&searchphrasefield('Limit by subject','subject', 395: $ENV{'form.subject'}); 396: $scrout.=&searchphrasefield('Limit by keywords','keywords', 397: $ENV{'form.keywords'}); 398: $scrout.=&searchphrasefield('Limit by URL','url', 399: $ENV{'form.url'}); 400: # $scrout.=&searchphrasefield('Limit by version','version', 401: # $ENV{'form.version'}); 402: $scrout.=&searchphrasefield('Limit by notes','notes', 403: $ENV{'form.notes'}); 404: $scrout.=&searchphrasefield('Limit by abstract','abstract', 405: $ENV{'form.abstract'}); 406: $ENV{'form.mime'}='any' unless length($ENV{'form.mime'}); 407: $scrout.=&selectbox('Limit by MIME type','mime', 408: $ENV{'form.mime'}, 409: 'any','Any type', 410: \&{Apache::loncommon::filedescriptionex}, 411: (&Apache::loncommon::fileextensions)); 412: $ENV{'form.language'}='any' unless length($ENV{'form.language'}); 413: $scrout.=&selectbox('Limit by language','language', 414: $ENV{'form.language'},'any','Any Language', 415: \&{Apache::loncommon::languagedescription}, 416: (&Apache::loncommon::languageids), 417: ); 418: # ------------------------------------------------ Compute date selection boxes 419: $scrout.=<<CREATIONDATESTART; 420: <p> 421: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b> 422: </font> 423: <br /> 424: between: 425: CREATIONDATESTART 426: $scrout.=&dateboxes('creationdatestart',1,1,1976, 427: $ENV{'form.creationdatestart_month'}, 428: $ENV{'form.creationdatestart_day'}, 429: $ENV{'form.creationdatestart_year'}, 430: ); 431: $scrout.="and:\n"; 432: $scrout.=&dateboxes('creationdateend',12,31,2051, 433: $ENV{'form.creationdateend_month'}, 434: $ENV{'form.creationdateend_day'}, 435: $ENV{'form.creationdateend_year'}, 436: ); 437: $scrout.="</p>"; 438: $scrout.=<<LASTREVISIONDATESTART; 439: <p> 440: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE: 441: </b></font> 442: <br />between: 443: LASTREVISIONDATESTART 444: $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, 445: $ENV{'form.lastrevisiondatestart_month'}, 446: $ENV{'form.lastrevisiondatestart_day'}, 447: $ENV{'form.lastrevisiondatestart_year'}, 448: ); 449: $scrout.=<<LASTREVISIONDATEEND; 450: and: 451: LASTREVISIONDATEEND 452: $scrout.=&dateboxes('lastrevisiondateend',12,31,2051, 453: $ENV{'form.lastrevisiondateend_month'}, 454: $ENV{'form.lastrevisiondateend_day'}, 455: $ENV{'form.lastrevisiondateend_year'}, 456: ); 457: $scrout.='</p>'; 458: $scrout.=&searchphrasefield('Limit by publisher/owner','owner', 459: $ENV{'form.owner'}); 460: $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); 461: $scrout.=&selectbox('Limit by copyright/distribution','copyright', 462: $ENV{'form.copyright'}, 463: 'any','Any copyright/distribution', 464: \&{Apache::loncommon::copyrightdescription}, 465: (&Apache::loncommon::copyrightids), 466: ); 467: # ------------------------------------------- Compute customized metadata field 468: $scrout.=<<CUSTOMMETADATA; 469: <p> 470: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b> 471: </font> 472: For resource-specific metadata, enter in an expression in the form of 473: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br /> 474: <b>Example:</b> grandmother=75 OR grandfather=85 475: <br /> 476: CUSTOMMETADATA 477: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); 478: $scrout.=<<CUSTOMSHOW; 479: <p> 480: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b> 481: </font> 482: Enter in a space-separated list of special metadata fields to show 483: in a fielded listing for each record result. 484: <br /> 485: CUSTOMSHOW 486: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); 487: $scrout.=<<ENDDOCUMENT; 488: <p> 489: <input type="submit" name="advancedsubmit" value='SEARCH' /> 490: <input type="reset" name="reset" value='RESET' /> 491: $closebutton 492:  493: <select name='advancedviewselect'> 494: <option value='Detailed Citation View' selected="true"> 495: Detailed Citation View</option> 496: <option value='Summary View'>Summary View</option> 497: <option value='Fielded Format'>Fielded Format</option> 498: <option value='XML/SGML'>XML/SGML</option> 499: </select> 500:  501: <input type="button" value="HELP" onClick="openhelp()" /> 502: </p> 503: </form> 504: </body> 505: </html> 506: ENDDOCUMENT 507: return $scrout; 508: } 509: 510: ###################################################################### 511: ###################################################################### 512: 513: =pod 514: 515: =item &make_persistent() 516: 517: Returns a scalar which holds the current ENV{'form.*'} values in 518: a 'hidden' html input tag. This allows search interface information 519: to be somewhat persistent. 520: 521: =cut 522: 523: ###################################################################### 524: ###################################################################### 525: 526: sub make_persistent { 527: my $persistent=''; 528: foreach (keys %ENV) { 529: if (/^form\./ && !/submit/) { 530: my $name=$_; 531: my $key=$name; 532: $ENV{$key}=~s/\'//g; # do not mess with html field syntax 533: $name=~s/^form\.//; 534: $persistent.=<<END; 535: <input type="hidden" name="$name" value="$ENV{$key}" /> 536: END 537: } 538: } 539: return $persistent; 540: } 541: 542: 543: ###################################################################### 544: ###################################################################### 545: 546: =pod 547: 548: =item HTML form building functions 549: 550: =over 4 551: 552: =item &simpletextfield() 553: 554: Inputs: $name,$value,$size 555: 556: Returns a text input field with the given name, value, and size. 557: If size is not specified, a value of 20 is used. 558: 559: =item &simplecheckbox() 560: 561: Inputs: $name,$value 562: 563: Returns a simple check box with the given $name. 564: If $value eq 'on' the box is checked. 565: 566: =item &searchphrasefield() 567: 568: Inputs: $title,$name,$value 569: 570: Returns html for a title line and an input field for entering search terms. 571: the instructions "Enter terms or phrases separated by search operators such 572: as AND, OR, or NOT." are given following the title. The entry field (which 573: is where the $name and $value are used) is an 80 column simpletextfield. 574: 575: =item &dateboxes() 576: 577: Returns html selection form elements for the specification of 578: the day, month, and year. 579: 580: =item &selectbox() 581: 582: Returns html selection form. 583: 584: =back 585: 586: =cut 587: 588: ###################################################################### 589: ###################################################################### 590: 591: sub simpletextfield { 592: my ($name,$value,$size)=@_; 593: $size = 20 if (! defined($size)); 594: return '<input type="text" name="'.$name. 595: '" size="'.$size.'" value="'.$value.'" />'; 596: } 597: 598: sub simplecheckbox { 599: my ($name,$value)=@_; 600: my $checked=''; 601: $checked="CHECKED" if $value eq 'on'; 602: return '<input type="checkbox" name="'.$name.'" '. $checked . ' />'; 603: } 604: 605: sub searchphrasefield { 606: my ($title,$name,$value)=@_; 607: my $instruction=<<END; 608: Enter terms or phrases separated by search operators such as AND, OR, or NOT. 609: END 610: my $uctitle=uc($title); 611: return "\n". 612: '<p><font color="#800000" face="helvetica"><b>'.$uctitle.':</b>'. 613: "</FONT> $instruction<br />".&simpletextfield($name,$value,80); 614: } 615: 616: sub dateboxes { 617: my ($name,$defaultmonth,$defaultday,$defaultyear, 618: $currentmonth,$currentday,$currentyear)=@_; 619: ($defaultmonth,$defaultday,$defaultyear)=('','',''); 620: # 621: # Day 622: my $day=<<END; 623: <select name="${name}_day"> 624: <option value='$defaultday'> </option> 625: END 626: for (my $i = 1; $i<=31; $i++) { 627: $day.="<option value=\"$i\">$i</option>\n"; 628: } 629: $day.="</select>\n"; 630: $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); 631: # 632: # Month 633: my $month=<<END; 634: <select name="${name}_month"> 635: <option value='$defaultmonth'> </option> 636: END 637: my $i = 1; 638: foreach (qw/January February March April May June 639: July August September October November December /){ 640: $month .="<option value=\"$i\">$_</option>\n"; 641: $i++; 642: } 643: $month.="</select>\n"; 644: $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); 645: # 646: # Year (obviously) 647: my $year=<<END; 648: <select name="${name}_year"> 649: <option value='$defaultyear'> </option> 650: END 651: my $maxyear = 2051; 652: for (my $i = 1976; $i<=$maxyear; $i++) { 653: $year.="<option value=\"$i\">$i</option>\n"; 654: } 655: $year.="</select>\n"; 656: $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); 657: return "$month$day$year"; 658: } 659: 660: sub selectbox { 661: my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; 662: my $uctitle=uc($title); 663: my $selout="\n".'<p><font color="#800000" face="helvetica">'. 664: '<b>'.$uctitle.':</b></font><br /><select name="'.$name.'">'; 665: foreach ($anyvalue,@idlist) { 666: $selout.='<option value="'.$_.'"'; 667: if ($_ eq $value and !/^any$/) { 668: $selout.=' selected >'.&{$functionref}($_).'</option>'; 669: } 670: elsif ($_ eq $value and /^$anyvalue$/) { 671: $selout.=' selected >'.$anytag.'</option>'; 672: } 673: else {$selout.='>'.&{$functionref}($_).'</option>';} 674: } 675: return $selout.'</select>'; 676: } 677: 678: ###################################################################### 679: ###################################################################### 680: 681: =pod 682: 683: =item &advancedsearch() 684: 685: Parse advanced search results. 686: 687: =cut 688: 689: ###################################################################### 690: ###################################################################### 691: sub advancedsearch { 692: my ($r,$envhash,$hidden)=@_; 693: my %ENV=%{$envhash}; 694: my $fillflag=0; 695: # Clean up fields for safety 696: for my $field ('title','author','subject','keywords','url','version', 697: 'creationdatestart_month','creationdatestart_day', 698: 'creationdatestart_year','creationdateend_month', 699: 'creationdateend_day','creationdateend_year', 700: 'lastrevisiondatestart_month','lastrevisiondatestart_day', 701: 'lastrevisiondatestart_year','lastrevisiondateend_month', 702: 'lastrevisiondateend_day','lastrevisiondateend_year', 703: 'notes','abstract','mime','language','owner', 704: 'custommetadata','customshow') { 705: $ENV{"form.$field"}=~s/[^\w\/\s\=\-\"\']//g; 706: } 707: foreach ('mode','form','element') { 708: # is this required? Hmmm. 709: next unless (exists($ENV{"form.$_"})); 710: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); 711: $ENV{"form.$_"}=~s/[^\w\/\s\=\-\"\']//g; 712: } 713: # Check to see if enough information was filled in 714: for my $field ('title','author','subject','keywords','url','version', 715: 'notes','abstract','mime','language','owner', 716: 'custommetadata') { 717: if (&filled($ENV{"form.$field"})) { 718: $fillflag++; 719: } 720: } 721: unless ($fillflag) { 722: &output_blank_field_error($r); 723: return OK; 724: } 725: # Turn the form input into a SQL-based query 726: my $query=''; 727: my @queries; 728: # Evaluate logical expression AND/OR/NOT phrase fields. 729: foreach my $field ('title','author','subject','notes','abstract','url', 730: 'keywords','version','owner') { 731: if ($ENV{'form.'.$field}) { 732: push @queries,&build_SQL_query($field,$ENV{'form.'.$field}); 733: } 734: } 735: # Evaluate option lists 736: if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { 737: push @queries,"(language like \"$ENV{'form.language'}\")"; 738: } 739: if ($ENV{'form.mime'} and $ENV{'form.mime'} ne 'any') { 740: push @queries,"(mime like \"$ENV{'form.mime'}\")"; 741: } 742: if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { 743: push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; 744: } 745: # Evaluate date windows 746: my $datequery=&build_date_queries( 747: $ENV{'form.creationdatestart_month'}, 748: $ENV{'form.creationdatestart_day'}, 749: $ENV{'form.creationdatestart_year'}, 750: $ENV{'form.creationdateend_month'}, 751: $ENV{'form.creationdateend_day'}, 752: $ENV{'form.creationdateend_year'}, 753: $ENV{'form.lastrevisiondatestart_month'}, 754: $ENV{'form.lastrevisiondatestart_day'}, 755: $ENV{'form.lastrevisiondatestart_year'}, 756: $ENV{'form.lastrevisiondateend_month'}, 757: $ENV{'form.lastrevisiondateend_day'}, 758: $ENV{'form.lastrevisiondateend_year'}, 759: ); 760: # Test to see if date windows are legitimate 761: if ($datequery=~/^Incorrect/) { 762: &output_date_error($r,$datequery); 763: return OK; 764: } 765: elsif ($datequery) { 766: push @queries,$datequery; 767: } 768: # Process form information for custom metadata querying 769: my $customquery=''; 770: if ($ENV{'form.custommetadata'}) { 771: $customquery=&build_custommetadata_query('custommetadata', 772: $ENV{'form.custommetadata'}); 773: } 774: my $customshow=''; 775: if ($ENV{'form.customshow'}) { 776: $customshow=$ENV{'form.customshow'}; 777: $customshow=~s/[^\w\s]//g; 778: my @fields=split(/\s+/,$customshow); 779: $customshow=join(" ",@fields); 780: } 781: # Send query statements over the network to be processed by either the SQL 782: # database or a recursive scheme of 'grep'-like actions (for custom 783: # metadata). 784: if (@queries) { 785: $query=join(" AND ",@queries); 786: $query="select * from metadata where $query"; 787: my $reply; # reply hash reference 788: unless ($customquery or $customshow) { 789: $reply=&Apache::lonnet::metadata_query($query); 790: } 791: else { 792: $reply=&Apache::lonnet::metadata_query($query, 793: $customquery,$customshow); 794: } 795: &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden); 796: return OK; 797: } elsif ($customquery) { 798: my $reply; # reply hash reference 799: $reply=&Apache::lonnet::metadata_query('', 800: $customquery,$customshow); 801: &output_results('Advanced',$r,$envhash,$customquery,$reply,$hidden); 802: return OK; 803: } 804: # should not get to this point 805: return 'Error. Should not have gone to this point.'; 806: } 807: 808: ###################################################################### 809: ###################################################################### 810: 811: =pod 812: 813: =item &basicsearch() 814: 815: Parse basic search form. 816: 817: =cut 818: 819: ###################################################################### 820: ###################################################################### 821: sub basicsearch { 822: my ($r,$envhash,$hidden)=@_; 823: my %ENV=%{$envhash}; 824: # Clean up fields for safety 825: for my $field ('basicexp') { 826: $ENV{"form.$field"}=~s/[^\w\s\-]//g; 827: } 828: foreach ('mode','form','element') { 829: # is this required? Hmmm. 830: next unless (exists($ENV{"form.$_"})); 831: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); 832: $ENV{"form.$_"}=~s/[^\w\/\s\=\-\"\']//g; 833: } 834: 835: # Check to see if enough is filled in 836: unless (&filled($ENV{'form.basicexp'})) { 837: &output_blank_field_error($r); 838: return OK; 839: } 840: 841: # Build SQL query string based on form page 842: my $query=''; 843: my $concatarg=join('," ",', 844: ('title', 'author', 'subject', 'notes', 'abstract', 845: 'keywords')); 846: $concatarg='title' if $ENV{'form.titleonly'}; 847: 848: $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'}); 849: 850: # Get reply (either a hash reference to filehandles or bad connection) 851: # &Apache::lonnet::logthis("metadata query started:".time); 852: my $reply=&Apache::lonnet::metadata_query('select * from metadata where '.$query); 853: # &Apache::lonnet::logthis("metadata query finished:".time); 854: # Output search results 855: 856: &output_results('Basic',$r,$envhash,$query,$reply,$hidden); 857: 858: return OK; 859: } 860: 861: 862: ###################################################################### 863: ###################################################################### 864: 865: =pod 866: 867: =item &build_SQL_query() 868: 869: Builds a SQL query string from a logical expression with AND/OR keywords 870: using Text::Query and &recursive_SQL_query_builder() 871: 872: =cut 873: 874: ###################################################################### 875: ###################################################################### 876: sub build_SQL_query { 877: my ($field_name,$logic_statement)=@_; 878: my $q=new Text::Query('abc', 879: -parse => 'Text::Query::ParseAdvanced', 880: -build => 'Text::Query::Build'); 881: $q->prepare($logic_statement); 882: my $matchexp=${$q}{'matchexp'}; chomp $matchexp; 883: my $sql_query=&recursive_SQL_query_build($field_name,$matchexp); 884: return $sql_query; 885: } 886: 887: ###################################################################### 888: ###################################################################### 889: 890: =pod 891: 892: =item &build_custommetadata_query() 893: 894: Constructs a custom metadata query using a rather heinous regular 895: expression. 896: 897: =cut 898: 899: ###################################################################### 900: ###################################################################### 901: sub build_custommetadata_query { 902: my ($field_name,$logic_statement)=@_; 903: my $q=new Text::Query('abc', 904: -parse => 'Text::Query::ParseAdvanced', 905: -build => 'Text::Query::BuildAdvancedString'); 906: $q->prepare($logic_statement); 907: my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; 908: # quick fix to change literal into xml tag-matching 909: # will eventually have to write a separate builder module 910: # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\> 911: $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to 912: /\\<$1\\>?# \<wordone\> 913: \[\^\\<\]?# [^\<] 914: \*$2\[\^\\<\]?# *wordtwo[^\<] 915: \*\\<\\\/$1\\>?# *\<\/wordone\> 916: /g; 917: return $matchexp; 918: } 919: 920: ###################################################################### 921: ###################################################################### 922: 923: =pod 924: 925: =item &recursive_SQL_query_build() 926: 927: Recursively constructs an SQL query. Takes as input $dkey and $pattern. 928: 929: =cut 930: 931: ###################################################################### 932: ###################################################################### 933: sub recursive_SQL_query_build { 934: my ($dkey,$pattern)=@_; 935: my @matches=($pattern=~/(\[[^\]|\[]*\])/g); 936: return $pattern unless @matches; 937: foreach my $match (@matches) { 938: $match=~/\[ (\w+)\s(.*) \]/; 939: my ($key,$value)=($1,$2); 940: my $replacement=''; 941: if ($key eq 'literal') { 942: $replacement="($dkey like \"\%$value\%\")"; 943: } 944: elsif ($key eq 'not') { 945: $value=~s/like/not like/; 946: # $replacement="($dkey not like $value)"; 947: $replacement="$value"; 948: } 949: elsif ($key eq 'and') { 950: $value=~/(.*[\"|\)]) ([|$|\^].*)/; 951: $replacement="($1 AND $2)"; 952: } 953: elsif ($key eq 'or') { 954: $value=~/(.*[\"|$]) ([|\(|\^].*)/; 955: $replacement="($1 OR $2)"; 956: } 957: substr($pattern, 958: index($pattern,$match), 959: length($match), 960: $replacement 961: ); 962: } 963: &recursive_SQL_query_build($dkey,$pattern); 964: } 965: 966: ###################################################################### 967: ###################################################################### 968: 969: =pod 970: 971: =item &build_date_queries() 972: 973: Builds a SQL logic query to check time/date entries. 974: Also reports errors (check for /^Incorrect/). 975: 976: =cut 977: 978: ###################################################################### 979: ###################################################################### 980: sub build_date_queries { 981: my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, 982: $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; 983: my @queries; 984: if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) { 985: unless ($cmonth1 and $cday1 and $cyear1 and 986: $cmonth2 and $cday2 and $cyear2) { 987: return "Incorrect entry for the creation date. You must specify ". 988: "a starting month, day, and year and an ending month, ". 989: "day, and year."; 990: } 991: my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1); 992: $cnumeric1+=0; 993: my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2); 994: $cnumeric2+=0; 995: if ($cnumeric1>$cnumeric2) { 996: return "Incorrect entry for the creation date. The starting ". 997: "date must occur before the ending date."; 998: } 999: my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '". 1000: "$cyear2-$cmonth2-$cday2 23:59:59')"; 1001: push @queries,$cquery; 1002: } 1003: if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) { 1004: unless ($lmonth1 and $lday1 and $lyear1 and 1005: $lmonth2 and $lday2 and $lyear2) { 1006: return "Incorrect entry for the last revision date. You must ". 1007: "specify a starting month, day, and year and an ending ". 1008: "month, day, and year."; 1009: } 1010: my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1); 1011: $lnumeric1+=0; 1012: my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2); 1013: $lnumeric2+=0; 1014: if ($lnumeric1>$lnumeric2) { 1015: return "Incorrect entry for the last revision date. The ". 1016: "starting date must occur before the ending date."; 1017: } 1018: my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '". 1019: "$lyear2-$lmonth2-$lday2 23:59:59')"; 1020: push @queries,$lquery; 1021: } 1022: if (@queries) { 1023: return join(" AND ",@queries); 1024: } 1025: return ''; 1026: } 1027: 1028: ###################################################################### 1029: ###################################################################### 1030: 1031: =pod 1032: 1033: =item &output_results() 1034: 1035: Format and output results based on a reply list. 1036: There are two windows that this function writes to. The main search 1037: window ("srch") has a listing of the results. A secondary window ("popwin") 1038: gives the status of the network search (time elapsed, number of machines 1039: contacted, etc.) 1040: 1041: =cut 1042: 1043: ###################################################################### 1044: ###################################################################### 1045: sub output_results { 1046: # &Apache::lonnet::logthis("output_results:".time); 1047: my $fnum; # search result counter 1048: my ($mode,$r,$envhash,$query,$replyref,$hidden)=@_; 1049: my %ENV=%{$envhash}; 1050: my %rhash=%{$replyref}; 1051: my $compiledresult=''; 1052: my $timeremain=300; # (seconds) 1053: my $elapsetime=0; 1054: my $resultflag=0; 1055: my $tflag=1; 1056: # 1057: # make query information persistent to allow for subsequent revision 1058: my $persistent=&make_persistent(); 1059: # spit out the generic header 1060: $r->print(&search_results_header()); 1061: $r->rflush(); 1062: # begin showing the cataloged results 1063: $r->print(<<CATALOGBEGIN); 1064: </head> 1065: <body bgcolor="#ffffff"> 1066: <img align=right src=/adm/lonIcons/lonlogos.gif> 1067: <h1>Search Catalog</h1> 1068: CATALOGBEGIN 1069: $r->print(<<CATALOGCONTROLS); 1070: <form name='results' method="post" action="/adm/searchcat"> 1071: $hidden 1072: <input type='hidden' name='acts' value='' /> 1073: <input type='button' value='Revise search request' 1074: onClick='this.form.submit();' /> 1075: $importbutton 1076: $closebutton 1077: $persistent 1078: <hr /> 1079: <h3>Search Query</h3> 1080: CATALOGCONTROLS 1081: # 1082: # Remind them what they searched for 1083: # 1084: if ($mode eq 'Basic') { 1085: $r->print('<p><b>Basic search:</b> '.$ENV{'form.basicexp'}.'</p>'); 1086: } elsif ($mode eq 'Advanced') { 1087: $r->print('<p><b>Advanced search</b> '.$query.'</p>'); 1088: } 1089: $r->print('<h3>Search Results</h3>'); 1090: $r->rflush(); 1091: # 1092: # make the pop-up window for status 1093: # 1094: $r->print(&make_popwin(%rhash)); 1095: $r->rflush(); 1096: ## 1097: ## Prepare for the main loop below 1098: ## 1099: my $servercount=0; 1100: my $hitcountsum=0; 1101: my $servernum=(keys %rhash); 1102: my $serversleft=$servernum; 1103: ## 1104: ## Run until we run out of time or we run out of servers 1105: ## 1106: while($serversleft && $timeremain) { 1107: ## 1108: ## %rhash has servers deleted from it as results come in 1109: ## (within the foreach loop below). 1110: ## 1111: foreach my $rkey (sort keys %rhash) { 1112: # &Apache::lonnet::logthis("Server $rkey:".time); 1113: $servercount++; 1114: $compiledresult=''; 1115: my $reply=$rhash{$rkey}; 1116: my @results; 1117: if ($reply eq 'con_lost') { 1118: &popwin_imgupdate($r,$rkey,"srvbad.gif"); 1119: $serversleft--; 1120: delete $rhash{$rkey}; 1121: } else { 1122: # must do since 'use strict' checks for tainting 1123: $reply=~/^([\.\w]+)$/; 1124: my $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1; 1125: $reply=~/(.*?)\_/; 1126: for (my $counter=0;$counter<2;$counter++) { 1127: if (-e $replyfile && ! -e "$replyfile.end") { 1128: &popwin_imgupdate($r,$rkey,"srvhalf.gif"); 1129: &popwin_js($r,'popwin.hc["'.$rkey.'"]='. 1130: '"still transferring..."'.';'); 1131: } 1132: # Are we finished transferring data? 1133: if (-e "$replyfile.end") { 1134: $serversleft--; 1135: delete $rhash{$rkey}; 1136: if (-s $replyfile) { 1137: &popwin_imgupdate($r,$rkey,"srvgood.gif"); 1138: my $fh; 1139: unless ($fh=Apache::File->new($replyfile)){ 1140: # Is it really appropriate to die on this error? 1141: $r->print('ERROR: file '. 1142: $replyfile.' cannot be opened'); 1143: return OK; 1144: } 1145: @results=<$fh> if $fh; 1146: $hitcount{$rkey}=@results+0; 1147: &popwin_js($r,'popwin.hc["'.$rkey.'"]='. 1148: $hitcount{$rkey}.';'); 1149: $hitcountsum+=$hitcount{$rkey}; 1150: &popwin_js($r,'popwin.document.forms.popremain.'. 1151: 'numhits.value='.$hitcountsum.';'); 1152: } else { 1153: &popwin_imgupdate($r,$rkey,"srvempty.gif"); 1154: &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;'); 1155: } 1156: last; 1157: } # end of if ( -e "$replyfile.end") 1158: last unless $timeremain; 1159: sleep 1; # wait for daemons to write files? 1160: $timeremain--; 1161: $elapsetime++; 1162: &popwin_js($r,"popwin.document.popremain.". 1163: "elapsetime.value=$elapsetime;"); 1164: } 1165: &popwin_js($r,'popwin.document.whirly.'. 1166: 'src="/adm/lonIcons/lonanimend.gif";'); 1167: } # end of if ($reply eq 'con_lost') else statement 1168: my %Fields = undef; # Holds the data to be sent to the various 1169: # *_view routines. 1170: my ($extrashow,$customfields,$customhash) = &handle_custom_fields(\@results); 1171: my @customfields = @$customfields; 1172: my %customhash = %$customhash; 1173: untie %hash if (keys %hash); 1174: # 1175: if (! tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { 1176: $r->print('<html><head></head><body>Unable to tie hash to db '. 1177: 'file</body></html>'); 1178: } else { 1179: if ($ENV{'form.launch'} eq '1') { 1180: &start_fresh_session(); 1181: } 1182: foreach my $result (@results) { 1183: next if $result=~/^custom\=/; 1184: chomp $result; 1185: next unless $result; 1186: %Fields = &parse_raw_result($result,$rkey); 1187: $Fields{'extrashow'}=$extrashow; 1188: if ($extrashow) { 1189: foreach my $field (@customfields) { 1190: my $value=''; 1191: $value = $1 if ($customhash{$Fields{'url'}}=~/\<{$field}[^\>]*\>(.*?)\<\/{$field}[^\>]*\>/s); 1192: $Fields{'extrashow'}=~s/\<\!\-\- $field \-\-\>/ $value/g; 1193: } 1194: } 1195: if ($compiledresult or $servercount!=$servernum) { 1196: $compiledresult.="<hr align='left' width='200' noshade />"; 1197: } 1198: $compiledresult.="\n<p>\n"; 1199: if ($ENV{'form.catalogmode'} eq 'interactive') { 1200: my $titleesc=$Fields{'title'}; 1201: $titleesc=~s/\'/\\'/; # ' 1202: $compiledresult.=<<END if ($ENV{'form.catalogmode'} eq 'interactive'); 1203: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT" 1204: onClick="javascript:select_data('$titleesc','$Fields{'url'}')"> 1205: </font> 1206: <br /> 1207: END 1208: } 1209: if ($ENV{'form.catalogmode'} eq 'groupsearch') { 1210: $fnum+=0; 1211: $hash{"pre_${fnum}_link"}=$Fields{'url'}; 1212: $hash{"pre_${fnum}_title"}=$Fields{'title'}; 1213: $compiledresult.=<<END; 1214: <font size='-1'> 1215: <input type="checkbox" name="returnvalues" value="SELECT" 1216: onClick="javascript:queue($fnum)" /> 1217: </font> 1218: <br /> 1219: END 1220: # <input type="hidden" name="title$fnum" value="$title" /> 1221: # <input type="hidden" name="url$fnum" value="$url" /> 1222: $fnum++; 1223: } 1224: my $viewselect; 1225: if ($mode eq 'Basic') { 1226: $viewselect=$ENV{'form.basicviewselect'}; 1227: } 1228: elsif ($mode eq 'Advanced') { 1229: $viewselect=$ENV{'form.advancedviewselect'}; 1230: } 1231: if ($viewselect eq 'Detailed Citation View') { 1232: $compiledresult.=&detailed_citation_view 1233: (%Fields, hostname => $rkey ); 1234: } 1235: elsif ($viewselect eq 'Summary View') { 1236: $compiledresult.=&summary_view 1237: (%Fields, hostname => $rkey ); 1238: } 1239: elsif ($viewselect eq 'Fielded Format') { 1240: $compiledresult.=&fielded_format_view 1241: (%Fields, hostname => $rkey ); 1242: } 1243: elsif ($viewselect eq 'XML/SGML') { 1244: $compiledresult.=&xml_sgml_view 1245: (%Fields, hostname => $rkey ); 1246: } 1247: } 1248: untie %hash; 1249: } 1250: if ($compiledresult) { 1251: $resultflag=1; 1252: $r->print($compiledresult); 1253: } 1254: my $percent=sprintf('%3.0f',($servercount/$servernum*100)); 1255: } # End of foreach loop over servers remaining 1256: } # End of big loop - while($serversleft && $timeremain) 1257: unless ($resultflag) { 1258: $r->print("\nThere were no results that matched your query\n"); 1259: } 1260: # $r->print('<script type="text/javascript">'.'popwin.close()</script>'."\n"); $r->rflush(); 1261: $r->print("</body>\n</html>\n"); 1262: return; 1263: } 1264: 1265: ########################################################### 1266: ########################################################### 1267: 1268: =pod 1269: 1270: =item &parse_raw_result() 1271: 1272: Takes a line from the file of results and parse it. Returns a hash 1273: with keys for the following fields: 1274: 'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes', 1275: 'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate', 1276: 'lastrevisiondate'. 1277: 1278: In addition, the following tags are set by calling the appropriate 1279: lonnet function: 'language', 'cprtag', 'mimetag'. 1280: 1281: The 'title' field is set to "Untitled" if the title field is blank. 1282: 1283: 'abstract' and 'keywords' are truncated to 200 characters. 1284: 1285: =cut 1286: 1287: ########################################################### 1288: ########################################################### 1289: sub parse_raw_result { 1290: my ($result,$hostname) = @_; 1291: # Check for a comma - if it is there then we do not need to unescape the 1292: # string. There seems to be some kind of problem with some items in 1293: # the database - the entire string gets sent out unescaped...? 1294: unless ($result =~ /,/) { 1295: $result = &Apache::lonnet::unescape($result); 1296: } 1297: my @fields=map { 1298: &Apache::lonnet::unescape($_); 1299: } (split(/\,/,$result)); 1300: my ($title,$author,$subject,$url,$keywords,$version, 1301: $notes,$abstract,$mime,$lang, 1302: $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; 1303: my %Fields = 1304: ( title => &Apache::lonnet::unescape($title), 1305: author => &Apache::lonnet::unescape($author), 1306: subject => &Apache::lonnet::unescape($subject), 1307: url => &Apache::lonnet::unescape($url), 1308: keywords => &Apache::lonnet::unescape($keywords), 1309: version => &Apache::lonnet::unescape($version), 1310: notes => &Apache::lonnet::unescape($notes), 1311: abstract => &Apache::lonnet::unescape($abstract), 1312: mime => &Apache::lonnet::unescape($mime), 1313: lang => &Apache::lonnet::unescape($lang), 1314: owner => &Apache::lonnet::unescape($owner), 1315: copyright => &Apache::lonnet::unescape($copyright), 1316: creationdate => &Apache::lonnet::unescape($creationdate), 1317: lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate) 1318: ); 1319: $Fields{'language'} = 1320: &Apache::loncommon::languagedescription($Fields{'lang'}); 1321: $Fields{'copyrighttag'} = 1322: &Apache::loncommon::copyrightdescription($Fields{'copyright'}); 1323: $Fields{'mimetag'} = 1324: &Apache::loncommon::filedescription($Fields{'mime'}); 1325: # Put spaces in the keyword list, if needed. 1326: $Fields{'keywords'}=~ s/,([A-z])/, $1/g; 1327: if ($Fields{'title'}=~ /^\s*$/ ) { 1328: $Fields{'title'}='Untitled'; 1329: } 1330: unless ($ENV{'user.adv'}) { 1331: $Fields{'keywords'} = '- not displayed -'; 1332: $Fields{'notes'} = '- not displayed -'; 1333: $Fields{'abstract'} = '- not displayed -'; 1334: $Fields{'subject'} = '- not displayed -'; 1335: } 1336: if (length($Fields{'abstract'})>200) { 1337: $Fields{'abstract'} = 1338: substr($Fields{'abstract'},0,200).'...'; 1339: } 1340: if (length($Fields{'keywords'})>200) { 1341: $Fields{'keywords'} = 1342: substr($Fields{'keywords'},0,200).'...'; 1343: } 1344: return %Fields; 1345: } 1346: 1347: ########################################################### 1348: ########################################################### 1349: 1350: =pod 1351: 1352: =item &handle_custom_fields() 1353: 1354: =cut 1355: 1356: ########################################################### 1357: ########################################################### 1358: sub handle_custom_fields { 1359: my @results = @{shift()}; 1360: my $customshow=''; 1361: my $extrashow=''; 1362: my @customfields; 1363: if ($ENV{'form.customshow'}) { 1364: $customshow=$ENV{'form.customshow'}; 1365: $customshow=~s/[^\w\s]//g; 1366: my @fields=map { 1367: "<font color=\"#008000\">$_:</font>"; 1368: } split(/\s+/,$customshow); 1369: @customfields=split(/\s+/,$customshow); 1370: if ($customshow) { 1371: $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n"; 1372: } 1373: } 1374: my $customdata=''; 1375: my %customhash; 1376: foreach my $result (@results) { 1377: if ($result=~/^(custom\=.*)$/) { # grab all custom metadata 1378: my $tmp=$result; 1379: $tmp=~s/^custom\=//; 1380: my ($k,$v)=map {&Apache::lonnet::unescape($_); 1381: } split(/\,/,$tmp); 1382: $customhash{$k}=$v; 1383: } 1384: } 1385: return ($extrashow,\@customfields,\%customhash); 1386: } 1387: 1388: ###################################################################### 1389: ###################################################################### 1390: 1391: =pod 1392: 1393: =item &search_results_header 1394: 1395: Output the proper javascript code to deal with different calling modes. 1396: 1397: Takes inputs directly from from %ENV. The following environment variables 1398: are checked: 1399: 1400: =over 4 1401: 1402: =item 'form.catalogmode' 1403: 1404: Checked for 'interactive' and 'groupsearch'. 1405: 1406: =item 'form.mode' 1407: 1408: Checked for existance & 'edit' mode. 1409: 1410: =item 'form.form' 1411: 1412: =item 'form.element' 1413: 1414: =back 1415: 1416: =cut 1417: 1418: ###################################################################### 1419: ###################################################################### 1420: sub search_results_header { 1421: my $result = ''; 1422: # output beginning of search page 1423: $result.=<<BEGINNING; 1424: <html> 1425: <head> 1426: <title>The LearningOnline Network with CAPA</title> 1427: BEGINNING 1428: # conditional output of script functions dependent on the mode in 1429: # which the search was invoked 1430: if ($ENV{'form.catalogmode'} eq 'interactive'){ 1431: if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { 1432: $result.=<<SCRIPT; 1433: <script type="text/javascript"> 1434: function select_data(title,url) { 1435: changeTitle(title); 1436: changeURL(url); 1437: self.close(); 1438: } 1439: function changeTitle(val) { 1440: if (opener.inf.document.forms.resinfo.elements.t) { 1441: opener.inf.document.forms.resinfo.elements.t.value=val; 1442: } 1443: } 1444: function changeURL(val) { 1445: if (opener.inf.document.forms.resinfo.elements.u) { 1446: opener.inf.document.forms.resinfo.elements.u.value=val; 1447: } 1448: } 1449: </script> 1450: SCRIPT 1451: } elsif ($ENV{'form.mode'} eq 'edit') { 1452: my $form = $ENV{'form.form'}; 1453: my $element = $ENV{'form.element'}; 1454: $result.=<<SCRIPT; 1455: <script type="text/javascript"> 1456: function select_data(title,url) { 1457: changeURL(url); 1458: self.close(); 1459: } 1460: function changeTitle(val) { 1461: } 1462: function changeURL(val) { 1463: if (window.opener.document) { 1464: window.opener.document.forms["$form"].elements["$element"].value=val; 1465: } else { 1466: var url = 'forms[\"$form\"].elements[\"$element\"].value'; 1467: alert("Unable to transfer data to "+url); 1468: } 1469: } 1470: </script> 1471: SCRIPT 1472: } 1473: } 1474: $result.=<<SCRIPT if $ENV{'form.catalogmode'} eq 'groupsearch'; 1475: <script type="text/javascript"> 1476: function select_data(title,url) { 1477: // alert('DEBUG: Should be storing '+title+' and '+url); 1478: } 1479: function queue(val) { 1480: if (eval("document.forms.results.returnvalues["+val+"].checked")) { 1481: document.forms.results.acts.value+='1a'+val+'b'; 1482: } 1483: else { 1484: document.forms.results.acts.value+='0a'+val+'b'; 1485: } 1486: } 1487: function select_group() { 1488: window.location= 1489: "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ 1490: document.forms.results.acts.value; 1491: } 1492: </script> 1493: SCRIPT 1494: $result.=<<SCRIPT; 1495: <script type="text/javascript"> 1496: function displayinfo(val) { 1497: popwin.document.forms.popremain.sdetails.value=val; 1498: } 1499: function openhelp(val) { 1500: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 1501: 'scrollbars=1,width=400,height=300'); 1502: openhelpwin.focus(); 1503: } 1504: function abortsearch(val) { 1505: popwin.close(); 1506: } 1507: </script> 1508: SCRIPT 1509: return $result; 1510: } 1511: 1512: ###################################################################### 1513: ###################################################################### 1514: 1515: =pod 1516: 1517: =item &make_popwin() 1518: 1519: Returns html with javascript in it to open up the status window. 1520: 1521: =cut 1522: 1523: ###################################################################### 1524: ###################################################################### 1525: sub make_popwin { 1526: my %rhash = @_; 1527: my $servernum=(keys %rhash); 1528: my $hcinit; 1529: my $grid="'<br />'+\n"; 1530: # $sn is the server number, used ONLY to make sure we have 1531: # rows of 10 each. No longer used to index images. 1532: my $sn=1; 1533: foreach my $sk (sort keys %rhash) { 1534: # '<a href=" 1535: $grid.="'<a href=\""; 1536: # javascript:displayinfo('+ 1537: $grid.="javascript:opener.displayinfo('+"; 1538: # "'"+'key 1539: $grid.="\"'\"+'"; 1540: $grid.=$sk; 1541: my $hc; 1542: if ($rhash{$sk} eq 'con_lost') { 1543: $hc="BAD CONNECTION, CONTACT SYSTEM ADMINISTRATOR "; 1544: } 1545: else { 1546: $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'"; 1547: $hcinit.="hc[\"$sk\"]=\"not yet connected...\";"; 1548: } 1549: $grid.=" hitcount=".$hc; 1550: $grid.=" domain=".$hostdomains{$sk}; 1551: $grid.=" IP=".$hostips{$sk}; 1552: # '+"'"+'">'+ 1553: $grid.="'+\"'\"+')\">'+"; 1554: $grid.="\n"; 1555: $grid.="'<img border=\"0\" name=\"img_".$hostdomains{$sk}.'_'.$sk."\"". 1556: " src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk."\" /></a>'+\n"; 1557: $grid.="'<br />'+\n" unless $sn%10; 1558: $sn++; 1559: } 1560: my $result.=<<ENDPOP; 1561: <script type="text/javascript"> 1562: popwin=open('','popwin','scrollbars=1,width=400,height=220'); 1563: popwin.focus(); 1564: popwin.document.writeln('<'+'html>'); 1565: popwin.document.writeln('<'+'head>'); 1566: popwin.document.writeln('<'+'script>'); 1567: popwin.document.writeln('hc=new Array();$hcinit'); 1568: popwin.document.writeln('<'+'/script>'); 1569: popwin.document.writeln('<'+'/head>'+ 1570: '<'+'body bgcolor="#FFFFFF">'+ 1571: '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+ 1572: 'lonanim.gif" '+ 1573: 'alt="animated logo" />'+ 1574: '<'+'h3>Search Results Progress<'+'/h3>'+ 1575: '<'+'form name="popremain">'+ 1576: '<'+'tt>'+ 1577: '<'+'br clear="all"/><i>PLEASE BE PATIENT</i>'+ 1578: '<'+'br />SCANNING $servernum SERVERS'+ 1579: '<'+'br clear="all" />Number of record hits found '+ 1580: '<'+'input type="text" size="10" name="numhits"'+ 1581: ' value="0" />'+ 1582: '<'+'br clear="all" />Time elapsed '+ 1583: '<'+'input type="text" size="10" name="elapsetime"'+ 1584: ' value="0" />'+ 1585: '<'+'br />'+ 1586: 'SERVER GRID (click on any cell for details)'+ 1587: $grid 1588: '<'+'br />'+ 1589: 'Server details '+ 1590: '<'+'input type="text" size="35" name="sdetails"'+ 1591: ' value="" />'+ 1592: '<'+'br />'+ 1593: ' <'+'input type="button" name="button"'+ 1594: ' value="close this window" '+ 1595: ' onClick="javascript:opener.abortsearch()" />'+ 1596: ' <'+'input type="button" name="button"'+ 1597: ' value="help" onClick="javascript:opener.openhelp()" />'+ 1598: '<'+'/tt>'+ 1599: '<'+'/form>'+ 1600: '<'+'/body><'+'/html>'); 1601: popwin.document.close(); 1602: </script> 1603: ENDPOP 1604: return $result; 1605: } 1606: 1607: ###################################################################### 1608: ###################################################################### 1609: 1610: =pod 1611: 1612: =item Metadata Viewing Functions 1613: 1614: Output is a HTML-ified string. 1615: Input arguments are title, author, subject, url, keywords, version, 1616: notes, short abstract, mime, language, creation date, 1617: last revision date, owner, copyright, hostname, and 1618: extra custom metadata to show. 1619: 1620: =over 4 1621: 1622: =item &detailed_citation_view() 1623: 1624: =cut 1625: 1626: ###################################################################### 1627: ###################################################################### 1628: sub detailed_citation_view { 1629: my %values = @_; 1630: my $result=<<END; 1631: <i>$values{'owner'}</i>, last revised $values{'lastrevisiondate'} 1632: <h3><a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 1633: target='search_preview'>$values{'title'}</a></h3> 1634: <h3>$values{'author'}</h3> 1635: </p> 1636: <p> 1637: <b>Subject:</b> $values{'subject'}<br /> 1638: <b>Keyword(s):</b> $values{'keywords'}<br /> 1639: <b>Notes:</b> $values{'notes'}<br /> 1640: <b>MIME Type:</b> 1641: END 1642: $result.=&Apache::loncommon::filedescription($values{'mime'}); 1643: $result.=<<END; 1644: <br /> 1645: <b>Language:</b> 1646: END 1647: $result.=&Apache::loncommon::languagedescription($values{'lang'}); 1648: $result.=<<END; 1649: <br /> 1650: <b>Copyright/Distribution:</b> 1651: END 1652: $result.=&Apache::loncommon::copyrightdescription($values{'copyright'}); 1653: $result.=<<END; 1654: <br /> 1655: </p> 1656: $values{'extrashow'} 1657: <p> 1658: $values{'shortabstract'} 1659: </p> 1660: END 1661: return $result; 1662: } 1663: 1664: ###################################################################### 1665: ###################################################################### 1666: 1667: =pod 1668: 1669: =item &summary_view() 1670: 1671: =cut 1672: 1673: ###################################################################### 1674: ###################################################################### 1675: sub summary_view { 1676: my %values = @_; 1677: my $result=<<END; 1678: <a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 1679: target='search_preview'>$values{'author'}</a><br /> 1680: $values{'title'}<br /> 1681: $values{'owner'} -- $values{'lastrevisiondate'}<br /> 1682: $values{'copyrighttag'}<br /> 1683: $values{'extrashow'} 1684: </p> 1685: END 1686: return $result; 1687: } 1688: 1689: ###################################################################### 1690: ###################################################################### 1691: 1692: =pod 1693: 1694: =item &fielded_format_view() 1695: 1696: =cut 1697: 1698: ###################################################################### 1699: ###################################################################### 1700: sub fielded_format_view { 1701: my %values = @_; 1702: my $result=<<END; 1703: <b>URL: </b> <a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 1704: target='search_preview'>$values{'url'}</a> 1705: <br /> 1706: <b>Title:</b> $values{'title'}<br /> 1707: <b>Author(s):</b> $values{'author'}<br /> 1708: <b>Subject:</b> $values{'subject'}<br /> 1709: <b>Keyword(s):</b> $values{'keywords'}<br /> 1710: <b>Notes:</b> $values{'notes'}<br /> 1711: <b>MIME Type:</b> $values{'mimetag'}<br /> 1712: <b>Language:</b> $values{'language'}<br /> 1713: <b>Creation Date:</b> $values{'creationdate'}<br /> 1714: <b>Last Revision Date:</b> $values{'lastrevisiondate'}<br /> 1715: <b>Publisher/Owner:</b> $values{'owner'}<br /> 1716: <b>Copyright/Distribution:</b> $values{'copyrighttag'}<br /> 1717: <b>Repository Location:</b> $values{'hostname'}<br /> 1718: <b>Abstract:</b> $values{'shortabstract'}<br /> 1719: $values{'extrashow'} 1720: </p> 1721: END 1722: return $result; 1723: } 1724: 1725: ###################################################################### 1726: ###################################################################### 1727: 1728: =pod 1729: 1730: =item &xml_sgml_view() 1731: 1732: =back 1733: 1734: =cut 1735: 1736: ###################################################################### 1737: ###################################################################### 1738: sub xml_sgml_view { 1739: my %values = @_; 1740: my $result=<<END; 1741: <pre> 1742: <LonCapaResource> 1743: <url>$values{'url'}</url> 1744: <title>$values{'title'}</title> 1745: <author>$values{'author'}</author> 1746: <subject>$values{'subject'}</subject> 1747: <keywords>$values{'keywords'}</keywords> 1748: <notes>$values{'notes'}</notes> 1749: <mimeInfo> 1750: <mime>$values{'mime'}</mime> 1751: <mimetag>$values{'mimetag'}</mimetag> 1752: </mimeInfo> 1753: <languageInfo> 1754: <language>$values{'lang'}</language> 1755: <languagetag>$values{'language'}</languagetag> 1756: </languageInfo> 1757: <creationdate>$values{'creationdate'}</creationdate> 1758: <lastrevisiondate>$values{'lastrevisiondate'}</lastrevisiondate> 1759: <owner>$values{'owner'}</owner> 1760: <copyrightInfo> 1761: <copyright>$values{'copyright'}</copyright> 1762: <copyrighttag>$values{'copyrighttag'}</copyrighttag> 1763: </copyrightInfo> 1764: <repositoryLocation>$values{'hostname'}</repositoryLocation> 1765: <shortabstract>$values{'shortabstract'}</shortabstract> 1766: </LonCapaResource> 1767: </pre> 1768: $values{'extrashow'} 1769: END 1770: return $result; 1771: } 1772: 1773: ###################################################################### 1774: ###################################################################### 1775: 1776: =pod 1777: 1778: =item &filled() see if field is filled. 1779: 1780: =cut 1781: 1782: ###################################################################### 1783: ###################################################################### 1784: sub filled { 1785: my ($field)=@_; 1786: if ($field=~/\S/ && $field ne 'any') { 1787: return 1; 1788: } 1789: else { 1790: return 0; 1791: } 1792: } 1793: 1794: ###################################################################### 1795: ###################################################################### 1796: 1797: =pod 1798: 1799: =item &output_blank_field_error() 1800: 1801: =cut 1802: 1803: ###################################################################### 1804: ###################################################################### 1805: sub output_blank_field_error { 1806: my ($r)=@_; 1807: # make query information persistent to allow for subsequent revision 1808: my $persistent=&make_persistent(); 1809: 1810: $r->print(<<BEGINNING); 1811: <html> 1812: <head> 1813: <title>The LearningOnline Network with CAPA</title> 1814: BEGINNING 1815: $r->print(<<RESULTS); 1816: </head> 1817: <body bgcolor="#ffffff"> 1818: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 1819: <h1>Search Catalog</h1> 1820: <form method="post" action="/adm/searchcat"> 1821: $persistent 1822: <input type='button' value='Revise search request' 1823: onClick='this.form.submit();' /> 1824: $closebutton 1825: <hr /> 1826: <h3>Helpful Message</h3> 1827: <p> 1828: Incorrect search query due to blank entry fields. 1829: You need to fill in the relevant 1830: fields on the search page in order for a query to be 1831: processed. 1832: </p> 1833: </body> 1834: </html> 1835: RESULTS 1836: } 1837: 1838: ###################################################################### 1839: ###################################################################### 1840: 1841: =pod 1842: 1843: =item &output_date_error() 1844: 1845: Output a full html page with an error message. 1846: 1847: =cut 1848: 1849: ###################################################################### 1850: ###################################################################### 1851: sub output_date_error { 1852: my ($r,$message)=@_; 1853: # make query information persistent to allow for subsequent revision 1854: my $persistent=&make_persistent(); 1855: 1856: $r->print(<<RESULTS); 1857: <html> 1858: <head> 1859: <title>The LearningOnline Network with CAPA</title> 1860: </head> 1861: <body bgcolor="#ffffff"> 1862: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 1863: <h1>Search Catalog</h1> 1864: <form method="post" action="/adm/searchcat"> 1865: $persistent 1866: <input type='button' value='Revise search request' 1867: onClick='this.form.submit();' /> 1868: $closebutton 1869: <hr /> 1870: <h3>Helpful Message</h3> 1871: <p> 1872: $message 1873: </p> 1874: </body> 1875: </html> 1876: RESULTS 1877: } 1878: 1879: ###################################################################### 1880: ###################################################################### 1881: 1882: =pod 1883: 1884: =item &start_fresh_session() 1885: 1886: Cleans the global %hash by removing all fields which begin with 1887: 'pre_' or 'store'. 1888: 1889: =cut 1890: 1891: ###################################################################### 1892: ###################################################################### 1893: sub start_fresh_session { 1894: delete $hash{'mode_catalog'}; 1895: foreach (keys %hash) { 1896: if ($_ =~ /^pre_/) { 1897: delete $hash{$_}; 1898: } 1899: if ($_ =~ /^store/) { 1900: delete $hash{$_}; 1901: } 1902: } 1903: } 1904: 1905: ###################################################################### 1906: ###################################################################### 1907: 1908: =pod 1909: 1910: =item &popwin_js() send javascript to popwin 1911: 1912: =cut 1913: 1914: ###################################################################### 1915: ###################################################################### 1916: sub popwin_js { 1917: # Print javascript out to popwin, but make sure we dont generate 1918: # any javascript errors in doing so. 1919: my ($r,$text) = @_; 1920: $r->print(<<"END"); 1921: <script type="text/javascript"> 1922: if (! popwin.closed) { 1923: $text 1924: } 1925: </script> 1926: END 1927: $r->rflush(); 1928: } 1929: 1930: ###################################################################### 1931: ###################################################################### 1932: 1933: =pod 1934: 1935: =item &popwin_imgupdate() 1936: 1937: Send a given image (and its location) out to the browser. Takes as 1938: input $r, loncapa server id, and an icon URL. 1939: 1940: =cut 1941: 1942: ###################################################################### 1943: ###################################################################### 1944: sub popwin_imgupdate { 1945: my ($r,$server,$icon) = @_; 1946: &popwin_js($r,'popwin.document.img_'.$hostdomains{$server}.'_'.$server.'.'. 1947: 'src="/adm/lonIcons/'.$icon.'";'); 1948: } 1949: 1950: 1; 1951: 1952: __END__ 1953: 1954: =pod 1955: 1956: =back 1957: 1958: =cut