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