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