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