loncom/interface/lonsearchcat.pm - view

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

More (much more!) POD documentation.
Minor cleanups:
   Changed yesterdays 'unescape' calls to 'escape'.
   Reformatted regular expression writing regular expression in
       &build_custom_metedata_query() so that a2ps can print it
       out instead of hanging.
   Changes to the form outputing routines (which should later be moved
       to loncommon, I suspect) to be a little nicer.
   Tried to make the html produced a little closer to xhtml standard.

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