loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.121: download - view: text, annotated - select for diffs
Tue Jun 18 21:36:38 2002 UTC (21 years, 11 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Towards rewrite of search interface and internals.
 * POD documentation started.
 * cleanup of BEGIN to use lonnet hashes instead of re-reading hosts.tab.
 * clean up of old POD documentation.
 * beginnings of cleanups of global variables.

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