loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.150: download - view: text, annotated - select for diffs
Thu Aug 1 14:11:57 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Many changes to error reporting and better cleanups on errors/aborted
connections.
Groupsearch and interactive imports (such as from editing a randomlabel problem)
are now handled properly (at least on mozilla 1.0 linux, will test on
'alternative' operating systems soon).
Added new results view, &compact_view, which is the default for groupsearch
and interactive imports.
Removed &write_status.
Changed status reporting system in run_search to output general status,
number of hits, and seconds remaining in search instead of 'servers contacted',
'servers read from' and number of hits.
Change parameters to *_view functions.  Now accept 'prefix' html.
Other minor changes.

1: # The LearningOnline Network with CAPA 2: # Search Catalog 3: # 4: # $Id: lonsearchcat.pm,v 1.150 2002/08/01 14:11:57 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: ############################################################################### 29: ############################################################################### 30: 31: =pod 32: 33: =head1 NAME 34: 35: lonsearchcat - LONCAPA Search Interface 36: 37: =head1 SYNOPSIS 38: 39: Search interface to LON-CAPAs digital library 40: 41: =head1 DESCRIPTION 42: 43: This module enables searching for a distributed browseable catalog. 44: 45: This is part of the LearningOnline Network with CAPA project 46: described at http://www.lon-capa.org. 47: 48: lonsearchcat presents the user with an interface to search the LON-CAPA 49: digital library. lonsearchcat also initiates the execution of a search 50: by sending the search parameters to LON-CAPA servers. The progress of 51: search (on a server basis) is displayed to the user in a seperate window. 52: 53: =head1 Internals 54: 55: =over 4 56: 57: =cut 58: 59: ############################################################################### 60: ############################################################################### 61: 62: ############################################################################### 63: ## ## 64: ## ORGANIZATION OF THIS PERL MODULE ## 65: ## ## 66: ## 1. Modules used by this module ## 67: ## 2. Variables used throughout the module ## 68: ## 3. handler subroutine called via Apache and mod_perl ## 69: ## 4. Other subroutines ## 70: ## ## 71: ############################################################################### 72: 73: package Apache::lonsearchcat; 74: 75: # ------------------------------------------------- modules used by this module 76: use strict; 77: use Apache::Constants qw(:common); 78: use Apache::lonnet(); 79: use Apache::File(); 80: use CGI qw(:standard); 81: use Text::Query; 82: use DBI; 83: use GDBM_File; 84: use Apache::loncommon(); 85: use Apache::lonmysql(); 86: 87: # ---------------------------------------- variables used throughout the module 88: 89: ###################################################################### 90: ###################################################################### 91: 92: =pod 93: 94: =item Global variables 95: 96: =over 4 97: 98: =item $importbutton 99: 100: button to take the select results and go to group sorting 101: 102: =item %groupsearch_db 103: 104: Database hash used to save values for the groupsearch RAT interface. 105: 106: =item $diropendb 107: 108: The full path to the (temporary) search database file. This is set and 109: used in &handler() and is also used in &output_results(). 110: 111: =item %Views 112: 113: Hash which associates an output view description with the function 114: that produces it. Adding a new view type should be as easy as 115: adding a line to the definition of this hash and making sure the function 116: takes the proper parameters. 117: 118: =back 119: 120: =cut 121: 122: ###################################################################### 123: ###################################################################### 124: 125: # -- dynamically rendered interface components 126: my $importbutton; # button to take the selected results and go to group sorting 127: 128: # -- miscellaneous variables 129: my %groupsearch_db; # database hash 130: my $diropendb = ""; # db file 131: # View Description Function Pointer 132: my %Views = ("Detailed Citation View" => \&detailed_citation_view, 133: "Summary View" => \&summary_view, 134: "Fielded Format" => \&fielded_format_view, 135: "XML/SGML" => \&xml_sgml_view, 136: "Compact View" => \&compact_view); 137: my %persistent_db; 138: my $hidden_fields; 139: ###################################################################### 140: ###################################################################### 141: 142: =pod 143: 144: =item &handler() - main handler invoked by httpd child 145: 146: =item Variables 147: 148: =over 4 149: 150: =item $hidden 151: 152: holds 'hidden' html forms 153: 154: =item $scrout 155: 156: string that holds portions of the screen output 157: 158: =back 159: 160: =cut 161: 162: ###################################################################### 163: ###################################################################### 164: sub handler { 165: my $r = shift; 166: # 167: my $closebutton; # button that closes the search window 168: # This button is different for the RAT compared to 169: # normal invocation. 170: # 171: $r->content_type('text/html'); 172: $r->send_http_header; 173: return OK if $r->header_only; 174: ## 175: ## Pick up form fields passed in the links. 176: ## 177: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 178: ['catalogmode','launch','acts','mode','form','element','pause', 179: 'phase','persistent_db_id','table','start','show']); 180: ## 181: ## The following is a trick - we wait a few seconds if asked to so 182: ## the daemon running the search can get ahead of the daemon 183: ## printing the results. We only need (theoretically) to do 184: ## this once, so the pause indicator is deleted 185: ## 186: if (exists($ENV{'form.pause'})) { 187: sleep(3); 188: delete($ENV{'form.pause'}); 189: } 190: ## 191: ## Initialize global variables 192: ## 193: my $domain = $r->dir_config('lonDefDomain'); 194: $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). 195: "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db"; 196: # 197: # set the name of the persistent database 198: # $ENV{'form.persistent_db_id'} can only have digits in it. 199: if (! exists($ENV{'form.persistent_db_id'}) || 200: ($ENV{'form.persistent_db_id'} =~ /\D/) || 201: ($ENV{'form.launch'} eq '1')) { 202: $ENV{'form.persistent_db_id'} = time; 203: } 204: my $persistent_db_file = "/home/httpd/perl/tmp/". 205: &Apache::lonnet::escape($domain). 206: '_'.&Apache::lonnet::escape($ENV{'user.name'}). 207: '_'.$ENV{'form.persistent_db_id'}.'_persistent_search.db'; 208: ## 209: if (! &get_persistent_form_data($r,$persistent_db_file)) { 210: if ($ENV{'form.phase'} =~ /(run_search|results)/) { 211: &Apache::lonnet::logthis("lonsearchcat:Unable to recover data ". 212: "from $persistent_db_file"); 213: $r->print(<<END); 214: <html> 215: <head><title>LON-CAPA Search Error</title></head> 216: <body> 217: We were unable to retrieve data describing your search. This is a serious 218: error and has been logged. Please alert your LON-CAPA administrator. 219: </body> 220: </html> 221: END 222: return OK; 223: } 224: } 225: ## 226: ## Clear out old values from groupsearch database 227: ## 228: untie %groupsearch_db if (tied(%groupsearch_db)); 229: if ($ENV{'form.launch'} eq '1' && 230: ($ENV{'form.catalogmode'} eq 'groupsearch') && 231: ($ENV{'form.phase'} eq 'results')) { 232: if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT(),0640)) { 233: &start_fresh_session(); 234: untie %groupsearch_db; 235: } else { 236: $r->print('<html><head></head><body>Unable to tie hash to db '. 237: 'file</body></html>'); 238: return OK; 239: } 240: } 241: ## 242: ## Configure hidden fields 243: ## 244: $hidden_fields = '<input type="hidden" name="persistent_db_id" value="'. 245: $ENV{'form.persistent_db_id'}.'" />'."\n"; 246: if (exists($ENV{'form.catalogmode'})) { 247: $hidden_fields .= '<input type="hidden" name="catalogmode" value="'. 248: $ENV{'form.catalogmode'}.'" />'."\n"; 249: } 250: if (exists($ENV{'form.form'})) { 251: $hidden_fields .= '<input type="hidden" name="form" value="'. 252: $ENV{'form.form'}.'" />'."\n"; 253: } 254: if (exists($ENV{'form.element'})) { 255: $hidden_fields .= '<input type="hidden" name="element" value="'. 256: $ENV{'form.element'}.'" />'."\n"; 257: } 258: if (exists($ENV{'form.mode'})) { 259: $hidden_fields .= '<input type="hidden" name="mode" value="'. 260: $ENV{'form.mode'}.'" />'."\n"; 261: } 262: ## 263: ## Configure dynamic components of interface 264: ## 265: if ($ENV{'form.catalogmode'} eq 'interactive') { 266: $closebutton="<input type='button' name='close' value='CLOSE' "; 267: if ($ENV{'form.phase'} =~ /(results|run_search)/) { 268: $closebutton .="onClick='parent.close()'"; 269: } else { 270: $closebutton .="onClick='self.close()'"; 271: } 272: $closebutton .=">\n"; 273: } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { 274: $closebutton="<input type='button' name='close' value='CLOSE' "; 275: if ($ENV{'form.phase'} =~ /(results|run_search)/) { 276: $closebutton .="onClick='parent.close()'"; 277: } else { 278: $closebutton .="onClick='self.close()'"; 279: } 280: $closebutton .= ">"; 281: $importbutton=<<END; 282: <input type='button' name='import' value='IMPORT' 283: onClick='javascript:select_group()'> 284: END 285: } else { 286: $closebutton = ''; 287: $importbutton = ''; 288: } 289: ## 290: ## Sanity checks on form elements 291: ## 292: if (!defined($ENV{'form.viewselect'})) { 293: if (($ENV{'form.catalogmode'} eq 'groupsearch') || 294: ($ENV{'form.catalogmode'} eq 'interactive')) { 295: $ENV{'form.viewselect'} ="Compact View"; 296: } else { 297: $ENV{'form.viewselect'} ="Detailed Citation View"; 298: } 299: } 300: $ENV{'form.phase'} = 'disp_basic' if (! exists($ENV{'form.phase'})); 301: ## 302: ## Switch on the phase 303: ## 304: if ($ENV{'form.phase'} eq 'disp_basic') { 305: &print_basic_search_form($r,$closebutton); 306: } elsif ($ENV{'form.phase'} eq 'disp_adv') { 307: &print_advanced_search_form($r,$closebutton); 308: } elsif ($ENV{'form.phase'} eq 'results') { 309: &display_results($r,$importbutton,$closebutton); 310: } elsif($ENV{'form.phase'} eq 'run_search') { 311: my ($query,$customquery,$customshow,$libraries,$pretty_string) = 312: &get_persistent_data($persistent_db_file, 313: ['query','customquery','customshow', 314: 'libraries','pretty_string']); 315: &run_search($r,$query,$customquery,$customshow, 316: $libraries,$pretty_string); 317: } elsif(($ENV{'form.phase'} eq 'basic_search') || 318: ($ENV{'form.phase'} eq 'adv_search')) { 319: # Set up table 320: if (! defined(&create_results_table())) { 321: $r->print(<<END); 322: <html><head><title>Search Error</title></head> 323: <body> 324: Unable to create table in which to store search results. 325: The search has been aborted. 326: </body> 327: </html> 328: END 329: return OK; 330: } 331: delete($ENV{'form.launch'}); 332: if (! &make_form_data_persistent($r,$persistent_db_file)) { 333: $r->print(<<END); 334: <html><head><title>Search Error</title></head> 335: <body> 336: Unable to properly store search information. The search has been aborted. 337: </body> 338: </html> 339: END 340: return OK; 341: } 342: # 343: # We are running a search 344: my ($query,$customquery,$customshow,$libraries) = 345: (undef,undef,undef,undef); 346: my $pretty_string; 347: if ($ENV{'form.phase'} eq 'basic_search') { 348: ($query,$pretty_string) = &parse_basic_search($r,$closebutton); 349: } else { # Advanced search 350: ($query,$customquery,$customshow,$libraries,$pretty_string) 351: = &parse_advanced_search($r,$closebutton); 352: return OK if (! defined($query)); 353: } 354: &make_persistent($r, 355: { query => $query, 356: customquery => $customquery, 357: customshow => $customshow, 358: libraries => $libraries, 359: pretty_string => $pretty_string }, 360: $persistent_db_file); 361: ## 362: ## Print out the frames interface 363: ## 364: &print_frames_interface($r); 365: } 366: return OK; 367: } 368: 369: ###################################################################### 370: ###################################################################### 371: 372: =pod 373: 374: =item &print_basic_search_form() 375: 376: Returns a scalar which holds html for the basic search form. 377: 378: =cut 379: 380: ###################################################################### 381: ###################################################################### 382: 383: sub print_basic_search_form{ 384: my ($r,$closebutton) = @_; 385: my $scrout=<<"ENDDOCUMENT"; 386: <html> 387: <head> 388: <title>The LearningOnline Network with CAPA</title> 389: <script type="text/javascript"> 390: function openhelp(val) { 391: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 392: 'scrollbars=1,width=600,height=300'); 393: openhelpwin.focus(); 394: } 395: </script> 396: </head> 397: <body bgcolor="#FFFFFF"> 398: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 399: <h1>Search Catalog</h1> 400: <form method="post" action="/adm/searchcat"> 401: <input type="hidden" name="phase" value="basic_search" /> 402: $hidden_fields 403: <h3>Basic Search</h3> 404: <p> 405: Enter terms or phrases separated by AND, OR, or NOT 406: then press SEARCH below. 407: </p> 408: <p> 409: <table> 410: <tr><td> 411: ENDDOCUMENT 412: $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40). 413: ' '; 414: my $checkbox = &simplecheckbox('related',$ENV{'form.related'}); 415: $scrout.=<<END; 416: </td><td><a href="/adm/searchcat?phase=disp_adv">Advanced Search</a></td></tr> 417: <tr><td>$checkbox use related words</td><td></td></tr> 418: </table> 419: </p> 420: <p> 421:  <input type="submit" name="basicsubmit" value='SEARCH' />  422: $closebutton 423: END 424: $scrout.=&selectbox(undef,'viewselect', 425: $ENV{'form.viewselect'}, 426: undef,undef,undef, 427: sort(keys(%Views))); 428: $scrout.=<<ENDDOCUMENT; 429: <input type="button" value="HELP" onClick="openhelp()" /> 430: </p> 431: </form> 432: </body> 433: </html> 434: ENDDOCUMENT 435: $r->print($scrout); 436: return; 437: } 438: ###################################################################### 439: ###################################################################### 440: 441: =pod 442: 443: =item &advanced_search_form() 444: 445: Returns a scalar which holds html for the advanced search form. 446: 447: =cut 448: 449: ###################################################################### 450: ###################################################################### 451: 452: sub print_advanced_search_form{ 453: my ($r,$closebutton) = @_; 454: my $advanced_buttons = <<"END"; 455: <p> 456: <input type="submit" name="advancedsubmit" value='SEARCH' /> 457: <input type="reset" name="reset" value='RESET' /> 458: $closebutton 459: <input type="button" value="HELP" onClick="openhelp()" /> 460: </p> 461: END 462: if (!defined($ENV{'form.viewselect'})) { 463: $ENV{'form.viewselect'} ="Detailed Citation View"; 464: } 465: my $scrout=<<"ENDHEADER"; 466: <html> 467: <head> 468: <title>The LearningOnline Network with CAPA</title> 469: <script type="text/javascript"> 470: function openhelp(val) { 471: openhelpwin=open('/adm/help/searchcat.html','helpscreen', 472: 'scrollbars=1,width=600,height=300'); 473: openhelpwin.focus(); 474: } 475: </script> 476: </head> 477: <body bgcolor="#FFFFFF"> 478: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 479: <h1>Advanced Catalog Search</h1> 480: <hr /> 481: Enter terms or phrases separated by search operators 482: such as AND, OR, or NOT.<br /> 483: <form method="post" action="/adm/searchcat"> 484: $advanced_buttons 485: $hidden_fields 486: <input type="hidden" name="phase" value="adv_search" /> 487: <table> 488: <tr><td><font color="#800000" face="helvetica"><b>VIEW:</b></font></td> 489: <td> 490: ENDHEADER 491: $scrout.=&selectbox(undef,'viewselect', 492: $ENV{'form.viewselect'}, 493: undef,undef,undef, 494: sort(keys(%Views))); 495: $scrout.="</td><td>Related<br />Words</td></tr>\n"; 496: $scrout.=&searchphrasefield_with_related('title', 'title' , 497: $ENV{'form.title'}); 498: $scrout.=&searchphrasefield('author', 'author' ,$ENV{'form.author'}); 499: $scrout.=&searchphrasefield_with_related('subject', 'subject' , 500: $ENV{'form.subject'}); 501: $scrout.=&searchphrasefield_with_related('keywords','keywords', 502: $ENV{'form.keywords'}); 503: $scrout.=&searchphrasefield('URL', 'url' ,$ENV{'form.url'}); 504: $scrout.=&searchphrasefield_with_related('notes', 'notes' , 505: $ENV{'form.notes'}); 506: $scrout.=&searchphrasefield_with_related('abstract','abstract', 507: $ENV{'form.abstract'}); 508: # Hack - an empty table row. 509: $scrout.="<tr><td> </td><td> </td><td> </td></tr>\n"; 510: $scrout.=&searchphrasefield('file<br />extension','mime', 511: $ENV{'form.mime'}); 512: $scrout.="<tr><td> </td><td> </td><td> </td></tr>\n"; 513: $scrout.=&searchphrasefield('publisher<br />owner','owner', 514: $ENV{'form.owner'}); 515: $scrout.="</table>\n"; 516: $ENV{'form.category'}='any' unless length($ENV{'form.category'}); 517: $scrout.=&selectbox('File Category','category', 518: $ENV{'form.category'}, 519: 'any','Any category', 520: undef, 521: (&Apache::loncommon::filecategories())); 522: $ENV{'form.language'}='any' unless length($ENV{'form.language'}); 523: #---------------------------------------------------------------- 524: # Allow restriction to multiple domains. 525: # I make the crazy assumption that there will never be a domain 'any'. 526: # 527: $ENV{'form.domains'} = 'any' if (! exists($ENV{'form.domains'})); 528: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}} 529: : ($ENV{'form.domains'}) ); 530: my %domain_hash = (); 531: foreach (@allowed_domains) { 532: $domain_hash{$_}++; 533: } 534: my @domains =&Apache::loncommon::get_domains(); 535: # adjust the size of the select box 536: my $size = 4; 537: my $size = (scalar @domains < ($size - 1) ? scalar @domains + 1 : $size); 538: $scrout.="\n".'<font color="#800000" face="helvetica"><b>'. 539: 'DOMAINS</b></font><br />'. 540: '<select name="domains" size="'.$size.'" multiple>'."\n". 541: '<option name="any" value="any" '. 542: ($domain_hash{'any'}? 'selected ' :''). 543: '>all domains</option>'."\n"; 544: foreach my $dom (sort @domains) { 545: $scrout.="<option name=\"$dom\" ". 546: ($domain_hash{$dom} ? 'selected ' :'').">$dom</option>\n"; 547: } 548: $scrout.="</select>\n"; 549: #---------------------------------------------------------------- 550: $scrout.=&selectbox('Limit by language','language', 551: $ENV{'form.language'},'any','Any Language', 552: \&{Apache::loncommon::languagedescription}, 553: (&Apache::loncommon::languageids), 554: ); 555: # ------------------------------------------------ Compute date selection boxes 556: $scrout.=<<CREATIONDATESTART; 557: <p> 558: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b> 559: </font> 560: <br /> 561: between: 562: CREATIONDATESTART 563: $scrout.=&dateboxes('creationdatestart',1,1,1976, 564: $ENV{'form.creationdatestart_month'}, 565: $ENV{'form.creationdatestart_day'}, 566: $ENV{'form.creationdatestart_year'}, 567: ); 568: $scrout.="and:\n"; 569: $scrout.=&dateboxes('creationdateend',12,31,2051, 570: $ENV{'form.creationdateend_month'}, 571: $ENV{'form.creationdateend_day'}, 572: $ENV{'form.creationdateend_year'}, 573: ); 574: $scrout.="</p>"; 575: $scrout.=<<LASTREVISIONDATESTART; 576: <p> 577: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE: 578: </b></font> 579: <br />between: 580: LASTREVISIONDATESTART 581: $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976, 582: $ENV{'form.lastrevisiondatestart_month'}, 583: $ENV{'form.lastrevisiondatestart_day'}, 584: $ENV{'form.lastrevisiondatestart_year'}, 585: ); 586: $scrout.=<<LASTREVISIONDATEEND; 587: and: 588: LASTREVISIONDATEEND 589: $scrout.=&dateboxes('lastrevisiondateend',12,31,2051, 590: $ENV{'form.lastrevisiondateend_month'}, 591: $ENV{'form.lastrevisiondateend_day'}, 592: $ENV{'form.lastrevisiondateend_year'}, 593: ); 594: $scrout.='</p>'; 595: $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'}); 596: $scrout.=&selectbox('Limit by copyright/distribution','copyright', 597: $ENV{'form.copyright'}, 598: 'any','Any copyright/distribution', 599: \&{Apache::loncommon::copyrightdescription}, 600: (&Apache::loncommon::copyrightids), 601: ); 602: # ------------------------------------------- Compute customized metadata field 603: $scrout.=<<CUSTOMMETADATA; 604: <p> 605: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b> 606: </font> 607: For resource-specific metadata, enter in an expression in the form of 608: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br /> 609: <b>Example:</b> grandmother=75 OR grandfather=85 610: <br /> 611: CUSTOMMETADATA 612: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'}); 613: $scrout.=<<CUSTOMSHOW; 614: <p> 615: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b> 616: </font> 617: Enter in a space-separated list of special metadata fields to show 618: in a fielded listing for each record result. 619: <br /> 620: CUSTOMSHOW 621: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'}); 622: $scrout.=<<ENDDOCUMENT; 623: $advanced_buttons 624: </form> 625: </body> 626: </html> 627: ENDDOCUMENT 628: $r->print($scrout); 629: return; 630: } 631: 632: ###################################################################### 633: ###################################################################### 634: 635: =pod 636: 637: =item &get_persistent_form_data 638: 639: Inputs: filename of database 640: 641: Outputs: returns undef on database errors. 642: 643: This function is the reverse of &make_persistent() for form data. 644: Retrieve persistent data from %persistent_db. Retrieved items will have their 645: values unescaped. If a form value already exists in $ENV, it will not be 646: overwritten. Form values that are array references may have values appended 647: to them. 648: 649: =cut 650: 651: ###################################################################### 652: ###################################################################### 653: sub get_persistent_form_data { 654: my $r = shift; 655: my $filename = shift; 656: return 0 if (! -e $filename); 657: return undef if (! tie(%persistent_db,'GDBM_File',$filename, 658: &GDBM_READER(),0640)); 659: # 660: # These make sure we do not get array references printed out as 'values'. 661: my %arrays_allowed = ('form.category'=>1,'form.domains'=>1); 662: # 663: # Loop through the keys, looking for 'form.' 664: foreach my $name (keys(%persistent_db)) { 665: next if ($name !~ /^form./); 666: my @values = map { 667: &Apache::lonnet::unescape($_); 668: } split(',',$persistent_db{$name}); 669: next if (@values <1); 670: if (exists($ENV{$name})) { 671: if (ref($ENV{$name}) eq 'ARRAY') { 672: # If it is an array, tack @values on the end of it. 673: $ENV{$name} = [@$ENV{$name},@values]; 674: } elsif (! ref($ENV{$name}) && $arrays_allowed{$name}) { 675: # if arrays are allowed, turn it into one and add @values 676: $ENV{$name} = [$ENV{$name},@values]; 677: } # otherwise, assume the value in $ENV{$name} is better than ours. 678: } else { 679: if ($arrays_allowed{$name}) { 680: $ENV{$name} = [@values]; 681: } else { 682: $ENV{$name} = $values[0] if ($values[0]); 683: } 684: } 685: } 686: untie (%persistent_db); 687: return 1; 688: } 689: ###################################################################### 690: ###################################################################### 691: 692: =pod 693: 694: =item &get_persistent_data 695: 696: Inputs: filename of database, ref to array of values to recover. 697: 698: Outputs: array of values. Returns undef on error. 699: 700: This function is the reverse of &make_persistent(); 701: Retrieve persistent data from %persistent_db. Retrieved items will have their 702: values unescaped. If the item contains commas (before unescaping), the 703: returned value will be an array pointer. 704: 705: =cut 706: 707: ###################################################################### 708: ###################################################################### 709: sub get_persistent_data { 710: my $filename = shift; 711: my @Vars = @{shift()}; 712: my @Values; # Return array 713: return undef if (! -e $filename); 714: return undef if (! tie(%persistent_db,'GDBM_File',$filename, 715: &GDBM_READER(),0640)); 716: foreach my $name (@Vars) { 717: if (! exists($persistent_db{$name})) { 718: push @Values, undef; 719: next; 720: } 721: my @values = map { 722: &Apache::lonnet::unescape($_); 723: } split(',',$persistent_db{$name}); 724: if (@values == 1) { 725: push @Values,$values[0]; 726: } else { 727: push @Values,\@values; 728: } 729: } 730: untie (%persistent_db); 731: return @Values; 732: } 733: 734: ###################################################################### 735: ###################################################################### 736: 737: =pod 738: 739: =item &make_persistent() 740: 741: Inputs: Hash of values to save, filename of persistent database. 742: 743: Store variables away to the %persistent_db. 744: Values will be escaped. Values that are array pointers will have their 745: elements escaped and concatenated in a comma seperated string. 746: 747: =cut 748: 749: ###################################################################### 750: ###################################################################### 751: sub make_persistent { 752: my $r = shift; 753: my %save = %{shift()}; 754: my $filename = shift; 755: return undef if (! tie(%persistent_db,'GDBM_File', 756: $filename,&GDBM_WRCREAT(),0640)); 757: foreach my $name (keys(%save)) { 758: next if (! exists($save{$name})); 759: next if (! defined($save{$name}) || $save{$name} eq ''); 760: my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name})); 761: # We handle array references, but not recursively. 762: my $store = join(',', map { &Apache::lonnet::escape($_); } @values ); 763: $persistent_db{$name} = $store; 764: } 765: untie(%persistent_db); 766: return 1; 767: } 768: 769: ###################################################################### 770: ###################################################################### 771: 772: =pod 773: 774: =item &make_form_data_persistent() 775: 776: Inputs: filename of persistent database. 777: 778: Store most form variables away to the %persistent_db. 779: Values will be escaped. Values that are array pointers will have their 780: elements escaped and concatenated in a comma seperated string. 781: 782: =cut 783: 784: ###################################################################### 785: ###################################################################### 786: sub make_form_data_persistent { 787: my $r = shift; 788: my $filename = shift; 789: my %save; 790: foreach (keys(%ENV)) { 791: next if (!/^form/ || /submit/); 792: $save{$_} = $ENV{$_}; 793: } 794: return &make_persistent($r,\%save,$filename); 795: } 796: 797: ###################################################################### 798: # HTML form building functions # 799: ###################################################################### 800: 801: =pod 802: 803: =item HTML form building functions 804: 805: =over 4 806: 807: =cut 808: 809: ############################################### 810: ############################################### 811: 812: =pod 813: 814: =item &simpletextfield() 815: 816: Inputs: $name,$value,$size 817: 818: Returns a text input field with the given name, value, and size. 819: If size is not specified, a value of 20 is used. 820: 821: =cut 822: 823: ############################################### 824: ############################################### 825: 826: sub simpletextfield { 827: my ($name,$value,$size)=@_; 828: $size = 20 if (! defined($size)); 829: return '<input type="text" name="'.$name. 830: '" size="'.$size.'" value="'.$value.'" />'; 831: } 832: 833: ############################################### 834: ############################################### 835: 836: =pod 837: 838: =item &simplecheckbox() 839: 840: Inputs: $name,$value 841: 842: Returns a simple check box with the given $name. 843: If $value eq 'on' the box is checked. 844: 845: =cut 846: 847: ############################################### 848: ############################################### 849: 850: sub simplecheckbox { 851: my ($name,$value)=@_; 852: my $checked=''; 853: $checked="checked" if $value eq 'on'; 854: return '<input type="checkbox" name="'.$name.'" '. $checked . ' />'; 855: } 856: 857: ############################################### 858: ############################################### 859: 860: =pod 861: 862: =item &fieldtitle() 863: 864: Input: $title 865: 866: Returns a scalar with html which will display $title as a search 867: field heading. 868: 869: =cut 870: 871: ############################################### 872: ############################################### 873: 874: sub fieldtitle { 875: my $title = uc(shift()); 876: return '<font color="#800000" face="helvetica"><b>'.$title. 877: ': </b></font>'; 878: } 879: 880: ############################################### 881: ############################################### 882: 883: =pod 884: 885: =item &searchphrasefield() 886: 887: Inputs: $title,$name,$value 888: 889: Returns html for a title line and an input field for entering search terms. 890: The entry field (which is where the $name and $value are used) is a 50 column 891: simpletextfield. The html returned is for a row in a three column table. 892: 893: =cut 894: 895: ############################################### 896: ############################################### 897: 898: sub searchphrasefield { 899: my ($title,$name,$value)=@_; 900: return '<tr><td>'.&fieldtitle($title).'</td><td>'. 901: &simpletextfield($name,$value,50)."</td><td> </td></tr>\n"; 902: } 903: 904: ############################################### 905: ############################################### 906: 907: =pod 908: 909: =item &searchphrasefield_with_related() 910: 911: Inputs: $title,$name,$value 912: 913: Returns html for a title line and an input field for entering search terms 914: and a check box for 'related words'. The entry field (which is where the 915: $name and $value are used) is a 50 column simpletextfield. The name of 916: the related words checkbox is "$name_related". 917: 918: =cut 919: 920: ############################################### 921: ############################################### 922: 923: sub searchphrasefield_with_related { 924: my ($title,$name,$value)=@_; 925: return '<tr><td>'.&fieldtitle($title).'</td><td>'. 926: &simpletextfield($name,$value,50).'</td><td align="center"> '. 927: &simplecheckbox($name.'_related',$ENV{'form.'.$name.'_related'}). 928: " </td></tr>\n"; 929: } 930: 931: ############################################### 932: ############################################### 933: 934: =pod 935: 936: =item &dateboxes() 937: 938: Returns html selection form elements for the specification of 939: the day, month, and year. 940: 941: =cut 942: 943: ############################################### 944: ############################################### 945: 946: sub dateboxes { 947: my ($name,$defaultmonth,$defaultday,$defaultyear, 948: $currentmonth,$currentday,$currentyear)=@_; 949: ($defaultmonth,$defaultday,$defaultyear)=('','',''); 950: # 951: # Day 952: my $day=<<END; 953: <select name="${name}_day"> 954: <option value='$defaultday'> </option> 955: END 956: for (my $i = 1; $i<=31; $i++) { 957: $day.="<option value=\"$i\">$i</option>\n"; 958: } 959: $day.="</select>\n"; 960: $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday); 961: # 962: # Month 963: my $month=<<END; 964: <select name="${name}_month"> 965: <option value='$defaultmonth'> </option> 966: END 967: my $i = 1; 968: foreach (qw/January February March April May June 969: July August September October November December /){ 970: $month .="<option value=\"$i\">$_</option>\n"; 971: $i++; 972: } 973: $month.="</select>\n"; 974: $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth); 975: # 976: # Year (obviously) 977: my $year=<<END; 978: <select name="${name}_year"> 979: <option value='$defaultyear'> </option> 980: END 981: my $maxyear = 2051; 982: for (my $i = 1976; $i<=$maxyear; $i++) { 983: $year.="<option value=\"$i\">$i</option>\n"; 984: } 985: $year.="</select>\n"; 986: $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear); 987: return "$month$day$year"; 988: } 989: 990: ############################################### 991: ############################################### 992: 993: =pod 994: 995: =item &selectbox() 996: 997: Returns a scalar containing an html <select> form. 998: 999: Inputs: 1000: 1001: =over 4 1002: 1003: =item $title 1004: 1005: Printed above the select box, in uppercase. If undefined, only a select 1006: box will be returned, with no additional html. 1007: 1008: =item $name 1009: 1010: The name element of the <select> tag. 1011: 1012: =item $default 1013: 1014: The default value of the form. Can be $anyvalue, or in @idlist. 1015: 1016: =item $anyvalue 1017: 1018: The <option value="..."> used to indicate a default of 1019: none of the values. Can be undef. 1020: 1021: =item $anytag 1022: 1023: The text associate with $anyvalue above. 1024: 1025: =item $functionref 1026: 1027: Each element in @idlist will be passed as a parameter 1028: to the function referenced here. The return value of the function should 1029: be a scalar description of the items. If this value is undefined the 1030: description of each item in @idlist will be the item name. 1031: 1032: =item @idlist 1033: 1034: The items to be selected from. One of these or $anyvalue will be the 1035: value returned by the form element, $ENV{form.$name}. 1036: 1037: =back 1038: 1039: =cut 1040: 1041: ############################################### 1042: 1043: sub selectbox { 1044: my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_; 1045: if (! defined($functionref)) { $functionref = sub { $_[0]}; } 1046: my $selout=''; 1047: if (defined($title)) { 1048: my $uctitle=uc($title); 1049: $selout="\n".'<p><font color="#800000" face="helvetica">'. 1050: '<b>'.$uctitle.': </b></font>'; 1051: } 1052: $selout .= '<select name="'.$name.'">'; 1053: unshift @idlist,$anyvalue if (defined($anyvalue)); 1054: foreach (@idlist) { 1055: $selout.='<option value="'.$_.'"'; 1056: if ($_ eq $default and !/^any$/) { 1057: $selout.=' selected >'.&{$functionref}($_).'</option>'; 1058: } 1059: elsif ($_ eq $default and /^$anyvalue$/) { 1060: $selout.=' selected >'.$anytag.'</option>'; 1061: } 1062: else {$selout.='>'.&{$functionref}($_).'</option>';} 1063: } 1064: return $selout.'</select>'.(defined($title)?'</p>':' '); 1065: } 1066: 1067: ###################################################################### 1068: # End of HTML form building functions # 1069: ###################################################################### 1070: 1071: =pod 1072: 1073: =back 1074: 1075: =cut 1076: 1077: 1078: ###################################################################### 1079: ###################################################################### 1080: 1081: =pod 1082: 1083: =item &parse_advanced_search() 1084: 1085: Parse advanced search form and return the following: 1086: 1087: =over 4 1088: 1089: =item $query Scalar containing an SQL query. 1090: 1091: =item $customquery Scalar containing a custom query. 1092: 1093: =item $customshow Scalar containing commands to show custom metadata. 1094: 1095: =item $libraries_to_query Reference to array of domains to search. 1096: 1097: =back 1098: 1099: =cut 1100: 1101: ###################################################################### 1102: ###################################################################### 1103: sub parse_advanced_search { 1104: my ($r,$closebutton)=@_; 1105: my $fillflag=0; 1106: my $pretty_search_string = "<br />\n"; 1107: # Clean up fields for safety 1108: for my $field ('title','author','subject','keywords','url','version', 1109: 'creationdatestart_month','creationdatestart_day', 1110: 'creationdatestart_year','creationdateend_month', 1111: 'creationdateend_day','creationdateend_year', 1112: 'lastrevisiondatestart_month','lastrevisiondatestart_day', 1113: 'lastrevisiondatestart_year','lastrevisiondateend_month', 1114: 'lastrevisiondateend_day','lastrevisiondateend_year', 1115: 'notes','abstract','mime','language','owner', 1116: 'custommetadata','customshow','category') { 1117: $ENV{"form.$field"}=~s/[^\w\/\s\=\-\"\']//g; 1118: } 1119: foreach ('mode','form','element') { 1120: # is this required? Hmmm. 1121: next unless (exists($ENV{"form.$_"})); 1122: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); 1123: $ENV{"form.$_"}=~s/[^\w\/\s\=\-\"\']//g; 1124: } 1125: # Preprocess the category form element. 1126: if ($ENV{'form.category'} ne 'any') { 1127: my @extensions = &Apache::loncommon::filecategorytypes 1128: ($ENV{'form.category'}); 1129: $ENV{'form.mime'} = join ' OR ',@extensions; 1130: } 1131: # Check to see if enough information was filled in 1132: for my $field ('title','author','subject','keywords','url','version', 1133: 'notes','abstract','mime','language','owner', 1134: 'custommetadata') { 1135: if (&filled($ENV{"form.$field"})) { 1136: $fillflag++; 1137: } 1138: } 1139: unless ($fillflag) { 1140: &output_blank_field_error($r,$closebutton); 1141: return ; 1142: } 1143: # Turn the form input into a SQL-based query 1144: my $query=''; 1145: my @queries; 1146: my $font = '<font color="#800000" face="helvetica">'; 1147: # Evaluate logical expression AND/OR/NOT phrase fields. 1148: foreach my $field ('title','author','subject','notes','abstract','url', 1149: 'keywords','version','owner','mime') { 1150: if ($ENV{'form.'.$field}) { 1151: my $searchphrase = $ENV{'form.'.$field}; 1152: $pretty_search_string .= $font."$field</font> contains <b>". 1153: $searchphrase."</b>"; 1154: if ($ENV{'form.'.$field.'_related'}) { 1155: my @New_Words; 1156: ($searchphrase,@New_Words) = &related_version($searchphrase); 1157: if (@New_Words) { 1158: $pretty_search_string .= " with related words: ". 1159: "<b>@New_Words</b>."; 1160: } else { 1161: $pretty_search_string .= " with no related words."; 1162: } 1163: } 1164: $pretty_search_string .= "<br />\n"; 1165: push @queries,&build_SQL_query($field,$searchphrase); 1166: } 1167: } 1168: # I dislike the hack below. 1169: if ($ENV{'form.category'}) { 1170: $ENV{'form.mime'}=''; 1171: } 1172: # Evaluate option lists 1173: if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') { 1174: push @queries,"(language like \"$ENV{'form.language'}\")"; 1175: $pretty_search_string.=$font."language</font>= ". 1176: &Apache::loncommon::languagedescription($ENV{'form.language'}). 1177: "<br />\n"; 1178: } 1179: if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') { 1180: push @queries,"(copyright like \"$ENV{'form.copyright'}\")"; 1181: $pretty_search_string.=$font."copyright</font> = ". 1182: &Apache::loncommon::copyrightdescription($ENV{'form.copyright'}). 1183: "<br \>\n"; 1184: } 1185: # 1186: # Evaluate date windows 1187: my $datequery=&build_date_queries( 1188: $ENV{'form.creationdatestart_month'}, 1189: $ENV{'form.creationdatestart_day'}, 1190: $ENV{'form.creationdatestart_year'}, 1191: $ENV{'form.creationdateend_month'}, 1192: $ENV{'form.creationdateend_day'}, 1193: $ENV{'form.creationdateend_year'}, 1194: $ENV{'form.lastrevisiondatestart_month'}, 1195: $ENV{'form.lastrevisiondatestart_day'}, 1196: $ENV{'form.lastrevisiondatestart_year'}, 1197: $ENV{'form.lastrevisiondateend_month'}, 1198: $ENV{'form.lastrevisiondateend_day'}, 1199: $ENV{'form.lastrevisiondateend_year'}, 1200: ); 1201: # Test to see if date windows are legitimate 1202: if ($datequery=~/^Incorrect/) { 1203: &output_date_error($r,$datequery,$closebutton); 1204: return ; 1205: } elsif ($datequery) { 1206: # Here is where you would set up pretty_search_string to output 1207: # date query information. 1208: push @queries,$datequery; 1209: } 1210: # Process form information for custom metadata querying 1211: my $customquery=undef; 1212: if ($ENV{'form.custommetadata'}) { 1213: $pretty_search_string .=$font."Custom Metadata Search</font>: <b>". 1214: $ENV{'form.custommetadata'}."</b><br />\n"; 1215: $customquery=&build_custommetadata_query('custommetadata', 1216: $ENV{'form.custommetadata'}); 1217: } 1218: my $customshow=undef; 1219: if ($ENV{'form.customshow'}) { 1220: $pretty_search_string .=$font."Custom Metadata Display</font>: <b>". 1221: $ENV{'form.customshow'}."</b><br />\n"; 1222: $customshow=$ENV{'form.customshow'}; 1223: $customshow=~s/[^\w\s]//g; 1224: my @fields=split(/\s+/,$customshow); 1225: $customshow=join(" ",@fields); 1226: } 1227: ## --------------------------------------------------------------- 1228: ## Deal with restrictions to given domains 1229: ## 1230: my $libraries_to_query = undef; 1231: # $ENV{'form.domains'} can be either a scalar or an array reference. 1232: # We need an array. 1233: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}} 1234: : ($ENV{'form.domains'}) ); 1235: my %domain_hash = (); 1236: my $pretty_domains_string; 1237: foreach (@allowed_domains) { 1238: $domain_hash{$_}++; 1239: } 1240: if ($domain_hash{'any'}) { 1241: $pretty_domains_string = "Searching all domains."; 1242: } else { 1243: if (@allowed_domains > 1) { 1244: $pretty_domains_string = "Searching domains:"; 1245: } else { 1246: $pretty_domains_string = "Searching domain "; 1247: } 1248: foreach (sort @allowed_domains) { 1249: $pretty_domains_string .= "<b>$_</b> "; 1250: } 1251: foreach (keys(%Apache::lonnet::libserv)) { 1252: if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) { 1253: push @$libraries_to_query,$_; 1254: } 1255: } 1256: } 1257: $pretty_search_string .= $pretty_domains_string."<br />\n"; 1258: # 1259: if (@queries) { 1260: $query=join(" AND ",@queries); 1261: $query="select * from metadata where $query"; 1262: } elsif ($customquery) { 1263: $query = ''; 1264: } 1265: return ($query,$customquery,$customshow,$libraries_to_query, 1266: $pretty_search_string); 1267: } 1268: 1269: ###################################################################### 1270: ###################################################################### 1271: 1272: =pod 1273: 1274: =item &parse_basic_search() 1275: 1276: Parse the basic search form and return a scalar containing an sql query. 1277: 1278: =cut 1279: 1280: ###################################################################### 1281: ###################################################################### 1282: sub parse_basic_search { 1283: my ($r,$closebutton)=@_; 1284: # Clean up fields for safety 1285: for my $field ('basicexp') { 1286: $ENV{"form.$field"}=~s/[^\w\s\-]//g; 1287: } 1288: foreach ('mode','form','element') { 1289: # is this required? Hmmm. 1290: next unless (exists($ENV{"form.$_"})); 1291: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"}); 1292: $ENV{"form.$_"}=~s/[^\w\/\s\=\-\"\']//g; 1293: } 1294: 1295: # Check to see if enough is filled in 1296: unless (&filled($ENV{'form.basicexp'})) { 1297: &output_blank_field_error($r,$closebutton); 1298: return OK; 1299: } 1300: my $pretty_search_string = '<b>'.$ENV{'form.basicexp'}.'</b>'; 1301: my $search_string = $ENV{'form.basicexp'}; 1302: if ($ENV{'form.related'}) { 1303: my @New_Words; 1304: ($search_string,@New_Words) = &related_version($ENV{'form.basicexp'}); 1305: if (@New_Words) { 1306: $pretty_search_string .= " with related words: <b>@New_Words</b>."; 1307: } else { 1308: $pretty_search_string .= " with no related words."; 1309: } 1310: } 1311: # Build SQL query string based on form page 1312: my $query=''; 1313: my $concatarg=join('," ",', 1314: ('title', 'author', 'subject', 'notes', 'abstract', 1315: 'keywords')); 1316: $concatarg='title' if $ENV{'form.titleonly'}; 1317: $query=&build_SQL_query('concat('.$concatarg.')',$search_string); 1318: $pretty_search_string .= "<br />\n"; 1319: return 'select * from metadata where '.$query,$pretty_search_string; 1320: } 1321: 1322: 1323: ###################################################################### 1324: ###################################################################### 1325: 1326: =pod 1327: 1328: =item &related_version 1329: 1330: Modifies an input string to include related words. Words in the string 1331: are replaced with parenthesized lists of 'OR'd words. For example 1332: "torque" is replaced with "(torque OR word1 OR word2 OR ...)". 1333: 1334: Note: Using this twice on a string is probably silly. 1335: 1336: =cut 1337: 1338: ###################################################################### 1339: ###################################################################### 1340: sub related_version { 1341: my $search_string = shift; 1342: my $result = $search_string; 1343: my %New_Words = (); 1344: while ($search_string =~ /(\w+)/cg) { 1345: my $word = $1; 1346: next if (lc($word) =~ /\b(or|and|not)\b/); 1347: my @Words = &Apache::loncommon::get_related_words($word); 1348: @Words = ($#Words>4? @Words[0..4] : @Words); 1349: foreach (@Words) { $New_Words{$_}++;} 1350: my $replacement = join " OR ", ($word,@Words); 1351: $result =~ s/(\b)$word(\b)/$1($replacement)$2/g; 1352: } 1353: return $result,sort(keys(%New_Words)); 1354: } 1355: 1356: ###################################################################### 1357: ###################################################################### 1358: 1359: =pod 1360: 1361: =item &build_SQL_query() 1362: 1363: Builds a SQL query string from a logical expression with AND/OR keywords 1364: using Text::Query and &recursive_SQL_query_builder() 1365: 1366: =cut 1367: 1368: ###################################################################### 1369: ###################################################################### 1370: sub build_SQL_query { 1371: my ($field_name,$logic_statement)=@_; 1372: my $q=new Text::Query('abc', 1373: -parse => 'Text::Query::ParseAdvanced', 1374: -build => 'Text::Query::Build'); 1375: $q->prepare($logic_statement); 1376: my $matchexp=${$q}{'matchexp'}; chomp $matchexp; 1377: my $sql_query=&recursive_SQL_query_build($field_name,$matchexp); 1378: return $sql_query; 1379: } 1380: 1381: ###################################################################### 1382: ###################################################################### 1383: 1384: =pod 1385: 1386: =item &build_custommetadata_query() 1387: 1388: Constructs a custom metadata query using a rather heinous regular 1389: expression. 1390: 1391: =cut 1392: 1393: ###################################################################### 1394: ###################################################################### 1395: sub build_custommetadata_query { 1396: my ($field_name,$logic_statement)=@_; 1397: my $q=new Text::Query('abc', 1398: -parse => 'Text::Query::ParseAdvanced', 1399: -build => 'Text::Query::BuildAdvancedString'); 1400: $q->prepare($logic_statement); 1401: my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; 1402: # quick fix to change literal into xml tag-matching 1403: # will eventually have to write a separate builder module 1404: # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\> 1405: $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to 1406: /\\<$1\\>?# \<wordone\> 1407: \[\^\\<\]?# [^\<] 1408: \*$2\[\^\\<\]?# *wordtwo[^\<] 1409: \*\\<\\\/$1\\>?# *\<\/wordone\> 1410: /g; 1411: return $matchexp; 1412: } 1413: 1414: ###################################################################### 1415: ###################################################################### 1416: 1417: =pod 1418: 1419: =item &recursive_SQL_query_build() 1420: 1421: Recursively constructs an SQL query. Takes as input $dkey and $pattern. 1422: 1423: =cut 1424: 1425: ###################################################################### 1426: ###################################################################### 1427: sub recursive_SQL_query_build { 1428: my ($dkey,$pattern)=@_; 1429: my @matches=($pattern=~/(\[[^\]|\[]*\])/g); 1430: return $pattern unless @matches; 1431: foreach my $match (@matches) { 1432: $match=~/\[ (\w+)\s(.*) \]/; 1433: my ($key,$value)=($1,$2); 1434: my $replacement=''; 1435: if ($key eq 'literal') { 1436: $replacement="($dkey like \"\%$value\%\")"; 1437: } 1438: elsif ($key eq 'not') { 1439: $value=~s/like/not like/; 1440: # $replacement="($dkey not like $value)"; 1441: $replacement="$value"; 1442: } 1443: elsif ($key eq 'and') { 1444: $value=~/(.*[\"|\)]) ([|$|\^].*)/; 1445: $replacement="($1 AND $2)"; 1446: } 1447: elsif ($key eq 'or') { 1448: $value=~/(.*[\"|$]) ([|\(|\^].*)/; 1449: $replacement="($1 OR $2)"; 1450: } 1451: substr($pattern, 1452: index($pattern,$match), 1453: length($match), 1454: $replacement 1455: ); 1456: } 1457: &recursive_SQL_query_build($dkey,$pattern); 1458: } 1459: 1460: ###################################################################### 1461: ###################################################################### 1462: 1463: =pod 1464: 1465: =item &build_date_queries() 1466: 1467: Builds a SQL logic query to check time/date entries. 1468: Also reports errors (check for /^Incorrect/). 1469: 1470: =cut 1471: 1472: ###################################################################### 1473: ###################################################################### 1474: sub build_date_queries { 1475: my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, 1476: $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; 1477: my @queries; 1478: if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) { 1479: unless ($cmonth1 and $cday1 and $cyear1 and 1480: $cmonth2 and $cday2 and $cyear2) { 1481: return "Incorrect entry for the creation date. You must specify ". 1482: "a starting month, day, and year and an ending month, ". 1483: "day, and year."; 1484: } 1485: my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1); 1486: $cnumeric1+=0; 1487: my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2); 1488: $cnumeric2+=0; 1489: if ($cnumeric1>$cnumeric2) { 1490: return "Incorrect entry for the creation date. The starting ". 1491: "date must occur before the ending date."; 1492: } 1493: my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '". 1494: "$cyear2-$cmonth2-$cday2 23:59:59')"; 1495: push @queries,$cquery; 1496: } 1497: if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) { 1498: unless ($lmonth1 and $lday1 and $lyear1 and 1499: $lmonth2 and $lday2 and $lyear2) { 1500: return "Incorrect entry for the last revision date. You must ". 1501: "specify a starting month, day, and year and an ending ". 1502: "month, day, and year."; 1503: } 1504: my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1); 1505: $lnumeric1+=0; 1506: my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2); 1507: $lnumeric2+=0; 1508: if ($lnumeric1>$lnumeric2) { 1509: return "Incorrect entry for the last revision date. The ". 1510: "starting date must occur before the ending date."; 1511: } 1512: my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '". 1513: "$lyear2-$lmonth2-$lday2 23:59:59')"; 1514: push @queries,$lquery; 1515: } 1516: if (@queries) { 1517: return join(" AND ",@queries); 1518: } 1519: return ''; 1520: } 1521: 1522: ###################################################################### 1523: ###################################################################### 1524: 1525: =pod 1526: 1527: =item &copyright_check() 1528: 1529: =cut 1530: 1531: ###################################################################### 1532: ###################################################################### 1533: 1534: sub copyright_check { 1535: my $Metadata = shift; 1536: # Check copyright tags and skip results the user cannot use 1537: my (undef,undef,$resdom,$resname) = split('/', 1538: $Metadata->{'url'}); 1539: # Check for priv 1540: if (($Metadata->{'copyright'} eq 'priv') && 1541: (($ENV{'user.name'} ne $resname) && 1542: ($ENV{'user.domain'} ne $resdom))) { 1543: return 0; 1544: } 1545: # Check for domain 1546: if (($Metadata->{'copyright'} eq 'domain') && 1547: ($ENV{'user.domain'} ne $resdom)) { 1548: return 0; 1549: } 1550: return 1; 1551: } 1552: 1553: ##################################################################### 1554: ##################################################################### 1555: 1556: =pod 1557: 1558: =item MySQL Table Description 1559: 1560: MySQL table creation requires a precise description of the data to be 1561: stored. The use of the correct types to hold data is vital to efficient 1562: storage and quick retrieval of records. The columns must be described in 1563: the following format: 1564: 1565: =cut 1566: 1567: ## 1568: ## Restrictions: 1569: ## columns of type 'text' and 'blob' cannot have defaults. 1570: ## columns of type 'enum' cannot be used for FULLTEXT. 1571: ## 1572: my @DataOrder = qw/id title author subject url keywords version notes 1573: abstract mime lang owner copyright creationdate lastrevisiondate hostname/; 1574: 1575: my %Datatypes = 1576: ( id =>{ type => 'INT', 1577: restrictions => 'NOT NULL', 1578: primary_key => 'yes', 1579: auto_inc => 'yes' 1580: }, 1581: title =>{ type=>'TEXT'}, 1582: author =>{ type=>'TEXT'}, 1583: subject =>{ type=>'TEXT'}, 1584: url =>{ type=>'TEXT', 1585: restrictions => 'NOT NULL' }, 1586: keywords =>{ type=>'TEXT'}, 1587: version =>{ type=>'TEXT'}, 1588: notes =>{ type=>'TEXT'}, 1589: abstract =>{ type=>'TEXT'}, 1590: mime =>{ type=>'TEXT'}, 1591: lang =>{ type=>'TEXT'}, 1592: owner =>{ type=>'TEXT'}, 1593: copyright =>{ type=>'TEXT'}, 1594: hostname =>{ type=>'TEXT'}, 1595: #-------------------------------------------------- 1596: creationdate =>{ type=>'DATETIME'}, 1597: lastrevisiondate =>{ type=>'DATETIME'}, 1598: #-------------------------------------------------- 1599: ); 1600: 1601: my @Fullindicies = 1602: qw/title author subject abstract mime language owner copyright/; 1603: 1604: ###################################################################### 1605: ###################################################################### 1606: 1607: =pod 1608: 1609: =item &create_results_table() 1610: 1611: Creates the table of search results by calling lonmysql. Stores the 1612: table id in $ENV{'form.table'} 1613: 1614: Inputs: none. 1615: 1616: Returns: the identifier of the table on success, undef on error. 1617: 1618: =cut 1619: 1620: ###################################################################### 1621: ###################################################################### 1622: sub create_results_table { 1623: my $table = &Apache::lonmysql::create_table 1624: ( { columns => \%Datatypes, 1625: column_order => \@DataOrder, 1626: fullindex => \@Fullindicies, 1627: } ); 1628: if (defined($table)) { 1629: $ENV{'form.table'} = $table; 1630: return $table; 1631: } 1632: return undef; # Error... 1633: } 1634: 1635: ###################################################################### 1636: ###################################################################### 1637: 1638: =pod 1639: 1640: =item Search Status update functions 1641: 1642: Each of the following functions changes the values of one of the 1643: input fields used to display the search status to the user. The names 1644: should be explanatory. 1645: 1646: Inputs: Apache request handler ($r), text to display. 1647: 1648: Returns: Nothing. 1649: 1650: =over 4 1651: 1652: =item &update_count_status() 1653: 1654: =item &update_status() 1655: 1656: =item &update_seconds() 1657: 1658: =back 1659: 1660: =cut 1661: 1662: ###################################################################### 1663: ###################################################################### 1664: sub update_count_status { 1665: my ($r,$text) = @_; 1666: $text =~ s/\'/\\\'/g; 1667: $r->print 1668: ("<script>document.statusform.count.value = ' $text'</script>\n"); 1669: $r->rflush(); 1670: } 1671: 1672: sub update_status { 1673: my ($r,$text) = @_; 1674: $text =~ s/\'/\\\'/g; 1675: $r->print 1676: ("<script>document.statusform.status.value = ' $text'</script>\n"); 1677: $r->rflush(); 1678: } 1679: 1680: sub update_seconds { 1681: my ($r,$text) = @_; 1682: $text =~ s/\'/\\\'/g; 1683: $r->print 1684: ("<script>document.statusform.seconds.value = ' $text'</script>\n"); 1685: $r->rflush(); 1686: } 1687: 1688: ###################################################################### 1689: ###################################################################### 1690: 1691: =pod 1692: 1693: =item &run_search 1694: 1695: =cut 1696: 1697: ###################################################################### 1698: ###################################################################### 1699: sub run_search { 1700: my ($r,$query,$customquery,$customshow,$serverlist,$pretty_string) = @_; 1701: my $connection = $r->connection; 1702: # 1703: # Timing variables 1704: # 1705: my $starttime = time; 1706: my $max_time = 120; # seconds for the search to complete 1707: # 1708: # Print run_search header 1709: # 1710: $r->print("<html><head><title>Search Status</title></head><body>"); 1711: $r->print("Search: ".$pretty_string."\n"); 1712: $r->rflush(); 1713: # 1714: # Determine the servers we need to contact. 1715: # 1716: my @Servers_to_contact; 1717: if (defined($serverlist)) { 1718: @Servers_to_contact = @$serverlist; 1719: } else { 1720: @Servers_to_contact = sort(keys(%Apache::lonnet::libserv)); 1721: } 1722: my %Server_status; 1723: my $table =$ENV{'form.table'}; 1724: if (! defined($table) || $table eq '' || $table =~ /\D/ ) { 1725: $r->print("Unable to determine table id to store search results in.". 1726: "The search has been aborted.</body></html>"); 1727: return; 1728: } 1729: my $table_status = &Apache::lonmysql::check_table($table); 1730: if (! defined($table_status)) { 1731: $r->print("Unable to determine status of table.</body></html>"); 1732: &Apache::lonnet::logthis("Bogus table id of $table for ". 1733: "$ENV{'user.name'} @ $ENV{'user.domain'}"); 1734: &Apache::lonnet::logthis("lonmysql error = ". 1735: &Apache::lonmysql::get_error()); 1736: return; 1737: } 1738: if (! $table_status) { 1739: $r->print("The table id,$table, we tried to use is invalid.". 1740: "The search has been aborted.</body></html>"); 1741: return; 1742: } 1743: ## 1744: ## Prepare for the big loop. 1745: ## 1746: my $hitcountsum; 1747: my $server; 1748: my $status; 1749: $r->print(<<END); 1750: <form name="statusform" action="" method="post"> 1751: <input type="hidden" name="Queue" value="" /> 1752: <table> 1753: <tr><th>Status</th><th>Total Matches</th><th>Time Remaining</th></tr> 1754: <tr> 1755: <td><input type="text" name="status" value="" size="30" /></td> 1756: <td><input type="text" name="count" value="" size="10" /></td> 1757: <td><input type="text" name="seconds" value="" size="8" /></td> 1758: </tr> 1759: </table> 1760: </form> 1761: END 1762: $r->rflush(); 1763: my $time_remaining = $max_time - (time - $starttime) ; 1764: my $last_time = $time_remaining; 1765: &update_seconds($r,$time_remaining); 1766: while (($time_remaining > 0) && 1767: ((@Servers_to_contact) || keys(%Server_status))) { 1768: # Send out a search request if it needs to be done. 1769: if (@Servers_to_contact) { 1770: # Contact one server 1771: my $server = shift(@Servers_to_contact); 1772: my $reply=&Apache::lonnet::metadata_query($query,$customquery, 1773: $customshow,[$server]); 1774: ($server) = keys(%$reply); 1775: $Server_status{$server} = $reply->{$server}; 1776: &update_status($r,'contacting '.$server); 1777: } else { 1778: # wait a sec. to give time for files to be written 1779: # This sleep statement is here instead of outside the else 1780: # block because we do not want to pause if we have servers 1781: # left to contact. 1782: sleep(1); 1783: } 1784: &update_status($r,'waiting on '.(join(' ',keys(%Server_status)))); 1785: while (my ($server,$status) = each(%Server_status)) { 1786: last if ($connection->aborted()); 1787: if ($status eq 'con_lost') { 1788: delete ($Server_status{$server}); 1789: next; 1790: } 1791: $status=~/^([\.\w]+)$/; 1792: my $datafile=$r->dir_config('lonDaemons').'/tmp/'.$1; 1793: if (-e $datafile && ! -e "$datafile.end") { 1794: &update_status($r,'Receiving results from '.$server); 1795: next; 1796: } 1797: last if ($connection->aborted()); 1798: if (-e "$datafile.end") { 1799: &update_status($r,'Reading results from '.$server); 1800: if (-z "$datafile") { 1801: delete($Server_status{$server}); 1802: next; 1803: } 1804: my $fh; 1805: if (!($fh=Apache::File->new($datafile))) { 1806: $r->print("Unable to open search results file for ". 1807: "server $server. Omitting from search"); 1808: delete($Server_status{$server}); 1809: next; 1810: } 1811: # Read in the whole file. 1812: while (my $result = <$fh>) { 1813: last if ($connection->aborted()); 1814: # handle custom fields? Someday we will! 1815: chomp($result); 1816: next unless $result; 1817: # Parse the result. 1818: my %Fields = &parse_raw_result($result,$server); 1819: $Fields{'hostname'} = $server; 1820: next if (! &copyright_check(\%Fields)); 1821: # Store the result in the mysql database 1822: my $result = &Apache::lonmysql::store_row($table,\%Fields); 1823: if (! defined($result)) { 1824: $r->print(&Apache::lonmysql::get_error()); 1825: } 1826: # $r->print(&Apache::lonmysql::get_debug()); 1827: $hitcountsum ++; 1828: $time_remaining = $max_time - (time - $starttime) ; 1829: if ($last_time - $time_remaining > 0) { 1830: &update_seconds($r,$time_remaining); 1831: $last_time = $time_remaining; 1832: } 1833: if ($hitcountsum % 50 == 0) { 1834: &update_count_status($r,$hitcountsum); 1835: } 1836: } # End of foreach (@results) 1837: $fh->close(); 1838: # $server is only deleted if the results file has been 1839: # found and (successfully) opened. This may be a bad idea. 1840: delete($Server_status{$server}); 1841: } 1842: last if ($connection->aborted()); 1843: &update_count_status($r,$hitcountsum); 1844: } 1845: last if ($connection->aborted()); 1846: # Finished looping through the servers 1847: $time_remaining = $max_time - (time - $starttime) ; 1848: if ($last_time - $time_remaining > 0) { 1849: $last_time = $time_remaining; 1850: &update_seconds($r,$time_remaining); 1851: } 1852: } 1853: &update_status($r,'Search Complete'.$server); 1854: &Apache::lonmysql::disconnect_from_db(); 1855: # Let the user know 1856: # 1857: # We have run out of time or run out of servers to talk to and 1858: # results to get. 1859: $r->print("<b>Search Completed.</b>  "); 1860: if ($hitcountsum) { 1861: $r->print($hitcountsum." matches were found."); 1862: } else { 1863: $r->print("There were no successful matches to your query."); 1864: } 1865: $r->print("</body></html>"); 1866: return; 1867: } 1868: 1869: ###################################################################### 1870: ###################################################################### 1871: =pod 1872: 1873: =item &prev_next_buttons 1874: 1875: =cut 1876: 1877: ###################################################################### 1878: ###################################################################### 1879: sub prev_next_buttons { 1880: my ($current_min,$show,$total,$parms) = @_; 1881: return '' if ($show eq 'all'); # No links if you get them all at once. 1882: my $links; 1883: ## 1884: ## Prev 1885: my $prev_min = $current_min - $show; 1886: $prev_min = 0 if $prev_min < 0; 1887: if ($prev_min < $current_min) { 1888: $links .= qq{ 1889: <a href="/adm/searchcat?$parms&start=$prev_min&show=$show">prev</a> 1890: }; 1891: } else { 1892: $links .= 'prev'; 1893: } 1894: ## 1895: ## Pages.... Someday. 1896: ## 1897: $links .= qq{   1898: <a href="/adm/searchcat?$parms&start=$current_min&$show=$show">reload</a> 1899: }; 1900: ## 1901: ## Next 1902: my $next_min = $current_min + $show; 1903: $next_min = $current_min if ($next_min > $total); 1904: if ($next_min != $current_min) { 1905: $links .= qq{   1906: <a href="/adm/searchcat?$parms&start=$next_min&show=$show">next</a> 1907: }; 1908: } else { 1909: $links .= ' next'; 1910: } 1911: return $links; 1912: } 1913: ###################################################################### 1914: ###################################################################### 1915: 1916: =pod 1917: 1918: =item &display_results 1919: 1920: =cut 1921: 1922: ###################################################################### 1923: ###################################################################### 1924: sub display_results { 1925: my ($r,$importbutton,$closebutton) = @_; 1926: my $connection = $r->connection; 1927: $r->print(&search_results_header($importbutton,$closebutton)); 1928: ## 1929: ## Set viewing function 1930: ## 1931: my $viewfunction = $Views{$ENV{'form.viewselect'}}; 1932: if (!defined($viewfunction)) { 1933: $r->print("Internal Error - Bad view selected.\n"); 1934: $r->rflush(); 1935: return; 1936: } 1937: ## 1938: ## Get the catalog controls setup 1939: ## 1940: my $action = "/adm/searchcat?phase=results"; 1941: ## 1942: ## Deal with groupsearch 1943: ## 1944: if ($ENV{'form.catalogmode'} eq 'groupsearch') { 1945: if (! tie(%groupsearch_db,'GDBM_File',$diropendb, 1946: &GDBM_WRCREAT(),0640)) { 1947: $r->print('Unable to store import results.</form></body></html>'); 1948: $r->rflush(); 1949: return; 1950: } 1951: } 1952: ## 1953: ## Prepare the table for querying 1954: ## 1955: my $table = $ENV{'form.table'}; 1956: my $connection_result = &Apache::lonmysql::connect_to_db(); 1957: if (!defined($connection_result)) { 1958: $r->print(&Apache::lonmysql::get_error()); 1959: } 1960: my $table_check = &Apache::lonmysql::check_table($table); 1961: if (! defined($table_check)) { 1962: $r->print("A MySQL error has occurred.</form></body></html>"); 1963: &Apache::lonnet::logthis("lonmysql was unable to determine the status". 1964: " of table ".$table); 1965: return; 1966: } elsif (! $table_check) { 1967: $r->print("The table of results could not be found."); 1968: &Apache::lonnet::logthis("The user requested a table, ".$table. 1969: ", that could not be found."); 1970: return; 1971: } 1972: ## 1973: ## Get the number of results 1974: ## 1975: my $total_results = &Apache::lonmysql::number_of_rows($table); 1976: if (! defined($total_results)) { 1977: $r->print("A MySQL error has occurred.</form></body></html>"); 1978: &Apache::lonnet::logthis("lonmysql was unable to determine the number". 1979: " of rows in table ".$table); 1980: &Apache::lonnet::logthis(&Apache::lonmysql::get_error()); 1981: &Apache::lonnet::logthis(&Apache::lonmysql::get_debug()); 1982: return; 1983: } 1984: ## 1985: ## Determine how many results we need to get 1986: ## 1987: $ENV{'form.show'} = 20; 1988: $ENV{'form.start'} = 0 if (! exists($ENV{'form.start'})); 1989: $ENV{'form.show'} = 'all' if (! exists($ENV{'form.show'})); 1990: my $min = $ENV{'form.start'}; 1991: my $max; 1992: if ($ENV{'form.show'} eq 'all') { 1993: $max = $total_results ; 1994: } else { 1995: $max = $min + $ENV{'form.show'}; 1996: $max = $total_results if ($max > $total_results); 1997: } 1998: ## 1999: ## Output links (if necessary) for 'prev' and 'next' pages. 2000: ## 2001: $r->print 2002: ('<center>'. 2003: &prev_next_buttons($min,$ENV{'form.show'},$total_results, 2004: "table=".$ENV{'form.table'}. 2005: "&phase=results". 2006: "&persistent_db_id=".$ENV{'form.persistent_db_id'}) 2007: ."</center>\n" 2008: ); 2009: if ($total_results == 0) { 2010: $r->print("There are currently no results.\n". 2011: "</form></body></html>"); 2012: return; 2013: } else { 2014: $r->print 2015: ("<center>Results $min to $max out of $total_results</center>\n"); 2016: } 2017: ## 2018: ## Get results from MySQL table 2019: ## 2020: my @Results = &Apache::lonmysql::get_rows($table, 2021: 'id>'.$min.' AND id<='.$max); 2022: ## 2023: ## Loop through the results and output them. 2024: ## 2025: foreach my $row (@Results) { 2026: if ($connection->aborted()) { 2027: untie %groupsearch_db if (tied(%groupsearch_db)); 2028: &Apache::lonmysql::disconnect_from_db(); 2029: return; 2030: } 2031: my %Fields = %{&parse_row(@$row)}; 2032: my $output="<p>\n"; 2033: my $prefix=&catalogmode_output($Fields{'title'},$Fields{'url'}); 2034: # Render the result into html 2035: $output.= &$viewfunction($prefix,%Fields); 2036: # Print them out as they come in. 2037: $r->print($output); 2038: $r->rflush(); 2039: } 2040: if (@Results < 1) { 2041: $r->print("There were no results matching your query"); 2042: } else { 2043: $r->print 2044: ('<center>'. 2045: &prev_next_buttons($min,$ENV{'form.show'},$total_results, 2046: "table=".$ENV{'form.table'}. 2047: "&phase=results". 2048: "&persistent_db_id=". 2049: $ENV{'form.persistent_db_id'}) 2050: ."</center>\n" 2051: ); 2052: } 2053: $r->print("</form></body></html>"); 2054: $r->rflush(); 2055: untie %groupsearch_db if (tied(%groupsearch_db)); 2056: return; 2057: } 2058: 2059: ###################################################################### 2060: ###################################################################### 2061: 2062: =pod 2063: 2064: =item &catalogmode_output($title,$url) 2065: 2066: Returns html needed for the various catalog modes. Gets inputs from 2067: $ENV{'form.catalogmode'}. Stores data in %groupsearch_db and $fnum 2068: (local variable). 2069: 2070: =cut 2071: 2072: ###################################################################### 2073: ###################################################################### 2074: { 2075: my $fnum = 0; 2076: 2077: sub catalogmode_output { 2078: my $output = ''; 2079: my ($title,$url) = @_; 2080: if ($ENV{'form.catalogmode'} eq 'interactive') { 2081: $title=~ s/\'/\\\'/g; 2082: if ($ENV{'form.catalogmode'} eq 'interactive') { 2083: $output.=<<END 2084: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT" 2085: onClick="javascript:select_data('$title','$url')"> 2086: </font> 2087: END 2088: } 2089: } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') { 2090: $groupsearch_db{"pre_${fnum}_link"}=$url; 2091: $groupsearch_db{"pre_${fnum}_title"}=$title; 2092: $output.=<<END; 2093: <font size='-1'> 2094: <input type="checkbox" name="returnvalues" value="SELECT" 2095: onClick="javascript:queue($fnum)" /> 2096: </font> 2097: END 2098: $fnum++; 2099: } 2100: return $output; 2101: } 2102: 2103: } 2104: ###################################################################### 2105: ###################################################################### 2106: 2107: =pod 2108: 2109: =item &parse_row 2110: 2111: Parse a row returned from the database. 2112: 2113: =cut 2114: 2115: ###################################################################### 2116: ###################################################################### 2117: sub parse_row { 2118: my @Row = @_; 2119: my %Fields; 2120: for (my $i=0;$i<=$#Row;$i++) { 2121: $Fields{$DataOrder[$i]}=&Apache::lonnet::unescape($Row[$i]); 2122: } 2123: $Fields{'language'} = 2124: &Apache::loncommon::languagedescription($Fields{'lang'}); 2125: $Fields{'copyrighttag'} = 2126: &Apache::loncommon::copyrightdescription($Fields{'copyright'}); 2127: $Fields{'mimetag'} = 2128: &Apache::loncommon::filedescription($Fields{'mime'}); 2129: return \%Fields; 2130: } 2131: 2132: ########################################################### 2133: ########################################################### 2134: 2135: =pod 2136: 2137: =item &parse_raw_result() 2138: 2139: Takes a line from the file of results and parse it. Returns a hash 2140: with keys for the following fields: 2141: 'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes', 2142: 'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate', 2143: 'lastrevisiondate'. 2144: 2145: In addition, the following tags are set by calling the appropriate 2146: lonnet function: 'language', 'cprtag', 'mimetag'. 2147: 2148: The 'title' field is set to "Untitled" if the title field is blank. 2149: 2150: 'abstract' and 'keywords' are truncated to 200 characters. 2151: 2152: =cut 2153: 2154: ########################################################### 2155: ########################################################### 2156: sub parse_raw_result { 2157: my ($result,$hostname) = @_; 2158: # Check for a comma - if it is there then we do not need to unescape the 2159: # string. There seems to be some kind of problem with some items in 2160: # the database - the entire string gets sent out unescaped...? 2161: unless ($result =~ /,/) { 2162: $result = &Apache::lonnet::unescape($result); 2163: } 2164: my @fields=map { 2165: &Apache::lonnet::unescape($_); 2166: } (split(/\,/,$result)); 2167: my ($title,$author,$subject,$url,$keywords,$version, 2168: $notes,$abstract,$mime,$lang, 2169: $creationdate,$lastrevisiondate,$owner,$copyright)=@fields; 2170: my %Fields = 2171: ( title => &Apache::lonnet::unescape($title), 2172: author => &Apache::lonnet::unescape($author), 2173: subject => &Apache::lonnet::unescape($subject), 2174: url => &Apache::lonnet::unescape($url), 2175: keywords => &Apache::lonnet::unescape($keywords), 2176: version => &Apache::lonnet::unescape($version), 2177: notes => &Apache::lonnet::unescape($notes), 2178: abstract => &Apache::lonnet::unescape($abstract), 2179: mime => &Apache::lonnet::unescape($mime), 2180: lang => &Apache::lonnet::unescape($lang), 2181: owner => &Apache::lonnet::unescape($owner), 2182: copyright => &Apache::lonnet::unescape($copyright), 2183: creationdate => &Apache::lonnet::unescape($creationdate), 2184: lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate) 2185: ); 2186: $Fields{'language'} = 2187: &Apache::loncommon::languagedescription($Fields{'lang'}); 2188: $Fields{'copyrighttag'} = 2189: &Apache::loncommon::copyrightdescription($Fields{'copyright'}); 2190: $Fields{'mimetag'} = 2191: &Apache::loncommon::filedescription($Fields{'mime'}); 2192: if ($Fields{'author'}=~/^(\s*|error)$/) { 2193: $Fields{'author'}="Unknown Author"; 2194: } 2195: # Put spaces in the keyword list, if needed. 2196: $Fields{'keywords'}=~ s/,([A-z])/, $1/g; 2197: if ($Fields{'title'}=~ /^\s*$/ ) { 2198: $Fields{'title'}='Untitled'; 2199: } 2200: unless ($ENV{'user.adv'}) { 2201: # What is this anyway? 2202: $Fields{'keywords'} = '- not displayed -'; 2203: $Fields{'notes'} = '- not displayed -'; 2204: $Fields{'abstract'} = '- not displayed -'; 2205: $Fields{'subject'} = '- not displayed -'; 2206: } 2207: if (length($Fields{'abstract'})>200) { 2208: $Fields{'abstract'} = 2209: substr($Fields{'abstract'},0,200).'...'; 2210: } 2211: if (length($Fields{'keywords'})>200) { 2212: $Fields{'keywords'} = 2213: substr($Fields{'keywords'},0,200).'...'; 2214: } 2215: return %Fields; 2216: } 2217: 2218: ########################################################### 2219: ########################################################### 2220: 2221: =pod 2222: 2223: =item &handle_custom_fields() 2224: 2225: =cut 2226: 2227: ########################################################### 2228: ########################################################### 2229: sub handle_custom_fields { 2230: my @results = @{shift()}; 2231: my $customshow=''; 2232: my $extrashow=''; 2233: my @customfields; 2234: if ($ENV{'form.customshow'}) { 2235: $customshow=$ENV{'form.customshow'}; 2236: $customshow=~s/[^\w\s]//g; 2237: my @fields=map { 2238: "<font color=\"#008000\">$_:</font>"; 2239: } split(/\s+/,$customshow); 2240: @customfields=split(/\s+/,$customshow); 2241: if ($customshow) { 2242: $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n"; 2243: } 2244: } 2245: my $customdata=''; 2246: my %customhash; 2247: foreach my $result (@results) { 2248: if ($result=~/^(custom\=.*)$/) { # grab all custom metadata 2249: my $tmp=$result; 2250: $tmp=~s/^custom\=//; 2251: my ($k,$v)=map {&Apache::lonnet::unescape($_); 2252: } split(/\,/,$tmp); 2253: $customhash{$k}=$v; 2254: } 2255: } 2256: return ($extrashow,\@customfields,\%customhash); 2257: } 2258: 2259: ###################################################################### 2260: ###################################################################### 2261: 2262: =pod 2263: 2264: =item &search_results_header 2265: 2266: Output the proper html headers and javascript code to deal with different 2267: calling modes. 2268: 2269: Takes most inputs directly from %ENV, except $mode. 2270: 2271: =over 4 2272: 2273: =item $mode is either (at this writing) 'Basic' or 'Advanced' 2274: 2275: =back 2276: 2277: The following environment variables are checked: 2278: 2279: =over 4 2280: 2281: =item 'form.catalogmode' 2282: 2283: Checked for 'interactive' and 'groupsearch'. 2284: 2285: =item 'form.mode' 2286: 2287: Checked for existance & 'edit' mode. 2288: 2289: =item 'form.form' 2290: 2291: =item 'form.element' 2292: 2293: =back 2294: 2295: =cut 2296: 2297: ###################################################################### 2298: ###################################################################### 2299: sub search_results_header { 2300: my ($importbutton,$closebutton) = @_; 2301: my $result = ''; 2302: # output beginning of search page 2303: # conditional output of script functions dependent on the mode in 2304: # which the search was invoked 2305: if ($ENV{'form.catalogmode'} eq 'interactive'){ 2306: if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') { 2307: $result.=<<SCRIPT; 2308: <script type="text/javascript"> 2309: function select_data(title,url) { 2310: changeTitle(title); 2311: changeURL(url); 2312: parent.close(); 2313: } 2314: function changeTitle(val) { 2315: if (opener.inf.document.forms.resinfo.elements.t) { 2316: opener.inf.document.forms.resinfo.elements.t.value=val; 2317: } 2318: } 2319: function changeURL(val) { 2320: if (opener.inf.document.forms.resinfo.elements.u) { 2321: opener.inf.document.forms.resinfo.elements.u.value=val; 2322: } 2323: } 2324: </script> 2325: SCRIPT 2326: } elsif ($ENV{'form.mode'} eq 'edit') { 2327: my $form = $ENV{'form.form'}; 2328: my $element = $ENV{'form.element'}; 2329: $result.=<<SCRIPT; 2330: <script type="text/javascript"> 2331: function select_data(title,url) { 2332: changeURL(url); 2333: parent.close(); 2334: } 2335: function changeTitle(val) { 2336: } 2337: function changeURL(val) { 2338: if (parent.targetwin.document) { 2339: parent.targetwin.document.forms["$form"].elements["$element"].value=val; 2340: } else { 2341: var url = 'forms[\"$form\"].elements[\"$element\"].value'; 2342: alert("Unable to transfer data to "+url); 2343: } 2344: } 2345: </script> 2346: SCRIPT 2347: } 2348: } 2349: $result.=<<SCRIPT if $ENV{'form.catalogmode'} eq 'groupsearch'; 2350: <script type="text/javascript"> 2351: function queue(val) { 2352: if (document.forms.results.returnvalues[val].checked) { 2353: parent.statusframe.document.forms.statusform.elements.Queue.value +='1a'+val+'b'; 2354: } else { 2355: parent.statusframe.document.forms.statusform.elements.Queue.value +='0a'+val+'b'; 2356: } 2357: } 2358: function select_group() { 2359: parent.window.location= 2360: "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+ 2361: parent.statusframe.document.forms.statusform.elements.Queue.value; 2362: } 2363: </script> 2364: SCRIPT 2365: $result.=<<END; 2366: </head> 2367: <form name="results" method="post" action="" > 2368: <input type="hidden" name="Queue" value="" /> 2369: $importbutton 2370: END 2371: return $result; 2372: } 2373: 2374: ###################################################################### 2375: ###################################################################### 2376: sub search_status_header { 2377: return <<ENDSTATUS; 2378: <html><head><title>Search Status</title></head> 2379: <body> 2380: <h3>Search Status</h3> 2381: Sending search request to LON-CAPA servers.<br /> 2382: ENDSTATUS 2383: } 2384: 2385: sub results_link { 2386: my $basic_link = "/adm/searchcat?"."&table=".$ENV{'form.table'}. 2387: "&persistent_db_id=".$ENV{'form.persistent_db_id'}; 2388: my $results_link = $basic_link."&phase=results". 2389: "&pause=10"."&start=0"."&show=20"; 2390: return $results_link; 2391: } 2392: 2393: ###################################################################### 2394: ###################################################################### 2395: sub print_frames_interface { 2396: my $r = shift; 2397: my $basic_link = "/adm/searchcat?"."&table=".$ENV{'form.table'}. 2398: "&persistent_db_id=".$ENV{'form.persistent_db_id'}; 2399: my $run_search_link = $basic_link."&phase=run_search"; 2400: my $results_link = &results_link(); 2401: my $result = <<"ENDFRAMES"; 2402: <html> 2403: <head> 2404: <script> 2405: var targetwin = opener; 2406: </script> 2407: <title>LON-CAPA Digital Library Search Results</title> 2408: </head> 2409: <frameset rows="150,*"> 2410: <frame name="statusframe" src="$run_search_link"> 2411: <frame name="resultsframe" src="$results_link"> 2412: </frameset> 2413: </html> 2414: ENDFRAMES 2415: 2416: $r->print($result); 2417: return; 2418: } 2419: 2420: ###################################################################### 2421: ###################################################################### 2422: 2423: =pod 2424: 2425: =item Metadata Viewing Functions 2426: 2427: Output is a HTML-ified string. 2428: Input arguments are title, author, subject, url, keywords, version, 2429: notes, short abstract, mime, language, creation date, 2430: last revision date, owner, copyright, hostname, and 2431: extra custom metadata to show. 2432: 2433: =over 4 2434: 2435: =item &detailed_citation_view() 2436: 2437: =cut 2438: 2439: ###################################################################### 2440: ###################################################################### 2441: sub detailed_citation_view { 2442: my ($prefix,%values) = @_; 2443: my $result=<<END; 2444: <b>$prefix<a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 2445: target='search_preview'>$values{'title'}</a></b> 2446: <p> 2447: <b>$values{'author'}</b>, <i>$values{'owner'}</i><br /> 2448: 2449: <b>Subject: </b> $values{'subject'}<br /> 2450: <b>Keyword(s): </b> $values{'keywords'}<br /> 2451: <b>Notes: </b> $values{'notes'}<br /> 2452: <b>MIME Type: </b> $values{'mimetag'}<br /> 2453: <b>Language: </b> $values{'language'}<br /> 2454: <b>Copyright/Distribution:</b> $values{'cprtag'}<br /> 2455: </p> 2456: $values{'extrashow'} 2457: <p> 2458: $values{'shortabstract'} 2459: </p> 2460: <hr align='left' width='200' noshade /> 2461: END 2462: return $result; 2463: } 2464: 2465: ###################################################################### 2466: ###################################################################### 2467: 2468: =pod 2469: 2470: =item &summary_view() 2471: 2472: =cut 2473: ###################################################################### 2474: ###################################################################### 2475: sub summary_view { 2476: my ($prefix,%values) = @_; 2477: my $result=<<END; 2478: $prefix<a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 2479: target='search_preview'>$values{'author'}</a><br /> 2480: $values{'title'}<br /> 2481: $values{'owner'} -- $values{'lastrevisiondate'}<br /> 2482: $values{'copyrighttag'}<br /> 2483: $values{'extrashow'} 2484: </p> 2485: <hr align='left' width='200' noshade /> 2486: END 2487: return $result; 2488: } 2489: 2490: ###################################################################### 2491: ###################################################################### 2492: 2493: =pod 2494: 2495: =item &compact_view() 2496: 2497: =cut 2498: 2499: ###################################################################### 2500: ###################################################################### 2501: sub compact_view { 2502: my ($prefix,%values) = @_; 2503: my $result=<<END; 2504: $prefix <a href="http://$ENV{'HTTP_HOST'}$values{'url'}" target='search_preview'> 2505: $values{'title'}</a> 2506: <b>$values{'author'}</b><br /> 2507: END 2508: return $result; 2509: } 2510: 2511: 2512: ###################################################################### 2513: ###################################################################### 2514: 2515: =pod 2516: 2517: =item &fielded_format_view() 2518: 2519: =cut 2520: 2521: ###################################################################### 2522: ###################################################################### 2523: sub fielded_format_view { 2524: my ($prefix,%values) = @_; 2525: my $result=<<END; 2526: $prefix 2527: <b>URL: </b> <a href="http://$ENV{'HTTP_HOST'}$values{'url'}" 2528: target='search_preview'>$values{'url'}</a> 2529: <br /> 2530: <b>Title:</b> $values{'title'}<br /> 2531: <b>Author(s):</b> $values{'author'}<br /> 2532: <b>Subject:</b> $values{'subject'}<br /> 2533: <b>Keyword(s):</b> $values{'keywords'}<br /> 2534: <b>Notes:</b> $values{'notes'}<br /> 2535: <b>MIME Type:</b> $values{'mimetag'}<br /> 2536: <b>Language:</b> $values{'language'}<br /> 2537: <b>Creation Date:</b> $values{'creationdate'}<br /> 2538: <b>Last Revision Date:</b> $values{'lastrevisiondate'}<br /> 2539: <b>Publisher/Owner:</b> $values{'owner'}<br /> 2540: <b>Copyright/Distribution:</b> $values{'copyrighttag'}<br /> 2541: <b>Repository Location:</b> $values{'hostname'}<br /> 2542: <b>Abstract:</b> $values{'shortabstract'}<br /> 2543: $values{'extrashow'} 2544: </p> 2545: <hr align='left' width='200' noshade /> 2546: END 2547: return $result; 2548: } 2549: 2550: ###################################################################### 2551: ###################################################################### 2552: 2553: =pod 2554: 2555: =item &xml_sgml_view() 2556: 2557: =back 2558: 2559: =cut 2560: 2561: ###################################################################### 2562: ###################################################################### 2563: sub xml_sgml_view { 2564: my ($prefix,%values) = @_; 2565: my $result=<<END; 2566: $prefix 2567: <pre> 2568: <LonCapaResource> 2569: <url>$values{'url'}</url> 2570: <title>$values{'title'}</title> 2571: <author>$values{'author'}</author> 2572: <subject>$values{'subject'}</subject> 2573: <keywords>$values{'keywords'}</keywords> 2574: <notes>$values{'notes'}</notes> 2575: <mimeInfo> 2576: <mime>$values{'mime'}</mime> 2577: <mimetag>$values{'mimetag'}</mimetag> 2578: </mimeInfo> 2579: <languageInfo> 2580: <language>$values{'lang'}</language> 2581: <languagetag>$values{'language'}</languagetag> 2582: </languageInfo> 2583: <creationdate>$values{'creationdate'}</creationdate> 2584: <lastrevisiondate>$values{'lastrevisiondate'}</lastrevisiondate> 2585: <owner>$values{'owner'}</owner> 2586: <copyrightInfo> 2587: <copyright>$values{'copyright'}</copyright> 2588: <copyrighttag>$values{'copyrighttag'}</copyrighttag> 2589: </copyrightInfo> 2590: <repositoryLocation>$values{'hostname'}</repositoryLocation> 2591: <shortabstract>$values{'shortabstract'}</shortabstract> 2592: </LonCapaResource> 2593: </pre> 2594: $values{'extrashow'} 2595: <hr align='left' width='200' noshade /> 2596: END 2597: return $result; 2598: } 2599: 2600: ###################################################################### 2601: ###################################################################### 2602: 2603: =pod 2604: 2605: =item &filled() see if field is filled. 2606: 2607: =cut 2608: 2609: ###################################################################### 2610: ###################################################################### 2611: sub filled { 2612: my ($field)=@_; 2613: if ($field=~/\S/ && $field ne 'any') { 2614: return 1; 2615: } 2616: else { 2617: return 0; 2618: } 2619: } 2620: 2621: ###################################################################### 2622: ###################################################################### 2623: 2624: =pod 2625: 2626: =item &output_blank_field_error() 2627: 2628: =cut 2629: 2630: ###################################################################### 2631: ###################################################################### 2632: sub output_blank_field_error { 2633: my ($r,$closebutton)=@_; 2634: # make query information persistent to allow for subsequent revision 2635: $r->print(<<BEGINNING); 2636: <html> 2637: <head> 2638: <title>The LearningOnline Network with CAPA</title> 2639: BEGINNING 2640: $r->print(<<RESULTS); 2641: </head> 2642: <body bgcolor="#ffffff"> 2643: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 2644: <h1>Search Catalog</h1> 2645: <form method="post" action="/adm/searchcat"> 2646: $hidden_fields 2647: <a href="/adm/searchcat?persistent_db_id=$ENV{'form.persistent_db_id'}" 2648: >Revise search request</a>  2649: $closebutton 2650: <hr /> 2651: <h3>Helpful Message</h3> 2652: <p> 2653: Incorrect search query due to blank entry fields. 2654: You need to fill in the relevant 2655: fields on the search page in order for a query to be 2656: processed. 2657: </p> 2658: </body> 2659: </html> 2660: RESULTS 2661: } 2662: 2663: ###################################################################### 2664: ###################################################################### 2665: 2666: =pod 2667: 2668: =item &output_date_error() 2669: 2670: Output a full html page with an error message. 2671: 2672: Inputs: 2673: 2674: $r, the request pointer. 2675: $message, the error message for the user. 2676: $closebutton, the specialized close button needed for groupsearch. 2677: 2678: =cut 2679: 2680: ###################################################################### 2681: ###################################################################### 2682: sub output_date_error { 2683: my ($r,$message,$closebutton)=@_; 2684: # make query information persistent to allow for subsequent revision 2685: $r->print(<<RESULTS); 2686: <html> 2687: <head> 2688: <title>The LearningOnline Network with CAPA</title> 2689: </head> 2690: <body bgcolor="#ffffff"> 2691: <img align='right' src='/adm/lonIcons/lonlogos.gif' /> 2692: <h1>Search Catalog</h1> 2693: <form method="post" action="/adm/searchcat"> 2694: $hidden_fields 2695: <input type='button' value='Revise search request' 2696: onClick='this.form.submit();' /> 2697: $closebutton 2698: <hr /> 2699: <h3>Helpful Message</h3> 2700: <p> 2701: $message 2702: </p> 2703: </body> 2704: </html> 2705: RESULTS 2706: } 2707: 2708: ###################################################################### 2709: ###################################################################### 2710: 2711: =pod 2712: 2713: =item &start_fresh_session() 2714: 2715: Cleans the global %groupsearch_db by removing all fields which begin with 2716: 'pre_' or 'store'. 2717: 2718: =cut 2719: 2720: ###################################################################### 2721: ###################################################################### 2722: sub start_fresh_session { 2723: delete $groupsearch_db{'mode_catalog'}; 2724: foreach (keys %groupsearch_db) { 2725: if ($_ =~ /^pre_/) { 2726: delete $groupsearch_db{$_}; 2727: } 2728: if ($_ =~ /^store/) { 2729: delete $groupsearch_db{$_}; 2730: } 2731: } 2732: } 2733: 2734: 1; 2735: 2736: __END__ 2737: 2738: =pod 2739: 2740: =back 2741: 2742: =cut