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