loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.146: download - view: text, annotated - select for diffs
Mon Jul 29 21:53:57 2002 UTC (21 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

This code should NOT be considered stable.
However, it seems to work occasionally.
Frames are now used to contact two httpd daemons.  Results are shown in
pages of 20.
&handler was mostly rewritten.  Hopefully the logic is clearer.
Some function names were changed to reflect that they now output html
directly via $r.
Data persistence is a problem.  Rewrites were done of the previous 'persistent'
functions.  Two new functions were added as well.  This still needs work.
&create_results_table is a new function to create the mysql tables.
&write_status is depricated and will be removed once major debugging stops.
Many changes.  Much wailing and gnashing of teeth.

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