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