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