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