Annotation of loncom/interface/lonsearchcat.pm, revision 1.145
1.98 harris41 1: # The LearningOnline Network with CAPA
1.108 harris41 2: # Search Catalog
3: #
1.145 ! matthew 4: # $Id: lonsearchcat.pm,v 1.144 2002/07/26 16:37:58 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.121 matthew 34: # 6/17 Matthew Hall
1.104 harris41 35: #
1.121 matthew 36: ###############################################################################
37: ###############################################################################
38:
39: =pod
40:
41: =head1 NAME
42:
1.140 matthew 43: lonsearchcat - LONCAPA Search Interface
1.121 matthew 44:
45: =head1 SYNOPSIS
46:
47: Search interface to LON-CAPAs digital library
48:
49: =head1 DESCRIPTION
50:
51: This module enables searching for a distributed browseable catalog.
1.104 harris41 52:
1.121 matthew 53: This is part of the LearningOnline Network with CAPA project
54: described at http://www.lon-capa.org.
55:
56: lonsearchcat presents the user with an interface to search the LON-CAPA
57: digital library. lonsearchcat also initiates the execution of a search
58: by sending the search parameters to LON-CAPA servers. The progress of
59: search (on a server basis) is displayed to the user in a seperate window.
60:
61: =head1 Internals
62:
63: =over 4
64:
65: =cut
66:
67: ###############################################################################
1.98 harris41 68: ###############################################################################
1.121 matthew 69:
1.128 harris41 70: ###############################################################################
1.98 harris41 71: ## ##
72: ## ORGANIZATION OF THIS PERL MODULE ##
73: ## ##
1.105 harris41 74: ## 1. Modules used by this module ##
1.128 harris41 75: ## 2. Variables used throughout the module ##
76: ## 3. handler subroutine called via Apache and mod_perl ##
77: ## 4. Other subroutines ##
1.98 harris41 78: ## ##
79: ###############################################################################
80:
1.1 www 81: package Apache::lonsearchcat;
82:
1.98 harris41 83: # ------------------------------------------------- modules used by this module
1.1 www 84: use strict;
85: use Apache::Constants qw(:common);
1.6 harris41 86: use Apache::lonnet();
87: use Apache::File();
1.7 harris41 88: use CGI qw(:standard);
1.41 harris41 89: use Text::Query;
1.144 matthew 90: use DBI;
1.101 harris41 91: use GDBM_File;
1.112 harris41 92: use Apache::loncommon();
1.144 matthew 93: use Apache::lonmysql();
1.1 www 94:
1.90 harris41 95: # ---------------------------------------- variables used throughout the module
96:
1.121 matthew 97: ######################################################################
98: ######################################################################
99:
100: =pod
101:
102: =item Global variables
103:
104: =over 4
105:
106: =item $importbutton
107:
1.134 matthew 108: button to take the select results and go to group sorting
1.121 matthew 109:
1.142 matthew 110: =item %groupsearch_db
1.121 matthew 111:
1.142 matthew 112: Database hash used to save values for the groupsearch RAT interface.
1.121 matthew 113:
114: =item $diropendb
115:
116: The full path to the (temporary) search database file. This is set and
117: used in &handler() and is also used in &output_results().
118:
1.139 matthew 119: =item %Views
120:
121: Hash which associates an output view description with the function
122: that produces it. Adding a new view type should be as easy as
123: adding a line to the definition of this hash and making sure the function
124: takes the proper parameters.
125:
1.121 matthew 126: =back
127:
128: =cut
129:
130: ######################################################################
131: ######################################################################
132:
1.98 harris41 133: # -- dynamically rendered interface components
134: my $importbutton; # button to take the selected results and go to group sorting
135:
136: # -- miscellaneous variables
1.142 matthew 137: my %groupsearch_db; # database hash
1.127 matthew 138: my $diropendb = ""; # db file
1.139 matthew 139: # View Description Function Pointer
140: my %Views = ("Detailed Citation View" => \&detailed_citation_view,
141: "Summary View" => \&summary_view,
142: "Fielded Format" => \&fielded_format_view,
143: "XML/SGML" => \&xml_sgml_view );
1.145 ! matthew 144: my $persistent_db_file;
! 145: my %persistent_db;
! 146: my $hidden_fields;
1.121 matthew 147: ######################################################################
148: ######################################################################
149:
150: =pod
151:
152: =item &handler() - main handler invoked by httpd child
153:
1.124 matthew 154: =item Variables
155:
156: =over 4
157:
158: =item $hidden
159:
160: holds 'hidden' html forms
161:
162: =item $scrout
163:
164: string that holds portions of the screen output
165:
166: =back
167:
1.121 matthew 168: =cut
1.101 harris41 169:
1.121 matthew 170: ######################################################################
171: ######################################################################
1.98 harris41 172: sub handler {
173: my $r = shift;
1.145 ! matthew 174: #
! 175: untie %groupsearch_db if (tied(%groupsearch_db));
! 176: #
! 177: my $closebutton; # button that closes the search window
! 178: # This button is different for the RAT compared to
! 179: # normal invocation.
! 180: #
1.98 harris41 181: $r->content_type('text/html');
182: $r->send_http_header;
183: return OK if $r->header_only;
1.145 ! matthew 184: ##
! 185: ## Pick up form fields passed in the links.
! 186: ##
! 187: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
! 188: ['catalogmode','launch','acts','mode','form','element',
! 189: 'reqinterface','persistent_db_id','table']);
1.143 matthew 190: ##
191: ## Initialize global variables
192: ##
1.121 matthew 193: my $domain = $r->dir_config('lonDefDomain');
1.122 matthew 194: $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain).
195: "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db";
1.145 ! matthew 196: #
! 197: # set the name of the persistent database
! 198: # $ENV{'form.persistent_db_id'} can only have digits in it.
! 199: if (! exists($ENV{'form.persistent_db_id'}) ||
! 200: $ENV{'form.persistent_db_id'} =~ /\D/ ) {
! 201: $ENV{'form.persistent_db_id'} = time;
! 202: }
! 203: $persistent_db_file = "/home/httpd/perl/tmp/".
! 204: &Apache::lonnet::escape($domain).
! 205: '_'.&Apache::lonnet::escape($ENV{'user.name'}).
! 206: '_'.$ENV{'form.persistent_db_id'}.'_persistent_search.db';
! 207: #
! 208: # Read in the database. It should (hopefully) not be catastrophic to
! 209: # fail in this exercise.
! 210: if (-e $persistent_db_file) {
! 211: # Read in the previous values, if we can.
! 212: if (tie(%persistent_db,'GDBM_File',$persistent_db_file,
! 213: &GDBM_READER,0640)) {
! 214: &reconstruct_persistent_form_data($r);
! 215: untie (%persistent_db);
! 216: }
! 217: }
1.124 matthew 218: ##
1.143 matthew 219: ## Clear out old values from groupsearch database
1.124 matthew 220: ##
1.101 harris41 221: if ($ENV{'form.launch'} eq '1') {
1.142 matthew 222: if (tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
1.101 harris41 223: &start_fresh_session();
1.142 matthew 224: untie %groupsearch_db;
1.122 matthew 225: } else {
1.101 harris41 226: $r->print('<html><head></head><body>Unable to tie hash to db '.
227: 'file</body></html>');
228: return OK;
229: }
230: }
1.124 matthew 231: ##
232: ## Configure dynamic components of interface
233: ##
1.145 ! matthew 234: $hidden_fields = '<input type="hidden" name="persistent_db_id" value="'.
! 235: $ENV{'form.persistent_db_id'}.'" />';
1.98 harris41 236: if ($ENV{'form.catalogmode'} eq 'interactive') {
237: $closebutton="<input type='button' name='close' value='CLOSE' ".
238: "onClick='self.close()'>"."\n";
1.124 matthew 239: } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
1.98 harris41 240: $closebutton=<<END;
241: <input type='button' name='close' value='CLOSE' onClick='self.close()'>
242: END
243: $importbutton=<<END;
244: <input type='button' name='import' value='IMPORT'
245: onClick='javascript:select_group()'>
246: END
247: }
1.124 matthew 248: ##
1.145 ! matthew 249: ## Do a search, if needed.
1.124 matthew 250: ##
1.134 matthew 251: my $searchtype;
252: $searchtype = 'Basic' if ($ENV{'form.basicsubmit'} eq 'SEARCH');
253: $searchtype = 'Advanced' if ($ENV{'form.advancedsubmit'} eq 'SEARCH');
254: if ($searchtype) {
1.145 ! matthew 255: ##
! 256: ## make query information persistent to allow for subsequent revision
! 257: ##
! 258: tie(%persistent_db,'GDBM_File',$persistent_db_file,&GDBM_WRCREAT,0640);
! 259: &make_persistent(\%ENV);
! 260: untie(%persistent_db);
! 261: #
1.139 matthew 262: # We are running a search
1.134 matthew 263: my ($query,$customquery,$customshow,$libraries) =
264: (undef,undef,undef,undef);
1.143 matthew 265: my $pretty_string;
1.134 matthew 266: if ($searchtype eq 'Basic') {
1.145 ! matthew 267: ($query,$pretty_string) = &parse_basic_search($r,$closebutton);
1.134 matthew 268: } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
1.143 matthew 269: ($query,$customquery,$customshow,$libraries,$pretty_string)
1.145 ! matthew 270: = &parse_advanced_search($r,$closebutton);
1.134 matthew 271: return OK if (! defined($query));
272: }
1.142 matthew 273: # Output some information to the user.
1.143 matthew 274: $r->print(&search_results_header($searchtype,$pretty_string));
1.142 matthew 275: $r->print("Sending search request to LON-CAPA servers.<br />\n");
276: $r->rflush();
1.144 matthew 277: &run_search($r,$query,$customquery,$customshow,$libraries);
1.145 ! matthew 278: ##
! 279: ## Display the results
! 280: ##
! 281: &display_results($r,$searchtype,$importbutton,$closebutton);
1.142 matthew 282: $r->rflush();
1.139 matthew 283: } else {
284: #
285: # Set the default view if it is not already set.
286: if (!defined($ENV{'form.viewselect'})) {
287: $ENV{'form.viewselect'} ="Detailed Citation View";
288: }
1.145 ! matthew 289: #
! 290: # remove the requested interface from the environment.
! 291: my $interface;
! 292: if ($ENV{'form.reqinterface'}) {
! 293: $interface = lc($ENV{'form.reqinterface'});
! 294: } else {
! 295: $interface = 'basic';
! 296: }
! 297: ##
! 298: ## Determine course of action
! 299: ##
! 300: if ($interface eq 'display') {
! 301: # &display_results($closebutton));
! 302: } elsif ($interface eq 'advanced') {
! 303: $r->print(&advanced_search_form($closebutton));
! 304: } elsif ($interface eq 'basic') {
1.139 matthew 305: # Output normal search interface
1.145 ! matthew 306: $r->print(&basic_search_form($closebutton));
1.139 matthew 307: }
1.124 matthew 308: }
1.145 ! matthew 309: untie (%persistent_db);
1.124 matthew 310: return OK;
311: }
1.98 harris41 312:
1.124 matthew 313: ######################################################################
314: ######################################################################
315:
316: =pod
317:
318: =item &basic_search_form()
319:
320: Returns a scalar which holds html for the basic search form.
321:
322: =cut
323:
324: ######################################################################
325: ######################################################################
1.3 harris41 326:
1.124 matthew 327: sub basic_search_form{
1.145 ! matthew 328: my ($closebutton) = @_;
1.124 matthew 329: my $scrout=<<"ENDDOCUMENT";
330: <html>
331: <head>
332: <title>The LearningOnline Network with CAPA</title>
333: <script type="text/javascript">
334: function openhelp(val) {
335: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
336: 'scrollbars=1,width=600,height=300');
337: openhelpwin.focus();
1.6 harris41 338: }
1.124 matthew 339: </script>
340: </head>
341: <body bgcolor="#FFFFFF">
342: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
343: <h1>Search Catalog</h1>
344: <form method="post" action="/adm/searchcat">
1.145 ! matthew 345: $hidden_fields
1.124 matthew 346: <h3>Basic Search</h3>
347: <p>
1.131 matthew 348: Enter terms or phrases separated by AND, OR, or NOT
1.129 matthew 349: then press SEARCH below.
1.124 matthew 350: </p>
351: <p>
352: <table>
353: <tr><td>
354: ENDDOCUMENT
355: $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40).
356: ' ';
357: # $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'});
358: # $scrout.='<font color="#800000">Search historic archives</font>';
1.141 matthew 359: my $checkbox = &simplecheckbox('related',$ENV{'form.related'});
1.139 matthew 360: $scrout.=<<END;
1.141 matthew 361: </td><td><a href="/adm/searchcat?reqinterface=advanced">Advanced Search</a></td></tr>
362: <tr><td>$checkbox use related words</td><td></td></tr>
363: </table>
1.124 matthew 364: </p>
365: <p>
366: <input type="submit" name="basicsubmit" value='SEARCH' />
367: $closebutton
1.139 matthew 368: END
369: $scrout.=&selectbox(undef,'viewselect',
370: $ENV{'form.viewselect'},
371: undef,undef,undef,
372: sort(keys(%Views)));
373: $scrout.=<<ENDDOCUMENT;
1.124 matthew 374: <input type="button" value="HELP" onClick="openhelp()" />
375: </p>
376: </form>
377: </body>
378: </html>
379: ENDDOCUMENT
380: return $scrout;
381: }
382: ######################################################################
383: ######################################################################
384:
385: =pod
386:
387: =item &advanced_search_form()
388:
389: Returns a scalar which holds html for the advanced search form.
390:
391: =cut
392:
393: ######################################################################
394: ######################################################################
395:
396: sub advanced_search_form{
1.145 ! matthew 397: my ($closebutton) = @_;
1.129 matthew 398: my $advanced_buttons = <<"END";
399: <p>
400: <input type="submit" name="advancedsubmit" value='SEARCH' />
401: <input type="reset" name="reset" value='RESET' />
402: $closebutton
403: <input type="button" value="HELP" onClick="openhelp()" />
404: </p>
405: END
1.139 matthew 406: if (!defined($ENV{'form.viewselect'})) {
407: $ENV{'form.viewselect'} ="Detailed Citation View";
408: }
1.124 matthew 409: my $scrout=<<"ENDHEADER";
410: <html>
411: <head>
412: <title>The LearningOnline Network with CAPA</title>
413: <script type="text/javascript">
414: function openhelp(val) {
415: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
416: 'scrollbars=1,width=600,height=300');
417: openhelpwin.focus();
1.18 harris41 418: }
1.124 matthew 419: </script>
420: </head>
421: <body bgcolor="#FFFFFF">
422: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
1.129 matthew 423: <h1>Advanced Catalog Search</h1>
424: <hr />
1.131 matthew 425: Enter terms or phrases separated by search operators
1.129 matthew 426: such as AND, OR, or NOT.<br />
1.130 matthew 427: <form method="post" action="/adm/searchcat">
1.129 matthew 428: $advanced_buttons
1.145 ! matthew 429: $hidden_fields
1.129 matthew 430: <table>
1.130 matthew 431: <tr><td><font color="#800000" face="helvetica"><b>VIEW:</b></font></td>
432: <td>
1.124 matthew 433: ENDHEADER
1.139 matthew 434: $scrout.=&selectbox(undef,'viewselect',
435: $ENV{'form.viewselect'},
436: undef,undef,undef,
437: sort(keys(%Views)));
1.142 matthew 438: $scrout.="</td><td>Related<br />Words</td></tr>\n";
439: $scrout.=&searchphrasefield_with_related('title', 'title' ,
440: $ENV{'form.title'});
1.135 matthew 441: $scrout.=&searchphrasefield('author', 'author' ,$ENV{'form.author'});
1.142 matthew 442: $scrout.=&searchphrasefield_with_related('subject', 'subject' ,
443: $ENV{'form.subject'});
444: $scrout.=&searchphrasefield_with_related('keywords','keywords',
445: $ENV{'form.keywords'});
1.135 matthew 446: $scrout.=&searchphrasefield('URL', 'url' ,$ENV{'form.url'});
1.142 matthew 447: $scrout.=&searchphrasefield_with_related('notes', 'notes' ,
448: $ENV{'form.notes'});
449: $scrout.=&searchphrasefield_with_related('abstract','abstract',
450: $ENV{'form.abstract'});
1.129 matthew 451: # Hack - an empty table row.
1.142 matthew 452: $scrout.="<tr><td> </td><td> </td><td> </td></tr>\n";
1.129 matthew 453: $scrout.=&searchphrasefield('file<br />extension','mime',
454: $ENV{'form.mime'});
1.142 matthew 455: $scrout.="<tr><td> </td><td> </td><td> </td></tr>\n";
1.129 matthew 456: $scrout.=&searchphrasefield('publisher<br />owner','owner',
457: $ENV{'form.owner'});
458: $scrout.="</table>\n";
1.131 matthew 459: $ENV{'form.category'}='any' unless length($ENV{'form.category'});
1.132 matthew 460: $scrout.=&selectbox('File Category','category',
1.131 matthew 461: $ENV{'form.category'},
462: 'any','Any category',
463: undef,
464: (&Apache::loncommon::filecategories()));
1.11 harris41 465: $ENV{'form.language'}='any' unless length($ENV{'form.language'});
1.133 matthew 466: #----------------------------------------------------------------
1.132 matthew 467: # Allow restriction to multiple domains.
468: # I make the crazy assumption that there will never be a domain 'any'.
469: #
1.133 matthew 470: $ENV{'form.domains'} = 'any' if (! exists($ENV{'form.domains'}));
471: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}}
472: : ($ENV{'form.domains'}) );
473: my %domain_hash = ();
474: foreach (@allowed_domains) {
475: $domain_hash{$_}++;
476: }
1.132 matthew 477: my @domains =&Apache::loncommon::get_domains();
478: # adjust the size of the select box
479: my $size = 4;
480: my $size = (scalar @domains < ($size - 1) ? scalar @domains + 1 : $size);
1.145 ! matthew 481: $scrout.="\n".'<font color="#800000" face="helvetica"><b>'.
! 482: 'DOMAINS</b></font><br />'.
! 483: '<select name="domains" size="'.$size.'" multiple>'."\n".
! 484: '<option name="any" value="any" '.
! 485: ($domain_hash{'any'}? 'selected ' :'').
1.133 matthew 486: '>all domains</option>'."\n";
1.145 ! matthew 487: foreach my $dom (sort @domains) {
! 488: $scrout.="<option name=\"$dom\" ".
! 489: ($domain_hash{$dom} ? 'selected ' :'').">$dom</option>\n";
1.132 matthew 490: }
1.145 ! matthew 491: $scrout.="</select>\n";
1.133 matthew 492: #----------------------------------------------------------------
1.3 harris41 493: $scrout.=&selectbox('Limit by language','language',
1.111 harris41 494: $ENV{'form.language'},'any','Any Language',
495: \&{Apache::loncommon::languagedescription},
496: (&Apache::loncommon::languageids),
497: );
1.8 harris41 498: # ------------------------------------------------ Compute date selection boxes
499: $scrout.=<<CREATIONDATESTART;
1.3 harris41 500: <p>
501: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
502: </font>
1.98 harris41 503: <br />
1.8 harris41 504: between:
505: CREATIONDATESTART
1.11 harris41 506: $scrout.=&dateboxes('creationdatestart',1,1,1976,
507: $ENV{'form.creationdatestart_month'},
508: $ENV{'form.creationdatestart_day'},
509: $ENV{'form.creationdatestart_year'},
510: );
1.124 matthew 511: $scrout.="and:\n";
1.11 harris41 512: $scrout.=&dateboxes('creationdateend',12,31,2051,
513: $ENV{'form.creationdateend_month'},
514: $ENV{'form.creationdateend_day'},
515: $ENV{'form.creationdateend_year'},
516: );
1.8 harris41 517: $scrout.="</p>";
518: $scrout.=<<LASTREVISIONDATESTART;
519: <p>
520: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
521: </b></font>
1.98 harris41 522: <br />between:
1.8 harris41 523: LASTREVISIONDATESTART
1.11 harris41 524: $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
525: $ENV{'form.lastrevisiondatestart_month'},
526: $ENV{'form.lastrevisiondatestart_day'},
527: $ENV{'form.lastrevisiondatestart_year'},
528: );
1.8 harris41 529: $scrout.=<<LASTREVISIONDATEEND;
530: and:
531: LASTREVISIONDATEEND
1.11 harris41 532: $scrout.=&dateboxes('lastrevisiondateend',12,31,2051,
533: $ENV{'form.lastrevisiondateend_month'},
534: $ENV{'form.lastrevisiondateend_day'},
535: $ENV{'form.lastrevisiondateend_year'},
536: );
1.8 harris41 537: $scrout.='</p>';
1.11 harris41 538: $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
1.8 harris41 539: $scrout.=&selectbox('Limit by copyright/distribution','copyright',
1.111 harris41 540: $ENV{'form.copyright'},
541: 'any','Any copyright/distribution',
542: \&{Apache::loncommon::copyrightdescription},
543: (&Apache::loncommon::copyrightids),
544: );
1.14 harris41 545: # ------------------------------------------- Compute customized metadata field
546: $scrout.=<<CUSTOMMETADATA;
547: <p>
1.77 harris41 548: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
1.14 harris41 549: </font>
1.77 harris41 550: For resource-specific metadata, enter in an expression in the form of
1.100 harris41 551: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
1.14 harris41 552: <b>Example:</b> grandmother=75 OR grandfather=85
1.98 harris41 553: <br />
1.14 harris41 554: CUSTOMMETADATA
1.124 matthew 555: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
1.77 harris41 556: $scrout.=<<CUSTOMSHOW;
557: <p>
558: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b>
559: </font>
560: Enter in a space-separated list of special metadata fields to show
561: in a fielded listing for each record result.
1.98 harris41 562: <br />
1.77 harris41 563: CUSTOMSHOW
1.124 matthew 564: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'});
565: $scrout.=<<ENDDOCUMENT;
1.129 matthew 566: $advanced_buttons
1.8 harris41 567: </form>
568: </body>
569: </html>
570: ENDDOCUMENT
1.124 matthew 571: return $scrout;
572: }
1.8 harris41 573:
1.121 matthew 574: ######################################################################
575: ######################################################################
576:
577: =pod
578:
1.145 ! matthew 579: =item &reconstruct_persistent_form_data
! 580:
! 581: This function is the reverse of &make_persistent();
! 582: Retrieve persistent data from %persistent_db. Retrieved items will have their
! 583: values unescaped. If the item contains commas (before unescaping), the
! 584: returned value will be an array pointer. Items will be returned in the
! 585: environment in $ENV{"form.$name"}.
! 586:
! 587: =cut
! 588:
! 589: ######################################################################
! 590: ######################################################################
! 591: sub reconstruct_persistent_form_data {
! 592: foreach my $name (keys %persistent_db) {
! 593: # &Apache::lonnet::logthis("Reconstructing $name = $persistent_db{$name}");
! 594: my @Values = split(',',$persistent_db{$name});
! 595: my @value = map { &Apache::lonnet::unescape($_) } @Values;
! 596: $name = 'form.'.$name;
! 597: if (exists($ENV{$name})) {
! 598: if (ref($ENV{$name})) {
! 599: # Assume it is an array reference
! 600: $ENV{$name} = [@{$ENV{$name}},@value];
! 601: } else {
! 602: $ENV{$name} = [$ENV{$name},@value];
! 603: }
! 604: } else {
! 605: if (@value > 1) {
! 606: $ENV{$name} = [@value];
! 607: } else {
! 608: $ENV{$name} = $value[0];
! 609: }
! 610: }
! 611: }
! 612: return;
! 613: }
! 614:
! 615: ######################################################################
! 616: ######################################################################
! 617:
! 618: =pod
! 619:
1.121 matthew 620: =item &make_persistent()
621:
1.145 ! matthew 622: Store (environment) variables away to the %persistent_db.
! 623: Values will be escaped. Values that are array pointers will have their
! 624: elements escaped and concatenated in a comma seperated string.
1.122 matthew 625:
1.121 matthew 626: =cut
627:
628: ######################################################################
629: ######################################################################
1.98 harris41 630: sub make_persistent {
1.133 matthew 631: my %save = %{shift()};
1.143 matthew 632: foreach my $name (keys %save) {
1.145 ! matthew 633: next if ($name !~ /^form\./ || $name =~ /submit/);
! 634: my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name}));
! 635: # We handle array references, but not recursively.
! 636: my $store = join(',', map { &Apache::lonnet::escape($_); } @values );
! 637: $name=~s/^form\.//;
! 638: $persistent_db{$name} = $store;
1.109 harris41 639: }
1.145 ! matthew 640: return '';
1.98 harris41 641: }
642:
1.122 matthew 643: ######################################################################
1.142 matthew 644: # HTML form building functions #
1.122 matthew 645: ######################################################################
646:
647: =pod
648:
649: =item HTML form building functions
650:
651: =over 4
652:
1.142 matthew 653: =cut
654:
655: ###############################################
656: ###############################################
657:
658: =pod
659:
1.122 matthew 660: =item &simpletextfield()
661:
662: Inputs: $name,$value,$size
663:
664: Returns a text input field with the given name, value, and size.
665: If size is not specified, a value of 20 is used.
666:
1.142 matthew 667: =cut
668:
669: ###############################################
670: ###############################################
671:
672: sub simpletextfield {
673: my ($name,$value,$size)=@_;
674: $size = 20 if (! defined($size));
675: return '<input type="text" name="'.$name.
676: '" size="'.$size.'" value="'.$value.'" />';
677: }
678:
679: ###############################################
680: ###############################################
681:
682: =pod
683:
1.122 matthew 684: =item &simplecheckbox()
685:
686: Inputs: $name,$value
687:
688: Returns a simple check box with the given $name.
689: If $value eq 'on' the box is checked.
690:
1.142 matthew 691: =cut
692:
693: ###############################################
694: ###############################################
1.122 matthew 695:
1.142 matthew 696: sub simplecheckbox {
697: my ($name,$value)=@_;
698: my $checked='';
699: $checked="checked" if $value eq 'on';
700: return '<input type="checkbox" name="'.$name.'" '. $checked . ' />';
701: }
1.122 matthew 702:
1.142 matthew 703: ###############################################
704: ###############################################
1.122 matthew 705:
1.142 matthew 706: =pod
1.122 matthew 707:
1.142 matthew 708: =item &fieldtitle()
1.126 matthew 709:
1.142 matthew 710: Input: $title
1.122 matthew 711:
1.142 matthew 712: Returns a scalar with html which will display $title as a search
713: field heading.
1.129 matthew 714:
1.142 matthew 715: =cut
1.129 matthew 716:
1.142 matthew 717: ###############################################
718: ###############################################
1.129 matthew 719:
1.142 matthew 720: sub fieldtitle {
721: my $title = uc(shift());
722: return '<font color="#800000" face="helvetica"><b>'.$title.
723: ': </b></font>';
724: }
1.129 matthew 725:
1.142 matthew 726: ###############################################
727: ###############################################
1.129 matthew 728:
1.142 matthew 729: =pod
1.129 matthew 730:
1.142 matthew 731: =item &searchphrasefield()
1.129 matthew 732:
1.142 matthew 733: Inputs: $title,$name,$value
1.129 matthew 734:
1.142 matthew 735: Returns html for a title line and an input field for entering search terms.
736: The entry field (which is where the $name and $value are used) is a 50 column
737: simpletextfield. The html returned is for a row in a three column table.
1.129 matthew 738:
1.142 matthew 739: =cut
1.129 matthew 740:
1.142 matthew 741: ###############################################
742: ###############################################
743:
744: sub searchphrasefield {
745: my ($title,$name,$value)=@_;
746: return '<tr><td>'.&fieldtitle($title).'</td><td>'.
747: &simpletextfield($name,$value,50)."</td><td> </td></tr>\n";
748: }
1.129 matthew 749:
1.142 matthew 750: ###############################################
751: ###############################################
1.129 matthew 752:
1.142 matthew 753: =pod
1.129 matthew 754:
1.142 matthew 755: =item &searchphrasefield_with_related()
1.129 matthew 756:
1.142 matthew 757: Inputs: $title,$name,$value
1.129 matthew 758:
1.142 matthew 759: Returns html for a title line and an input field for entering search terms
760: and a check box for 'related words'. The entry field (which is where the
761: $name and $value are used) is a 50 column simpletextfield. The name of
762: the related words checkbox is "$name_related".
1.129 matthew 763:
1.142 matthew 764: =cut
1.129 matthew 765:
1.142 matthew 766: ###############################################
767: ###############################################
768:
769: sub searchphrasefield_with_related {
770: my ($title,$name,$value)=@_;
771: return '<tr><td>'.&fieldtitle($title).'</td><td>'.
772: &simpletextfield($name,$value,50).'</td><td align="center"> '.
773: &simplecheckbox($name.'_related',$ENV{'form.'.$name.'_related'}).
774: " </td></tr>\n";
775: }
1.126 matthew 776:
1.142 matthew 777: ###############################################
778: ###############################################
1.122 matthew 779:
1.142 matthew 780: =pod
1.122 matthew 781:
1.142 matthew 782: =item &dateboxes()
1.8 harris41 783:
1.142 matthew 784: Returns html selection form elements for the specification of
785: the day, month, and year.
1.11 harris41 786:
1.142 matthew 787: =cut
1.11 harris41 788:
1.142 matthew 789: ###############################################
790: ###############################################
1.3 harris41 791:
1.8 harris41 792: sub dateboxes {
1.11 harris41 793: my ($name,$defaultmonth,$defaultday,$defaultyear,
794: $currentmonth,$currentday,$currentyear)=@_;
795: ($defaultmonth,$defaultday,$defaultyear)=('','','');
1.117 matthew 796: #
797: # Day
798: my $day=<<END;
799: <select name="${name}_day">
800: <option value='$defaultday'> </option>
801: END
802: for (my $i = 1; $i<=31; $i++) {
803: $day.="<option value=\"$i\">$i</option>\n";
804: }
805: $day.="</select>\n";
806: $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
807: #
808: # Month
1.11 harris41 809: my $month=<<END;
1.8 harris41 810: <select name="${name}_month">
1.11 harris41 811: <option value='$defaultmonth'> </option>
812: END
1.117 matthew 813: my $i = 1;
814: foreach (qw/January February March April May June
815: July August September October November December /){
816: $month .="<option value=\"$i\">$_</option>\n";
817: $i++;
818: }
819: $month.="</select>\n";
1.11 harris41 820: $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
1.117 matthew 821: #
822: # Year (obviously)
1.11 harris41 823: my $year=<<END;
1.8 harris41 824: <select name="${name}_year">
1.11 harris41 825: <option value='$defaultyear'> </option>
1.3 harris41 826: END
1.117 matthew 827: my $maxyear = 2051;
828: for (my $i = 1976; $i<=$maxyear; $i++) {
829: $year.="<option value=\"$i\">$i</option>\n";
830: }
831: $year.="</select>\n";
1.11 harris41 832: $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
833: return "$month$day$year";
1.3 harris41 834: }
835:
1.142 matthew 836: ###############################################
837: ###############################################
838:
839: =pod
840:
841: =item &selectbox()
842:
843: Returns a scalar containing an html <select> form.
844:
845: Inputs:
846:
847: =over 4
848:
849: =item $title
850:
851: Printed above the select box, in uppercase. If undefined, only a select
852: box will be returned, with no additional html.
853:
854: =item $name
855:
856: The name element of the <select> tag.
857:
858: =item $default
859:
860: The default value of the form. Can be $anyvalue, or in @idlist.
861:
862: =item $anyvalue
863:
864: The <option value="..."> used to indicate a default of
865: none of the values. Can be undef.
866:
867: =item $anytag
868:
869: The text associate with $anyvalue above.
870:
871: =item $functionref
872:
873: Each element in @idlist will be passed as a parameter
874: to the function referenced here. The return value of the function should
875: be a scalar description of the items. If this value is undefined the
876: description of each item in @idlist will be the item name.
877:
878: =item @idlist
879:
880: The items to be selected from. One of these or $anyvalue will be the
881: value returned by the form element, $ENV{form.$name}.
882:
883: =back
884:
885: =cut
886:
887: ###############################################
888:
1.3 harris41 889: sub selectbox {
1.129 matthew 890: my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_;
891: if (! defined($functionref)) { $functionref = sub { $_[0]}; }
1.139 matthew 892: my $selout='';
893: if (defined($title)) {
894: my $uctitle=uc($title);
895: $selout="\n".'<p><font color="#800000" face="helvetica">'.
896: '<b>'.$uctitle.': </b></font>';
897: }
898: $selout .= '<select name="'.$name.'">';
899: unshift @idlist,$anyvalue if (defined($anyvalue));
900: foreach (@idlist) {
1.122 matthew 901: $selout.='<option value="'.$_.'"';
1.129 matthew 902: if ($_ eq $default and !/^any$/) {
1.122 matthew 903: $selout.=' selected >'.&{$functionref}($_).'</option>';
1.111 harris41 904: }
1.129 matthew 905: elsif ($_ eq $default and /^$anyvalue$/) {
1.122 matthew 906: $selout.=' selected >'.$anytag.'</option>';
1.111 harris41 907: }
908: else {$selout.='>'.&{$functionref}($_).'</option>';}
1.109 harris41 909: }
1.139 matthew 910: return $selout.'</select>'.(defined($title)?'</p>':' ');
1.6 harris41 911: }
912:
1.122 matthew 913: ######################################################################
1.142 matthew 914: # End of HTML form building functions #
915: ######################################################################
916:
917: =pod
918:
919: =back
920:
921: =cut
922:
923:
924: ######################################################################
1.122 matthew 925: ######################################################################
926:
927: =pod
928:
1.134 matthew 929: =item &parse_advanced_search()
930:
931: Parse advanced search form and return the following:
932:
933: =over 4
934:
935: =item $query Scalar containing an SQL query.
1.126 matthew 936:
1.134 matthew 937: =item $customquery Scalar containing a custom query.
938:
939: =item $customshow Scalar containing commands to show custom metadata.
940:
941: =item $libraries_to_query Reference to array of domains to search.
942:
943: =back
1.122 matthew 944:
945: =cut
946:
947: ######################################################################
948: ######################################################################
1.134 matthew 949: sub parse_advanced_search {
1.145 ! matthew 950: my ($r,$closebutton)=@_;
1.32 harris41 951: my $fillflag=0;
1.143 matthew 952: my $pretty_search_string = "<br />\n";
1.64 harris41 953: # Clean up fields for safety
954: for my $field ('title','author','subject','keywords','url','version',
955: 'creationdatestart_month','creationdatestart_day',
956: 'creationdatestart_year','creationdateend_month',
957: 'creationdateend_day','creationdateend_year',
958: 'lastrevisiondatestart_month','lastrevisiondatestart_day',
959: 'lastrevisiondatestart_year','lastrevisiondateend_month',
960: 'lastrevisiondateend_day','lastrevisiondateend_year',
961: 'notes','abstract','mime','language','owner',
1.131 matthew 962: 'custommetadata','customshow','category') {
1.101 harris41 963: $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
1.64 harris41 964: }
1.117 matthew 965: foreach ('mode','form','element') {
966: # is this required? Hmmm.
967: next unless (exists($ENV{"form.$_"}));
968: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
969: $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
970: }
1.131 matthew 971: # Preprocess the category form element.
972: if ($ENV{'form.category'} ne 'any') {
973: my @extensions = &Apache::loncommon::filecategorytypes
974: ($ENV{'form.category'});
975: $ENV{'form.mime'} = join ' OR ',@extensions;
976: }
1.90 harris41 977: # Check to see if enough information was filled in
1.32 harris41 978: for my $field ('title','author','subject','keywords','url','version',
979: 'notes','abstract','mime','language','owner',
980: 'custommetadata') {
1.40 harris41 981: if (&filled($ENV{"form.$field"})) {
1.32 harris41 982: $fillflag++;
983: }
984: }
985: unless ($fillflag) {
1.145 ! matthew 986: &output_blank_field_error($r,$closebutton);
1.134 matthew 987: return ;
1.32 harris41 988: }
1.90 harris41 989: # Turn the form input into a SQL-based query
1.39 harris41 990: my $query='';
1.45 harris41 991: my @queries;
1.143 matthew 992: my $font = '<font color="#800000" face="helvetica">';
1.90 harris41 993: # Evaluate logical expression AND/OR/NOT phrase fields.
1.58 harris41 994: foreach my $field ('title','author','subject','notes','abstract','url',
1.129 matthew 995: 'keywords','version','owner','mime') {
1.44 harris41 996: if ($ENV{'form.'.$field}) {
1.142 matthew 997: my $searchphrase = $ENV{'form.'.$field};
1.143 matthew 998: $pretty_search_string .= $font."$field</font> contains <b>".
999: $searchphrase."</b>";
1.142 matthew 1000: if ($ENV{'form.'.$field.'_related'}) {
1.143 matthew 1001: my @New_Words;
1002: ($searchphrase,@New_Words) = &related_version($searchphrase);
1003: if (@New_Words) {
1004: $pretty_search_string .= " with related words: ".
1005: "<b>@New_Words</b>.";
1006: } else {
1007: $pretty_search_string .= " with no related words.";
1008: }
1.142 matthew 1009: }
1.143 matthew 1010: $pretty_search_string .= "<br />\n";
1.142 matthew 1011: push @queries,&build_SQL_query($field,$searchphrase);
1.131 matthew 1012: }
1.44 harris41 1013: }
1.135 matthew 1014: # I dislike the hack below.
1015: if ($ENV{'form.category'}) {
1016: $ENV{'form.mime'}='';
1017: }
1.90 harris41 1018: # Evaluate option lists
1.58 harris41 1019: if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
1.90 harris41 1020: push @queries,"(language like \"$ENV{'form.language'}\")";
1.143 matthew 1021: $pretty_search_string.=$font."language</font>= ".
1022: &Apache::loncommon::languagedescription($ENV{'form.language'}).
1023: "<br />\n";
1.58 harris41 1024: }
1025: if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
1.90 harris41 1026: push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
1.143 matthew 1027: $pretty_search_string.=$font."copyright</font> = ".
1028: &Apache::loncommon::copyrightdescription($ENV{'form.copyright'}).
1029: "<br \>\n";
1.58 harris41 1030: }
1.143 matthew 1031: #
1.90 harris41 1032: # Evaluate date windows
1.60 harris41 1033: my $datequery=&build_date_queries(
1034: $ENV{'form.creationdatestart_month'},
1035: $ENV{'form.creationdatestart_day'},
1036: $ENV{'form.creationdatestart_year'},
1037: $ENV{'form.creationdateend_month'},
1038: $ENV{'form.creationdateend_day'},
1039: $ENV{'form.creationdateend_year'},
1040: $ENV{'form.lastrevisiondatestart_month'},
1041: $ENV{'form.lastrevisiondatestart_day'},
1042: $ENV{'form.lastrevisiondatestart_year'},
1043: $ENV{'form.lastrevisiondateend_month'},
1044: $ENV{'form.lastrevisiondateend_day'},
1045: $ENV{'form.lastrevisiondateend_year'},
1046: );
1.90 harris41 1047: # Test to see if date windows are legitimate
1.61 harris41 1048: if ($datequery=~/^Incorrect/) {
1.145 ! matthew 1049: &output_date_error($r,$datequery,$closebutton);
1.134 matthew 1050: return ;
1.143 matthew 1051: } elsif ($datequery) {
1052: # Here is where you would set up pretty_search_string to output
1053: # date query information.
1.60 harris41 1054: push @queries,$datequery;
1055: }
1.90 harris41 1056: # Process form information for custom metadata querying
1.134 matthew 1057: my $customquery=undef;
1.64 harris41 1058: if ($ENV{'form.custommetadata'}) {
1.143 matthew 1059: $pretty_search_string .=$font."Custom Metadata Search</font>: <b>".
1060: $ENV{'form.custommetadata'}."</b><br />\n";
1.64 harris41 1061: $customquery=&build_custommetadata_query('custommetadata',
1062: $ENV{'form.custommetadata'});
1063: }
1.134 matthew 1064: my $customshow=undef;
1.83 harris41 1065: if ($ENV{'form.customshow'}) {
1.143 matthew 1066: $pretty_search_string .=$font."Custom Metadata Display</font>: <b>".
1067: $ENV{'form.customshow'}."</b><br />\n";
1.83 harris41 1068: $customshow=$ENV{'form.customshow'};
1069: $customshow=~s/[^\w\s]//g;
1070: my @fields=split(/\s+/,$customshow);
1071: $customshow=join(" ",@fields);
1072: }
1.133 matthew 1073: ## ---------------------------------------------------------------
1.132 matthew 1074: ## Deal with restrictions to given domains
1075: ##
1076: my $libraries_to_query = undef;
1077: # $ENV{'form.domains'} can be either a scalar or an array reference.
1078: # We need an array.
1079: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}}
1080: : ($ENV{'form.domains'}) );
1081: my %domain_hash = ();
1.143 matthew 1082: my $pretty_domains_string;
1.132 matthew 1083: foreach (@allowed_domains) {
1084: $domain_hash{$_}++;
1085: }
1.143 matthew 1086: if ($domain_hash{'any'}) {
1087: $pretty_domains_string = "Searching all domains.";
1088: } else {
1089: if (@allowed_domains > 1) {
1090: $pretty_domains_string = "Searching domains:";
1091: } else {
1092: $pretty_domains_string = "Searching domain ";
1093: }
1094: foreach (sort @allowed_domains) {
1095: $pretty_domains_string .= "<b>$_</b> ";
1.132 matthew 1096: }
1.143 matthew 1097: foreach (keys(%Apache::lonnet::libserv)) {
1098: if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) {
1099: push @$libraries_to_query,$_;
1100: }
1.132 matthew 1101: }
1102: }
1.143 matthew 1103: $pretty_search_string .= $pretty_domains_string."<br />\n";
1.132 matthew 1104: #
1.45 harris41 1105: if (@queries) {
1.58 harris41 1106: $query=join(" AND ",@queries);
1.46 harris41 1107: $query="select * from metadata where $query";
1.126 matthew 1108: } elsif ($customquery) {
1.134 matthew 1109: $query = '';
1.45 harris41 1110: }
1.143 matthew 1111: return ($query,$customquery,$customshow,$libraries_to_query,
1112: $pretty_search_string);
1.18 harris41 1113: }
1114:
1.122 matthew 1115: ######################################################################
1116: ######################################################################
1117:
1118: =pod
1119:
1.134 matthew 1120: =item &parse_basic_search()
1.122 matthew 1121:
1.134 matthew 1122: Parse the basic search form and return a scalar containing an sql query.
1.126 matthew 1123:
1.122 matthew 1124: =cut
1125:
1126: ######################################################################
1127: ######################################################################
1.134 matthew 1128: sub parse_basic_search {
1.145 ! matthew 1129: my ($r,$closebutton)=@_;
1.64 harris41 1130: # Clean up fields for safety
1131: for my $field ('basicexp') {
1132: $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
1133: }
1.117 matthew 1134: foreach ('mode','form','element') {
1135: # is this required? Hmmm.
1136: next unless (exists($ENV{"form.$_"}));
1137: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
1138: $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
1139: }
1.64 harris41 1140:
1.90 harris41 1141: # Check to see if enough is filled in
1.26 harris41 1142: unless (&filled($ENV{'form.basicexp'})) {
1.145 ! matthew 1143: &output_blank_field_error($r,$closebutton);
1.24 harris41 1144: return OK;
1145: }
1.143 matthew 1146: my $pretty_search_string = '<b>'.$ENV{'form.basicexp'}.'</b>';
1.142 matthew 1147: my $search_string = $ENV{'form.basicexp'};
1.141 matthew 1148: if ($ENV{'form.related'}) {
1.143 matthew 1149: my @New_Words;
1150: ($search_string,@New_Words) = &related_version($ENV{'form.basicexp'});
1151: if (@New_Words) {
1152: $pretty_search_string .= " with related words: <b>@New_Words</b>.";
1153: } else {
1154: $pretty_search_string .= " with no related words.";
1155: }
1.141 matthew 1156: }
1.90 harris41 1157: # Build SQL query string based on form page
1.39 harris41 1158: my $query='';
1.33 harris41 1159: my $concatarg=join('," ",',
1.124 matthew 1160: ('title', 'author', 'subject', 'notes', 'abstract',
1161: 'keywords'));
1.95 harris41 1162: $concatarg='title' if $ENV{'form.titleonly'};
1.142 matthew 1163: $query=&build_SQL_query('concat('.$concatarg.')',$search_string);
1.143 matthew 1164: $pretty_search_string .= "<br />\n";
1165: return 'select * from metadata where '.$query,$pretty_search_string;
1.22 harris41 1166: }
1167:
1.122 matthew 1168:
1169: ######################################################################
1170: ######################################################################
1171:
1172: =pod
1173:
1.142 matthew 1174: =item &related_version
1175:
1176: Modifies an input string to include related words. Words in the string
1177: are replaced with parenthesized lists of 'OR'd words. For example
1178: "torque" is replaced with "(torque OR word1 OR word2 OR ...)".
1179:
1180: Note: Using this twice on a string is probably silly.
1181:
1182: =cut
1183:
1184: ######################################################################
1185: ######################################################################
1186: sub related_version {
1187: my $search_string = shift;
1188: my $result = $search_string;
1.143 matthew 1189: my %New_Words = ();
1.142 matthew 1190: while ($search_string =~ /(\w+)/cg) {
1191: my $word = $1;
1192: next if (lc($word) =~ /\b(or|and|not)\b/);
1193: my @Words = &Apache::loncommon::get_related_words($word);
1.143 matthew 1194: @Words = ($#Words>4? @Words[0..4] : @Words);
1195: foreach (@Words) { $New_Words{$_}++;}
1196: my $replacement = join " OR ", ($word,@Words);
1.142 matthew 1197: $result =~ s/(\b)$word(\b)/$1($replacement)$2/g;
1198: }
1.143 matthew 1199: return $result,sort(keys(%New_Words));
1.142 matthew 1200: }
1201:
1202: ######################################################################
1203: ######################################################################
1204:
1205: =pod
1206:
1.122 matthew 1207: =item &build_SQL_query()
1208:
1.126 matthew 1209: Builds a SQL query string from a logical expression with AND/OR keywords
1210: using Text::Query and &recursive_SQL_query_builder()
1211:
1.122 matthew 1212: =cut
1213:
1214: ######################################################################
1215: ######################################################################
1.98 harris41 1216: sub build_SQL_query {
1217: my ($field_name,$logic_statement)=@_;
1218: my $q=new Text::Query('abc',
1219: -parse => 'Text::Query::ParseAdvanced',
1220: -build => 'Text::Query::Build');
1221: $q->prepare($logic_statement);
1222: my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
1223: my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
1224: return $sql_query;
1225: }
1226:
1.122 matthew 1227: ######################################################################
1228: ######################################################################
1229:
1230: =pod
1231:
1232: =item &build_custommetadata_query()
1233:
1.126 matthew 1234: Constructs a custom metadata query using a rather heinous regular
1235: expression.
1236:
1.122 matthew 1237: =cut
1238:
1239: ######################################################################
1240: ######################################################################
1.98 harris41 1241: sub build_custommetadata_query {
1242: my ($field_name,$logic_statement)=@_;
1243: my $q=new Text::Query('abc',
1244: -parse => 'Text::Query::ParseAdvanced',
1245: -build => 'Text::Query::BuildAdvancedString');
1246: $q->prepare($logic_statement);
1247: my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
1248: # quick fix to change literal into xml tag-matching
1249: # will eventually have to write a separate builder module
1.122 matthew 1250: # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
1251: $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to
1252: /\\<$1\\>?# \<wordone\>
1253: \[\^\\<\]?# [^\<]
1254: \*$2\[\^\\<\]?# *wordtwo[^\<]
1255: \*\\<\\\/$1\\>?# *\<\/wordone\>
1256: /g;
1.98 harris41 1257: return $matchexp;
1258: }
1259:
1.122 matthew 1260: ######################################################################
1261: ######################################################################
1262:
1263: =pod
1264:
1265: =item &recursive_SQL_query_build()
1266:
1.126 matthew 1267: Recursively constructs an SQL query. Takes as input $dkey and $pattern.
1268:
1.122 matthew 1269: =cut
1270:
1271: ######################################################################
1272: ######################################################################
1.98 harris41 1273: sub recursive_SQL_query_build {
1274: my ($dkey,$pattern)=@_;
1275: my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
1276: return $pattern unless @matches;
1277: foreach my $match (@matches) {
1278: $match=~/\[ (\w+)\s(.*) \]/;
1279: my ($key,$value)=($1,$2);
1280: my $replacement='';
1281: if ($key eq 'literal') {
1282: $replacement="($dkey like \"\%$value\%\")";
1283: }
1284: elsif ($key eq 'not') {
1285: $value=~s/like/not like/;
1286: # $replacement="($dkey not like $value)";
1287: $replacement="$value";
1288: }
1289: elsif ($key eq 'and') {
1290: $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
1291: $replacement="($1 AND $2)";
1292: }
1293: elsif ($key eq 'or') {
1294: $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
1295: $replacement="($1 OR $2)";
1296: }
1297: substr($pattern,
1298: index($pattern,$match),
1299: length($match),
1300: $replacement
1301: );
1302: }
1303: &recursive_SQL_query_build($dkey,$pattern);
1304: }
1.22 harris41 1305:
1.122 matthew 1306: ######################################################################
1307: ######################################################################
1308:
1309: =pod
1310:
1311: =item &build_date_queries()
1312:
1.126 matthew 1313: Builds a SQL logic query to check time/date entries.
1314: Also reports errors (check for /^Incorrect/).
1315:
1.122 matthew 1316: =cut
1317:
1318: ######################################################################
1319: ######################################################################
1.98 harris41 1320: sub build_date_queries {
1321: my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
1322: $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
1323: my @queries;
1324: if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) {
1325: unless ($cmonth1 and $cday1 and $cyear1 and
1326: $cmonth2 and $cday2 and $cyear2) {
1327: return "Incorrect entry for the creation date. You must specify ".
1328: "a starting month, day, and year and an ending month, ".
1329: "day, and year.";
1330: }
1331: my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1);
1332: $cnumeric1+=0;
1333: my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2);
1334: $cnumeric2+=0;
1335: if ($cnumeric1>$cnumeric2) {
1336: return "Incorrect entry for the creation date. The starting ".
1337: "date must occur before the ending date.";
1338: }
1339: my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '".
1340: "$cyear2-$cmonth2-$cday2 23:59:59')";
1341: push @queries,$cquery;
1342: }
1343: if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) {
1344: unless ($lmonth1 and $lday1 and $lyear1 and
1345: $lmonth2 and $lday2 and $lyear2) {
1346: return "Incorrect entry for the last revision date. You must ".
1347: "specify a starting month, day, and year and an ending ".
1348: "month, day, and year.";
1349: }
1350: my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1);
1351: $lnumeric1+=0;
1352: my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2);
1353: $lnumeric2+=0;
1354: if ($lnumeric1>$lnumeric2) {
1355: return "Incorrect entry for the last revision date. The ".
1356: "starting date must occur before the ending date.";
1357: }
1358: my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '".
1359: "$lyear2-$lmonth2-$lday2 23:59:59')";
1360: push @queries,$lquery;
1361: }
1362: if (@queries) {
1363: return join(" AND ",@queries);
1364: }
1365: return '';
1.18 harris41 1366: }
1.6 harris41 1367:
1.122 matthew 1368: ######################################################################
1369: ######################################################################
1370:
1.144 matthew 1371: =pod
1372:
1373: =item ©right_check()
1374:
1375: =cut
1376:
1377: ######################################################################
1378: ######################################################################
1379:
1380: sub copyright_check {
1381: my $Metadata = shift;
1382: # Check copyright tags and skip results the user cannot use
1383: my (undef,undef,$resdom,$resname) = split('/',
1384: $Metadata->{'url'});
1385: # Check for priv
1386: if (($Metadata->{'copyright'} eq 'priv') &&
1387: (($ENV{'user.name'} ne $resname) &&
1388: ($ENV{'user.domain'} ne $resdom))) {
1389: return 0;
1390: }
1391: # Check for domain
1392: if (($Metadata->{'copyright'} eq 'domain') &&
1393: ($ENV{'user.domain'} ne $resdom)) {
1394: return 0;
1395: }
1396: return 1;
1397: }
1398:
1399: #####################################################################
1400: #####################################################################
1401:
1402: =pod
1403:
1404: =item MySQL Table Description
1405:
1406: MySQL table creation requires a precise description of the data to be
1407: stored. The use of the correct types to hold data is vital to efficient
1408: storage and quick retrieval of records. The columns must be described in
1409: the following format:
1410:
1411: =cut
1412:
1413: ##
1414: ## Restrictions:
1415: ## columns of type 'text' and 'blob' cannot have defaults.
1416: ## columns of type 'enum' cannot be used for FULLTEXT.
1417: ##
1418: my @DataOrder = qw/id title author subject url keywords version notes
1419: abstract mime lang owner copyright creationdate lastrevisiondate hostname
1420: idx_title idx_author idx_subject idx_abstract idx_mime idx_language
1421: idx_owner idx_copyright/;
1422:
1423: my %Datatypes =
1424: ( id =>{ type => 'INT',
1425: restrictions => 'NOT NULL',
1426: primary_key => 'yes',
1427: auto_inc => 'yes'
1428: },
1429: title =>{ type=>'TEXT'},
1430: author =>{ type=>'TEXT'},
1431: subject =>{ type=>'TEXT'},
1432: url =>{ type=>'TEXT',
1433: restrictions => 'NOT NULL' },
1434: keywords =>{ type=>'TEXT'},
1435: version =>{ type=>'TEXT'},
1436: notes =>{ type=>'TEXT'},
1437: abstract =>{ type=>'TEXT'},
1438: mime =>{ type=>'TEXT'},
1439: lang =>{ type=>'TEXT'},
1440: owner =>{ type=>'TEXT'},
1441: copyright =>{ type=>'TEXT'},
1442: hostname =>{ type=>'TEXT'},
1443: #--------------------------------------------------
1444: creationdate =>{ type=>'DATETIME'},
1445: lastrevisiondate =>{ type=>'DATETIME'},
1446: #--------------------------------------------------
1447: idx_title =>{ type=>'FULLTEXT', target=>'title'},
1448: idx_author =>{ type=>'FULLTEXT', target=>'author'},
1449: idx_subject =>{ type=>'FULLTEXT', target=>'subject'},
1450: idx_abstract =>{ type=>'FULLTEXT', target=>'abstract'},
1451: idx_mime =>{ type=>'FULLTEXT', target=>'mime'},
1452: idx_language =>{ type=>'FULLTEXT', target=>'lang'},
1453: idx_owner =>{ type=>'FULLTEXT', target=>'owner'},
1454: idx_copyright =>{ type=>'FULLTEXT', target=>'copyright'},
1455: );
1456:
1457: ######################################################################
1458: ######################################################################
1459:
1460: =pod
1461:
1462: =item &write_status()
1463:
1464: =cut
1465:
1466: ######################################################################
1467: ######################################################################
1468: sub write_status {
1469: my ($r,$string) = @_;
1470: $r->print("<pre>".$string."</pre>\n");
1471: $r->rflush();
1472: return;
1473: }
1474:
1475: ######################################################################
1476: ######################################################################
1477:
1478: =pod
1479:
1480: =item &run_search
1481:
1482: =cut
1483:
1484: ######################################################################
1485: ######################################################################
1486: sub run_search {
1487: my ($r,$query,$customquery,$customshow,$serverlist) = @_;
1488: #
1.145 ! matthew 1489: # Timing variables
! 1490: #
! 1491: my $starttime = time;
! 1492: my $max_time = 120; # seconds for the search to complete
! 1493: #
! 1494: # Determine the servers we need to contact.
! 1495: #
1.144 matthew 1496: my @Servers_to_contact;
1497: if (defined($serverlist)) {
1498: @Servers_to_contact = @$serverlist;
1499: } else {
1500: @Servers_to_contact = sort(keys(%Apache::lonnet::libserv));
1501: }
1502: my %Server_status;
1503: #
1.145 ! matthew 1504: # Create Table
1.144 matthew 1505: #
1506: my $table = &Apache::lonmysql::create_table
1507: ( { columns => \%Datatypes,
1508: column_order => \@DataOrder,
1509: } );
1510: if (! defined($table)) {
1511: # What do I do now? Print out an error page.
1512: &Apache::lonnet::logthis("lonmysql attempted to create a table ".
1513: "and this was the result:".
1514: &Apache::lonmysql::get_error());
1515: $r->print("An internal error occured with the database.<br />".
1516: "The error has been logged, but you should probably alert".
1517: " your system administrator.");
1518: return;
1519: }
1.145 ! matthew 1520: ##
! 1521: ## form.table needs to be stored in the persistent database...
! 1522: ##
1.144 matthew 1523: $ENV{'form.table'}=$table;
1524: #
1.145 ! matthew 1525: # Prepare for the big loop.
! 1526: #
1.144 matthew 1527: my $hitcountsum;
1528: my $server;
1529: my $status;
1530: while ((time - $starttime < $max_time) &&
1531: ((@Servers_to_contact) || keys(%Server_status))) {
1532: # Send out a search request if it needs to be done.
1533: if (@Servers_to_contact) {
1534: # Contact one server
1535: my $server = shift(@Servers_to_contact);
1536: my $reply=&Apache::lonnet::metadata_query($query,$customquery,
1537: $customshow,[$server]);
1538: ($server) = keys(%$reply);
1539: $Server_status{$server} = $reply->{$server};
1540: # &write_status($r,"Contacted:$server:reply:".
1541: # $Server_status{$server});
1.145 ! matthew 1542: if ($max_time - (time - $starttime) < 20) {
! 1543: # If there are less than 20 seconds to go in the search,
! 1544: # give the newly contacted servers 20 more seconds to
! 1545: # respond....
! 1546: $max_time += 20;
! 1547: }
1.144 matthew 1548: } else {
1549: sleep(1); # wait a sec. to give time for files to be written
1550: }
1551: while (my ($server,$status) = each(%Server_status)) {
1552: if ($status eq 'con_lost') {
1553: delete ($Server_status{$server});
1.145 ! matthew 1554: # &write_status($r,"server $server is not responding.");
1.144 matthew 1555: next;
1556: }
1557: $status=~/^([\.\w]+)$/;
1558: my $datafile=$r->dir_config('lonDaemons').'/tmp/'.$1;
1559: if (-e $datafile && ! -e "$datafile.end") {
1560: # Let the user know we are receiving data from the server
1.145 ! matthew 1561: # &write_status($r,"$server:Receiving file");
1.144 matthew 1562: next;
1563: }
1564: if (-e "$datafile.end") {
1565: if (-z "$datafile") {
1566: delete($Server_status{$server});
1567: next;
1568: }
1569: my $fh;
1570: if (!($fh=Apache::File->new($datafile))) {
1571: # Error opening file...
1572: # Tell the user and exit...?
1573: # Should I give up on opening it?
1.145 ! matthew 1574: &write_status("Unable to open search results file for ".
! 1575: "server $server. Omitting from search");
1.144 matthew 1576: next;
1577: }
1578: # Read in the whole file.
1579: while (my $result = <$fh>) {
1580: # handle custom fields? Someday we will!
1581: chomp($result);
1582: next unless $result;
1583: # Parse the result.
1584: my %Fields = &parse_raw_result($result,$server);
1585: $Fields{'hostname'} = $server;
1586: next if (! ©right_check(\%Fields));
1587: # Store the result in the mysql database
1588: my $result = &Apache::lonmysql::store_row($table,\%Fields);
1589: if (! defined($result)) {
1590: &write_status($r,&Apache::lonmysql::get_error());
1591: }
1592: # &write_status($r,&Apache::lonmysql::get_debug());
1593: $hitcountsum ++;
1594: } # End of foreach (@results)
1595: $fh->close();
1596: # $server is only deleted if the results file has been
1597: # found and (successfully) opened. This may be a bad idea.
1598: delete($Server_status{$server});
1.145 ! matthew 1599: #&write_status($r,"Received $new_count more results from ".
! 1600: # $server.".");
1.144 matthew 1601: }
1602: }
1603: # Finished looping through the servers
1604: }
1605: &Apache::lonmysql::disconnect_from_db();
1.145 ! matthew 1606: # Let the user know
! 1607: #
1.144 matthew 1608: # We have run out of time or run out of servers to talk to and
1609: # results to get.
1.145 ! matthew 1610: &write_status($r,"Search completed.");
! 1611: if ($hitcountsum) {
! 1612: &write_status($r,$hitcountsum." successful matches to your query.");
! 1613: } else {
! 1614: &write_status($r,"There were no successful matches to your query.");
1.144 matthew 1615: }
1616: return;
1617: }
1618:
1619: ######################################################################
1620: ######################################################################
1621: =pod
1622:
1623: =item &display_buttons
1624:
1625: =cut
1626:
1627: ######################################################################
1628: ######################################################################
1629: sub display_buttons {
1.145 ! matthew 1630: my ($current_min,$show,$total,$parms) = @_;
! 1631: return '' if ($show eq 'all'); # No links if you get them all at once.
! 1632: my $links;
! 1633: ##
! 1634: ## Prev
! 1635: my $prev_min = $current_min - $show;
! 1636: $prev_min = 0 if $prev_min < 0;
! 1637: if ($prev_min < $current_min) {
! 1638: $links .= qq{
! 1639: <a href="/adm/searchcat?$parms&startwith=$prev_min&show=$show">prev</a>
! 1640: };
! 1641: }
! 1642: ##
! 1643: ## Pages.... Someday.
! 1644: ##
! 1645:
! 1646: ##
! 1647: ## Next
! 1648: my $next_min = $current_min + $show;
! 1649: my $next_min = $current_min if ($next_min > $total);
! 1650: if ($next_min != $current_min) {
! 1651: $links .= qq{
! 1652: <a href="/adm/searchcat?$parms&startwith=$next_min&show=$show">next</a>
! 1653: };
1.144 matthew 1654: }
1.145 ! matthew 1655: return $links;
1.144 matthew 1656: }
1657: ######################################################################
1658: ######################################################################
1659:
1660: =pod
1661:
1662: =item &display_results
1663:
1664: =cut
1665:
1666: ######################################################################
1667: ######################################################################
1668: sub display_results {
1.145 ! matthew 1669: my ($r,$mode,$importbutton,$closebutton) = @_;
1.144 matthew 1670: ##
1671: ## Set viewing function
1672: ##
1673: my $viewfunction = $Views{$ENV{'form.viewselect'}};
1674: if (!defined($viewfunction)) {
1675: $r->print("Internal Error - Bad view selected.\n");
1676: $r->rflush();
1677: return;
1678: }
1679: ##
1680: ## Get the catalog controls setup
1681: ##
1682: my $action = "/adm/searchcat";
1683: if ($mode eq 'Basic') {
1684: $action .= "?reqinterface=basic";
1685: } elsif ($mode eq 'Advanced') {
1686: $action .= "?reqinterface=advanced";
1687: }
1688: $r->print(<<CATALOGCONTROLS);
1689: <form name='results' method="post" action="$action">
1.145 ! matthew 1690: $hidden_fields
1.144 matthew 1691: <input type='hidden' name='acts' value='' />
1692: <input type='button' value='Revise search request'
1693: onClick='this.form.submit();' />
1694: $importbutton
1695: $closebutton
1696: <hr />
1697: CATALOGCONTROLS
1698: if (! tie(%groupsearch_db,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
1699: $r->print('Unable to tie hash to db file</body></html>');
1700: $r->rflush();
1701: return;
1702: }
1.145 ! matthew 1703: ##
! 1704: ## Prepare the table for querying
! 1705: ##
1.144 matthew 1706: my $table = $ENV{'form.table'};
1707: my $connection_result = &Apache::lonmysql::connect_to_db();
1708: if (!defined($connection_result)) {
1709: &write_status($r,&Apache::lonmysql::get_error());
1710: }
1.145 ! matthew 1711: my $table_check = &Apache::lonmysql::check_table($table);
! 1712: if (! defined($table_check)) {
! 1713: $r->print("A MySQL error has occurred.</body></html>");
! 1714: &Apache::lonnet::logthis("lonmysql was unable to determine the status".
! 1715: " of table ".$table);
! 1716: return;
! 1717: } elsif (! $table_check) {
! 1718: $r->print("The table of results could not be found.");
! 1719: &Apache::lonnet::logthis("The user requested a table, ".$table.
! 1720: ", that could not be found.");
! 1721: return;
! 1722: }
! 1723: ##
! 1724: ## Get the number of results
! 1725: ##
! 1726: my $total_results = &Apache::lonmysql::number_of_rows($table);
! 1727: if (! defined($total_results)) {
! 1728: $r->print("A MySQL error has occurred.</body></html>");
! 1729: &Apache::lonnet::logthis("lonmysql was unable to determine the number".
! 1730: " of rows in table ".$table);
! 1731: &Apache::lonnet::logthis(&Apache::lonmysql::get_error());
! 1732: &Apache::lonnet::logthis(&Apache::lonmysql::get_debug());
! 1733: return;
! 1734: }
! 1735: if ($total_results == 0) {
! 1736: $r->print("There were no results matching your query.\n".
! 1737: "</form></body></html>");
! 1738: return;
! 1739: }
! 1740: ##
! 1741: ## Determine how many results we need to get
! 1742: ##
! 1743: $ENV{'form.startwith'} = 0 if (! exists($ENV{'form.startwith'}));
! 1744: $ENV{'form.show'} = 'all' if (! exists($ENV{'form.show'}));
! 1745: my $min = $ENV{'form.startwith'};
! 1746: my $max;
! 1747: if ($ENV{'form.show'} eq 'all') {
! 1748: $max = $total_results ;
! 1749: } else {
! 1750: $max = $min + $ENV{'form.show'};
! 1751: }
! 1752: ##
! 1753: ## Output links (if necessary) for 'prev' and 'next' pages.
! 1754: ##
! 1755:
! 1756: ##
! 1757: ## Get results from MySQL table
! 1758: ##
! 1759: my @Results = &Apache::lonmysql::get_rows($table,
! 1760: 'id>'.$min.' AND id<='.$max);
! 1761: ##
! 1762: ## Loop through the results and output them.
! 1763: ##
1.144 matthew 1764: foreach my $row (@Results) {
1765: my %Fields = %{&parse_row(@$row)};
1.145 ! matthew 1766: my $output="<p>\n";
! 1767: $output.=&catalogmode_output($Fields{'title'},$Fields{'url'});
1.144 matthew 1768: # Render the result into html
1769: $output.= &$viewfunction(%Fields);
1.145 ! matthew 1770: $output.="</p>\n<hr align='left' width='200' noshade />";
! 1771: # Print them out as they come in.
1.144 matthew 1772: $r->print($output);
1773: $r->rflush();
1774: }
1775: if (@Results < 1) {
1776: $r->print("There were no results matching your query");
1777: }
1778: $r->print("</body></html>");
1779: $r->rflush();
1780: untie %groupsearch_db;
1781: return;
1782: }
1783:
1784: ######################################################################
1785: ######################################################################
1786:
1787: =pod
1788:
1.145 ! matthew 1789: =item &catalogmode_output($title,$url)
! 1790:
! 1791: Returns html needed for the various catalog modes. Gets inputs from
! 1792: $ENV{'form.catalogmode'}. Stores data in %groupsearch_db and $fnum
! 1793: (local variable).
! 1794:
! 1795: =cut
! 1796:
! 1797: ######################################################################
! 1798: ######################################################################
! 1799: {
! 1800: my $fnum;
! 1801:
! 1802: sub catalogmode_output {
! 1803: my $output = '';
! 1804: my ($title,$url) = @_;
! 1805: if ($ENV{'form.catalogmode'} eq 'interactive') {
! 1806: $title=~ s/\'/\\'/g; # ' Escape single quotes.
! 1807: if ($ENV{'form.catalogmode'} eq 'interactive') {
! 1808: $output.=<<END
! 1809: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
! 1810: onClick="javascript:select_data('$title','$url')">
! 1811: </font>
! 1812: END
! 1813: }
! 1814: }
! 1815: if ($ENV{'form.catalogmode'} eq 'groupsearch') {
! 1816: $fnum+=0;
! 1817: $groupsearch_db{"pre_${fnum}_link"}=$url;
! 1818: $groupsearch_db{"pre_${fnum}_title"}=$title;
! 1819: $output.=<<END;
! 1820: <font size='-1'>
! 1821: <input type="checkbox" name="returnvalues" value="SELECT"
! 1822: onClick="javascript:queue($fnum)" />
! 1823: </font>
! 1824: END
! 1825: $fnum++;
! 1826: }
! 1827: return $output;
! 1828: }
! 1829:
! 1830: }
! 1831: ######################################################################
! 1832: ######################################################################
! 1833:
! 1834: =pod
! 1835:
1.144 matthew 1836: =item &parse_row
1837:
1838: Parse a row returned from the database.
1839:
1840: =cut
1841:
1842: ######################################################################
1843: ######################################################################
1844: sub parse_row {
1845: my @Row = @_;
1846: my %Fields;
1847: for (my $i=0;$i<=$#Row;$i++) {
1848: $Fields{$DataOrder[$i]}=&Apache::lonnet::unescape($Row[$i]);
1849: }
1850: $Fields{'language'} =
1851: &Apache::loncommon::languagedescription($Fields{'lang'});
1852: $Fields{'copyrighttag'} =
1853: &Apache::loncommon::copyrightdescription($Fields{'copyright'});
1854: $Fields{'mimetag'} =
1855: &Apache::loncommon::filedescription($Fields{'mime'});
1856: return \%Fields;
1857: }
1.126 matthew 1858:
1859: ###########################################################
1860: ###########################################################
1861:
1862: =pod
1863:
1864: =item &parse_raw_result()
1865:
1866: Takes a line from the file of results and parse it. Returns a hash
1867: with keys for the following fields:
1868: 'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes',
1869: 'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate',
1870: 'lastrevisiondate'.
1871:
1872: In addition, the following tags are set by calling the appropriate
1873: lonnet function: 'language', 'cprtag', 'mimetag'.
1874:
1875: The 'title' field is set to "Untitled" if the title field is blank.
1876:
1877: 'abstract' and 'keywords' are truncated to 200 characters.
1878:
1879: =cut
1880:
1881: ###########################################################
1882: ###########################################################
1883: sub parse_raw_result {
1884: my ($result,$hostname) = @_;
1885: # Check for a comma - if it is there then we do not need to unescape the
1886: # string. There seems to be some kind of problem with some items in
1887: # the database - the entire string gets sent out unescaped...?
1888: unless ($result =~ /,/) {
1889: $result = &Apache::lonnet::unescape($result);
1890: }
1891: my @fields=map {
1892: &Apache::lonnet::unescape($_);
1893: } (split(/\,/,$result));
1894: my ($title,$author,$subject,$url,$keywords,$version,
1895: $notes,$abstract,$mime,$lang,
1896: $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
1897: my %Fields =
1898: ( title => &Apache::lonnet::unescape($title),
1899: author => &Apache::lonnet::unescape($author),
1900: subject => &Apache::lonnet::unescape($subject),
1901: url => &Apache::lonnet::unescape($url),
1902: keywords => &Apache::lonnet::unescape($keywords),
1903: version => &Apache::lonnet::unescape($version),
1904: notes => &Apache::lonnet::unescape($notes),
1905: abstract => &Apache::lonnet::unescape($abstract),
1906: mime => &Apache::lonnet::unescape($mime),
1907: lang => &Apache::lonnet::unescape($lang),
1908: owner => &Apache::lonnet::unescape($owner),
1909: copyright => &Apache::lonnet::unescape($copyright),
1910: creationdate => &Apache::lonnet::unescape($creationdate),
1911: lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate)
1912: );
1913: $Fields{'language'} =
1914: &Apache::loncommon::languagedescription($Fields{'lang'});
1915: $Fields{'copyrighttag'} =
1916: &Apache::loncommon::copyrightdescription($Fields{'copyright'});
1917: $Fields{'mimetag'} =
1918: &Apache::loncommon::filedescription($Fields{'mime'});
1.134 matthew 1919: if ($Fields{'author'}=~/^(\s*|error)$/) {
1920: $Fields{'author'}="Unknown Author";
1921: }
1.126 matthew 1922: # Put spaces in the keyword list, if needed.
1923: $Fields{'keywords'}=~ s/,([A-z])/, $1/g;
1924: if ($Fields{'title'}=~ /^\s*$/ ) {
1925: $Fields{'title'}='Untitled';
1926: }
1927: unless ($ENV{'user.adv'}) {
1.144 matthew 1928: # What is this anyway?
1.126 matthew 1929: $Fields{'keywords'} = '- not displayed -';
1930: $Fields{'notes'} = '- not displayed -';
1931: $Fields{'abstract'} = '- not displayed -';
1932: $Fields{'subject'} = '- not displayed -';
1933: }
1934: if (length($Fields{'abstract'})>200) {
1935: $Fields{'abstract'} =
1936: substr($Fields{'abstract'},0,200).'...';
1937: }
1938: if (length($Fields{'keywords'})>200) {
1939: $Fields{'keywords'} =
1940: substr($Fields{'keywords'},0,200).'...';
1941: }
1942: return %Fields;
1943: }
1944:
1945: ###########################################################
1946: ###########################################################
1947:
1948: =pod
1949:
1950: =item &handle_custom_fields()
1951:
1952: =cut
1953:
1954: ###########################################################
1955: ###########################################################
1956: sub handle_custom_fields {
1957: my @results = @{shift()};
1958: my $customshow='';
1959: my $extrashow='';
1960: my @customfields;
1961: if ($ENV{'form.customshow'}) {
1962: $customshow=$ENV{'form.customshow'};
1963: $customshow=~s/[^\w\s]//g;
1964: my @fields=map {
1965: "<font color=\"#008000\">$_:</font><!-- $_ -->";
1966: } split(/\s+/,$customshow);
1967: @customfields=split(/\s+/,$customshow);
1968: if ($customshow) {
1969: $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
1970: }
1971: }
1972: my $customdata='';
1973: my %customhash;
1974: foreach my $result (@results) {
1975: if ($result=~/^(custom\=.*)$/) { # grab all custom metadata
1976: my $tmp=$result;
1977: $tmp=~s/^custom\=//;
1978: my ($k,$v)=map {&Apache::lonnet::unescape($_);
1979: } split(/\,/,$tmp);
1980: $customhash{$k}=$v;
1981: }
1982: }
1983: return ($extrashow,\@customfields,\%customhash);
1.41 harris41 1984: }
1985:
1.122 matthew 1986: ######################################################################
1987: ######################################################################
1988:
1.125 matthew 1989: =pod
1990:
1991: =item &search_results_header
1992:
1.130 matthew 1993: Output the proper html headers and javascript code to deal with different
1994: calling modes.
1995:
1996: Takes most inputs directly from %ENV, except $mode.
1997:
1998: =over 4
1999:
2000: =item $mode is either (at this writing) 'Basic' or 'Advanced'
2001:
2002: =back
1.126 matthew 2003:
1.130 matthew 2004: The following environment variables are checked:
1.126 matthew 2005:
2006: =over 4
2007:
2008: =item 'form.catalogmode'
2009:
2010: Checked for 'interactive' and 'groupsearch'.
2011:
2012: =item 'form.mode'
2013:
2014: Checked for existance & 'edit' mode.
2015:
2016: =item 'form.form'
2017:
2018: =item 'form.element'
2019:
2020: =back
2021:
1.125 matthew 2022: =cut
2023:
2024: ######################################################################
2025: ######################################################################
2026: sub search_results_header {
1.143 matthew 2027: my ($mode,$pretty_query) = @_;
1.130 matthew 2028: $mode = lc($mode);
2029: my $title;
2030: if ($mode eq 'advanced') {
2031: $title = "Advanced Search Results";
2032: } elsif ($mode eq 'basic') {
2033: $title = "Basic Search Results";
2034: }
1.125 matthew 2035: my $result = '';
2036: # output beginning of search page
2037: $result.=<<BEGINNING;
2038: <html>
2039: <head>
1.130 matthew 2040: <title>$title</title>
1.125 matthew 2041: BEGINNING
2042: # conditional output of script functions dependent on the mode in
2043: # which the search was invoked
2044: if ($ENV{'form.catalogmode'} eq 'interactive'){
2045: if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') {
2046: $result.=<<SCRIPT;
2047: <script type="text/javascript">
2048: function select_data(title,url) {
2049: changeTitle(title);
2050: changeURL(url);
2051: self.close();
2052: }
2053: function changeTitle(val) {
2054: if (opener.inf.document.forms.resinfo.elements.t) {
2055: opener.inf.document.forms.resinfo.elements.t.value=val;
2056: }
2057: }
2058: function changeURL(val) {
2059: if (opener.inf.document.forms.resinfo.elements.u) {
2060: opener.inf.document.forms.resinfo.elements.u.value=val;
2061: }
2062: }
2063: </script>
2064: SCRIPT
2065: } elsif ($ENV{'form.mode'} eq 'edit') {
2066: my $form = $ENV{'form.form'};
2067: my $element = $ENV{'form.element'};
2068: $result.=<<SCRIPT;
2069: <script type="text/javascript">
2070: function select_data(title,url) {
2071: changeURL(url);
2072: self.close();
2073: }
2074: function changeTitle(val) {
2075: }
2076: function changeURL(val) {
2077: if (window.opener.document) {
2078: window.opener.document.forms["$form"].elements["$element"].value=val;
2079: } else {
2080: var url = 'forms[\"$form\"].elements[\"$element\"].value';
2081: alert("Unable to transfer data to "+url);
2082: }
2083: }
2084: </script>
2085: SCRIPT
2086: }
2087: }
2088: $result.=<<SCRIPT if $ENV{'form.catalogmode'} eq 'groupsearch';
2089: <script type="text/javascript">
2090: function select_data(title,url) {
2091: // alert('DEBUG: Should be storing '+title+' and '+url);
2092: }
2093: function queue(val) {
2094: if (eval("document.forms.results.returnvalues["+val+"].checked")) {
2095: document.forms.results.acts.value+='1a'+val+'b';
2096: }
2097: else {
2098: document.forms.results.acts.value+='0a'+val+'b';
2099: }
2100: }
2101: function select_group() {
2102: window.location=
2103: "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+
2104: document.forms.results.acts.value;
2105: }
2106: </script>
2107: SCRIPT
2108: $result.=<<SCRIPT;
2109: <script type="text/javascript">
2110: function displayinfo(val) {
2111: popwin.document.forms.popremain.sdetails.value=val;
2112: }
2113: function openhelp(val) {
2114: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
2115: 'scrollbars=1,width=400,height=300');
2116: openhelpwin.focus();
2117: }
2118: function abortsearch(val) {
2119: popwin.close();
2120: }
2121: </script>
2122: SCRIPT
1.130 matthew 2123: $result.=<<END;
2124: </head>
2125: <body bgcolor="#ffffff">
2126: <img align=right src=/adm/lonIcons/lonlogos.gif>
2127: <h1>$title</h1>
2128: END
1.143 matthew 2129: if ($pretty_query) {
2130: $result .= "<p>Search query: $pretty_query</p>";
2131: }
1.125 matthew 2132: return $result;
2133: }
2134:
2135: ######################################################################
2136: ######################################################################
2137:
1.122 matthew 2138: =pod
2139:
2140: =item Metadata Viewing Functions
2141:
2142: Output is a HTML-ified string.
2143: Input arguments are title, author, subject, url, keywords, version,
2144: notes, short abstract, mime, language, creation date,
1.126 matthew 2145: last revision date, owner, copyright, hostname, and
1.122 matthew 2146: extra custom metadata to show.
2147:
2148: =over 4
2149:
2150: =item &detailed_citation_view()
2151:
2152: =cut
2153:
2154: ######################################################################
2155: ######################################################################
1.50 harris41 2156: sub detailed_citation_view {
1.126 matthew 2157: my %values = @_;
1.50 harris41 2158: my $result=<<END;
1.126 matthew 2159: <h3><a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
2160: target='search_preview'>$values{'title'}</a></h3>
1.56 harris41 2161: <p>
1.130 matthew 2162: <b>$values{'author'}</b>, <i>$values{'owner'}</i><br />
2163:
2164: <b>Subject: </b> $values{'subject'}<br />
2165: <b>Keyword(s): </b> $values{'keywords'}<br />
2166: <b>Notes: </b> $values{'notes'}<br />
2167: <b>MIME Type: </b> $values{'mimetag'}<br />
2168: <b>Language: </b> $values{'language'}<br />
2169: <b>Copyright/Distribution:</b> $values{'cprtag'}<br />
1.78 harris41 2170: </p>
1.126 matthew 2171: $values{'extrashow'}
1.78 harris41 2172: <p>
1.126 matthew 2173: $values{'shortabstract'}
1.50 harris41 2174: </p>
2175: END
2176: return $result;
2177: }
2178:
1.122 matthew 2179: ######################################################################
2180: ######################################################################
2181:
2182: =pod
2183:
2184: =item &summary_view()
2185:
2186: =cut
2187:
2188: ######################################################################
2189: ######################################################################
1.50 harris41 2190: sub summary_view {
1.126 matthew 2191: my %values = @_;
1.50 harris41 2192: my $result=<<END;
1.126 matthew 2193: <a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
2194: target='search_preview'>$values{'author'}</a><br />
2195: $values{'title'}<br />
2196: $values{'owner'} -- $values{'lastrevisiondate'}<br />
2197: $values{'copyrighttag'}<br />
2198: $values{'extrashow'}
1.50 harris41 2199: </p>
2200: END
2201: return $result;
2202: }
2203:
1.122 matthew 2204: ######################################################################
2205: ######################################################################
2206:
2207: =pod
2208:
2209: =item &fielded_format_view()
2210:
2211: =cut
2212:
2213: ######################################################################
2214: ######################################################################
1.50 harris41 2215: sub fielded_format_view {
1.126 matthew 2216: my %values = @_;
1.50 harris41 2217: my $result=<<END;
1.126 matthew 2218: <b>URL: </b> <a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
2219: target='search_preview'>$values{'url'}</a>
1.56 harris41 2220: <br />
1.126 matthew 2221: <b>Title:</b> $values{'title'}<br />
2222: <b>Author(s):</b> $values{'author'}<br />
2223: <b>Subject:</b> $values{'subject'}<br />
2224: <b>Keyword(s):</b> $values{'keywords'}<br />
2225: <b>Notes:</b> $values{'notes'}<br />
2226: <b>MIME Type:</b> $values{'mimetag'}<br />
2227: <b>Language:</b> $values{'language'}<br />
2228: <b>Creation Date:</b> $values{'creationdate'}<br />
2229: <b>Last Revision Date:</b> $values{'lastrevisiondate'}<br />
2230: <b>Publisher/Owner:</b> $values{'owner'}<br />
2231: <b>Copyright/Distribution:</b> $values{'copyrighttag'}<br />
2232: <b>Repository Location:</b> $values{'hostname'}<br />
2233: <b>Abstract:</b> $values{'shortabstract'}<br />
2234: $values{'extrashow'}
1.50 harris41 2235: </p>
2236: END
2237: return $result;
2238: }
2239:
1.122 matthew 2240: ######################################################################
2241: ######################################################################
2242:
2243: =pod
2244:
2245: =item &xml_sgml_view()
2246:
2247: =back
2248:
2249: =cut
2250:
2251: ######################################################################
2252: ######################################################################
1.50 harris41 2253: sub xml_sgml_view {
1.126 matthew 2254: my %values = @_;
1.50 harris41 2255: my $result=<<END;
1.56 harris41 2256: <pre>
2257: <LonCapaResource>
1.126 matthew 2258: <url>$values{'url'}</url>
2259: <title>$values{'title'}</title>
2260: <author>$values{'author'}</author>
2261: <subject>$values{'subject'}</subject>
2262: <keywords>$values{'keywords'}</keywords>
2263: <notes>$values{'notes'}</notes>
1.56 harris41 2264: <mimeInfo>
1.126 matthew 2265: <mime>$values{'mime'}</mime>
2266: <mimetag>$values{'mimetag'}</mimetag>
1.56 harris41 2267: </mimeInfo>
2268: <languageInfo>
1.126 matthew 2269: <language>$values{'lang'}</language>
2270: <languagetag>$values{'language'}</languagetag>
1.56 harris41 2271: </languageInfo>
1.126 matthew 2272: <creationdate>$values{'creationdate'}</creationdate>
2273: <lastrevisiondate>$values{'lastrevisiondate'}</lastrevisiondate>
2274: <owner>$values{'owner'}</owner>
1.56 harris41 2275: <copyrightInfo>
1.126 matthew 2276: <copyright>$values{'copyright'}</copyright>
2277: <copyrighttag>$values{'copyrighttag'}</copyrighttag>
1.56 harris41 2278: </copyrightInfo>
1.126 matthew 2279: <repositoryLocation>$values{'hostname'}</repositoryLocation>
2280: <shortabstract>$values{'shortabstract'}</shortabstract>
1.57 harris41 2281: </LonCapaResource>
1.56 harris41 2282: </pre>
1.126 matthew 2283: $values{'extrashow'}
1.50 harris41 2284: END
2285: return $result;
1.60 harris41 2286: }
2287:
1.122 matthew 2288: ######################################################################
2289: ######################################################################
2290:
2291: =pod
2292:
2293: =item &filled() see if field is filled.
2294:
2295: =cut
2296:
2297: ######################################################################
2298: ######################################################################
1.98 harris41 2299: sub filled {
2300: my ($field)=@_;
2301: if ($field=~/\S/ && $field ne 'any') {
2302: return 1;
1.61 harris41 2303: }
1.98 harris41 2304: else {
2305: return 0;
1.61 harris41 2306: }
1.60 harris41 2307: }
2308:
1.122 matthew 2309: ######################################################################
2310: ######################################################################
2311:
2312: =pod
2313:
2314: =item &output_blank_field_error()
2315:
2316: =cut
2317:
2318: ######################################################################
2319: ######################################################################
1.98 harris41 2320: sub output_blank_field_error {
1.145 ! matthew 2321: my ($r,$closebutton)=@_;
1.98 harris41 2322: # make query information persistent to allow for subsequent revision
2323: $r->print(<<BEGINNING);
2324: <html>
2325: <head>
2326: <title>The LearningOnline Network with CAPA</title>
2327: BEGINNING
2328: $r->print(<<RESULTS);
2329: </head>
2330: <body bgcolor="#ffffff">
2331: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
2332: <h1>Search Catalog</h1>
2333: <form method="post" action="/adm/searchcat">
1.145 ! matthew 2334: $hidden_fields
1.98 harris41 2335: <input type='button' value='Revise search request'
2336: onClick='this.form.submit();' />
2337: $closebutton
2338: <hr />
2339: <h3>Helpful Message</h3>
2340: <p>
2341: Incorrect search query due to blank entry fields.
2342: You need to fill in the relevant
2343: fields on the search page in order for a query to be
2344: processed.
2345: </p>
2346: </body>
2347: </html>
2348: RESULTS
2349: }
2350:
1.122 matthew 2351: ######################################################################
2352: ######################################################################
2353:
2354: =pod
2355:
2356: =item &output_date_error()
2357:
2358: Output a full html page with an error message.
2359:
1.145 ! matthew 2360: Inputs:
! 2361:
! 2362: $r, the request pointer.
! 2363: $message, the error message for the user.
! 2364: $closebutton, the specialized close button needed for groupsearch.
! 2365:
1.122 matthew 2366: =cut
2367:
2368: ######################################################################
2369: ######################################################################
1.60 harris41 2370: sub output_date_error {
1.145 ! matthew 2371: my ($r,$message,$closebutton)=@_;
1.60 harris41 2372: # make query information persistent to allow for subsequent revision
1.122 matthew 2373: $r->print(<<RESULTS);
1.60 harris41 2374: <html>
2375: <head>
2376: <title>The LearningOnline Network with CAPA</title>
2377: </head>
2378: <body bgcolor="#ffffff">
1.98 harris41 2379: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
1.60 harris41 2380: <h1>Search Catalog</h1>
2381: <form method="post" action="/adm/searchcat">
1.145 ! matthew 2382: $hidden_fields
1.60 harris41 2383: <input type='button' value='Revise search request'
1.98 harris41 2384: onClick='this.form.submit();' />
1.60 harris41 2385: $closebutton
1.98 harris41 2386: <hr />
1.60 harris41 2387: <h3>Helpful Message</h3>
2388: <p>
2389: $message
2390: </p>
2391: </body>
2392: </html>
2393: RESULTS
1.101 harris41 2394: }
2395:
1.122 matthew 2396: ######################################################################
2397: ######################################################################
2398:
2399: =pod
2400:
2401: =item &start_fresh_session()
2402:
1.142 matthew 2403: Cleans the global %groupsearch_db by removing all fields which begin with
1.122 matthew 2404: 'pre_' or 'store'.
2405:
2406: =cut
2407:
2408: ######################################################################
2409: ######################################################################
1.101 harris41 2410: sub start_fresh_session {
1.142 matthew 2411: delete $groupsearch_db{'mode_catalog'};
2412: foreach (keys %groupsearch_db) {
1.101 harris41 2413: if ($_ =~ /^pre_/) {
1.142 matthew 2414: delete $groupsearch_db{$_};
1.101 harris41 2415: }
2416: if ($_ =~ /^store/) {
1.142 matthew 2417: delete $groupsearch_db{$_};
1.101 harris41 2418: }
1.109 harris41 2419: }
1.3 harris41 2420: }
1.1 www 2421:
2422: 1;
1.98 harris41 2423:
1.1 www 2424: __END__
1.105 harris41 2425:
1.121 matthew 2426: =pod
1.105 harris41 2427:
1.121 matthew 2428: =back
1.105 harris41 2429:
2430: =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