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