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