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