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