Annotation of loncom/interface/lonsearchcat.pm, revision 1.140
1.98 harris41 1: # The LearningOnline Network with CAPA
1.108 harris41 2: # Search Catalog
3: #
1.140 ! matthew 4: # $Id: lonsearchcat.pm,v 1.139 2002/07/08 20:35: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.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.101 harris41 90: use GDBM_File;
1.112 harris41 91: use Apache::loncommon();
1.1 www 92:
1.90 harris41 93: # ---------------------------------------- variables used throughout the module
94:
1.121 matthew 95: ######################################################################
96: ######################################################################
97:
98: =pod
99:
100: =item Global variables
101:
102: =over 4
103:
104: =item $closebutton
105:
106: button that closes the search window
107:
108: =item $importbutton
109:
1.134 matthew 110: button to take the select results and go to group sorting
1.121 matthew 111:
112: =item %hash
113:
114: The ubiquitous database hash
115:
116: =item $diropendb
117:
118: The full path to the (temporary) search database file. This is set and
119: used in &handler() and is also used in &output_results().
120:
1.139 matthew 121: =item %Views
122:
123: Hash which associates an output view description with the function
124: that produces it. Adding a new view type should be as easy as
125: adding a line to the definition of this hash and making sure the function
126: takes the proper parameters.
127:
1.121 matthew 128: =back
129:
130: =cut
131:
132: ######################################################################
133: ######################################################################
134:
1.98 harris41 135: # -- dynamically rendered interface components
1.121 matthew 136: my $closebutton; # button that closes the search window
1.98 harris41 137: my $importbutton; # button to take the selected results and go to group sorting
138:
139: # -- miscellaneous variables
1.121 matthew 140: my %hash; # database hash
1.127 matthew 141: my $diropendb = ""; # db file
1.98 harris41 142:
1.139 matthew 143: # View Description Function Pointer
144: my %Views = ("Detailed Citation View" => \&detailed_citation_view,
145: "Summary View" => \&summary_view,
146: "Fielded Format" => \&fielded_format_view,
147: "XML/SGML" => \&xml_sgml_view );
148:
1.121 matthew 149: ######################################################################
150: ######################################################################
151:
152: =pod
153:
154: =item &handler() - main handler invoked by httpd child
155:
1.124 matthew 156: =item Variables
157:
158: =over 4
159:
160: =item $hidden
161:
162: holds 'hidden' html forms
163:
164: =item $scrout
165:
166: string that holds portions of the screen output
167:
168: =back
169:
1.121 matthew 170: =cut
1.101 harris41 171:
1.121 matthew 172: ######################################################################
173: ######################################################################
1.98 harris41 174: sub handler {
175: my $r = shift;
1.103 harris41 176: untie %hash;
1.98 harris41 177:
178: $r->content_type('text/html');
179: $r->send_http_header;
180: return OK if $r->header_only;
181:
1.121 matthew 182: my $domain = $r->dir_config('lonDefDomain');
1.122 matthew 183: $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain).
184: "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db";
1.101 harris41 185:
1.116 matthew 186: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.124 matthew 187: ['catalogmode','launch','acts','mode','form','element',
188: 'reqinterface']);
189: ##
190: ## Clear out old values from database
191: ##
1.101 harris41 192: if ($ENV{'form.launch'} eq '1') {
193: if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
194: &start_fresh_session();
195: untie %hash;
1.122 matthew 196: } else {
1.101 harris41 197: $r->print('<html><head></head><body>Unable to tie hash to db '.
198: 'file</body></html>');
199: return OK;
200: }
201: }
1.124 matthew 202: ##
203: ## Produce some output, so people know it is working
204: ##
1.119 www 205: $r->print("\n");
206: $r->rflush;
1.124 matthew 207: ##
208: ## Configure dynamic components of interface
209: ##
210: my $hidden; # Holds 'hidden' html forms
1.98 harris41 211: if ($ENV{'form.catalogmode'} eq 'interactive') {
212: $hidden="<input type='hidden' name='catalogmode' value='interactive'>".
213: "\n";
214: $closebutton="<input type='button' name='close' value='CLOSE' ".
215: "onClick='self.close()'>"."\n";
1.124 matthew 216: } elsif ($ENV{'form.catalogmode'} eq 'groupsearch') {
1.98 harris41 217: $hidden=<<END;
218: <input type='hidden' name='catalogmode' value='groupsearch'>
219: END
220: $closebutton=<<END;
221: <input type='button' name='close' value='CLOSE' onClick='self.close()'>
222: END
223: $importbutton=<<END;
224: <input type='button' name='import' value='IMPORT'
225: onClick='javascript:select_group()'>
226: END
227: }
1.133 matthew 228: $hidden .= &make_persistent({ "form.mode" => $ENV{'form.mode'},
229: "form.form" => $ENV{'form.form'},
230: "form.element" => $ENV{'form.element'},
231: "form.date" => 2 });
1.124 matthew 232: ##
233: ## What are we doing?
234: ##
1.134 matthew 235: my $searchtype;
236: $searchtype = 'Basic' if ($ENV{'form.basicsubmit'} eq 'SEARCH');
237: $searchtype = 'Advanced' if ($ENV{'form.advancedsubmit'} eq 'SEARCH');
238: if ($searchtype) {
1.139 matthew 239: # We are running a search
1.134 matthew 240: my ($query,$customquery,$customshow,$libraries) =
241: (undef,undef,undef,undef);
242: if ($searchtype eq 'Basic') {
243: $query = &parse_basic_search($r);
244: } elsif ($ENV{'form.advancedsubmit'} eq 'SEARCH') {
245: ($query,$customquery,$customshow,$libraries)
246: = &parse_advanced_search($r);
247: return OK if (! defined($query));
248: }
249: # Send query statements over the network to be processed by
250: # either the SQL database or a recursive scheme of 'grep'-like
251: # actions (for custom metadata).
252: $r->rflush();
253: my $reply=&Apache::lonnet::metadata_query($query,$customquery,
254: $customshow,$libraries);
255: &output_results($searchtype,$r,$reply,$hidden);
1.139 matthew 256: } else {
257: #
258: # We need to get information to search on
259: #
260: # Set the default view if it is not already set.
261: if (!defined($ENV{'form.viewselect'})) {
262: $ENV{'form.viewselect'} ="Detailed Citation View";
263: }
1.124 matthew 264: # Output the advanced interface
1.139 matthew 265: if ($ENV{'form.reqinterface'} eq 'advanced') {
266: $r->print(&advanced_search_form($closebutton,$hidden));
267: } else {
268: # Output normal search interface
269: $r->print(&basic_search_form($closebutton,$hidden));
270: }
1.124 matthew 271: }
272: return OK;
273: }
1.98 harris41 274:
1.124 matthew 275: ######################################################################
276: ######################################################################
277:
278: =pod
279:
280: =item &basic_search_form()
281:
282: Returns a scalar which holds html for the basic search form.
283:
284: =cut
285:
286: ######################################################################
287: ######################################################################
1.3 harris41 288:
1.124 matthew 289: sub basic_search_form{
290: my ($closebutton,$hidden) = @_;
291: my $scrout=<<"ENDDOCUMENT";
292: <html>
293: <head>
294: <title>The LearningOnline Network with CAPA</title>
295: <script type="text/javascript">
296: function openhelp(val) {
297: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
298: 'scrollbars=1,width=600,height=300');
299: openhelpwin.focus();
1.6 harris41 300: }
1.124 matthew 301: </script>
302: </head>
303: <body bgcolor="#FFFFFF">
304: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
305: <h1>Search Catalog</h1>
306: <form method="post" action="/adm/searchcat">
307: $hidden
308: <h3>Basic Search</h3>
309: <p>
1.131 matthew 310: Enter terms or phrases separated by AND, OR, or NOT
1.129 matthew 311: then press SEARCH below.
1.124 matthew 312: </p>
313: <p>
314: <table>
315: <tr><td>
316: ENDDOCUMENT
317: $scrout.=' '.&simpletextfield('basicexp',$ENV{'form.basicexp'},40).
318: ' ';
319: # $scrout.=&simplecheckbox('allversions',$ENV{'form.allversions'});
320: # $scrout.='<font color="#800000">Search historic archives</font>';
1.139 matthew 321: $scrout.=<<END;
1.124 matthew 322: </td><td><a href="/adm/searchcat?reqinterface=advanced">Advanced Search</a></td></tr></table>
323: </p>
324: <p>
325: <input type="submit" name="basicsubmit" value='SEARCH' />
326: $closebutton
1.139 matthew 327: END
328: $scrout.=&selectbox(undef,'viewselect',
329: $ENV{'form.viewselect'},
330: undef,undef,undef,
331: sort(keys(%Views)));
332: $scrout.=<<ENDDOCUMENT;
1.124 matthew 333: <input type="button" value="HELP" onClick="openhelp()" />
334: </p>
335: </form>
336: </body>
337: </html>
338: ENDDOCUMENT
339: return $scrout;
340: }
341: ######################################################################
342: ######################################################################
343:
344: =pod
345:
346: =item &advanced_search_form()
347:
348: Returns a scalar which holds html for the advanced search form.
349:
350: =cut
351:
352: ######################################################################
353: ######################################################################
354:
355: sub advanced_search_form{
356: my ($closebutton,$hidden) = @_;
1.129 matthew 357: my $advanced_buttons = <<"END";
358: <p>
359: <input type="submit" name="advancedsubmit" value='SEARCH' />
360: <input type="reset" name="reset" value='RESET' />
361: $closebutton
362: <input type="button" value="HELP" onClick="openhelp()" />
363: </p>
364: END
1.139 matthew 365: if (!defined($ENV{'form.viewselect'})) {
366: $ENV{'form.viewselect'} ="Detailed Citation View";
367: }
1.124 matthew 368: my $scrout=<<"ENDHEADER";
369: <html>
370: <head>
371: <title>The LearningOnline Network with CAPA</title>
372: <script type="text/javascript">
373: function openhelp(val) {
374: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
375: 'scrollbars=1,width=600,height=300');
376: openhelpwin.focus();
1.18 harris41 377: }
1.124 matthew 378: </script>
379: </head>
380: <body bgcolor="#FFFFFF">
381: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
1.129 matthew 382: <h1>Advanced Catalog Search</h1>
383: <hr />
1.131 matthew 384: Enter terms or phrases separated by search operators
1.129 matthew 385: such as AND, OR, or NOT.<br />
1.130 matthew 386: <form method="post" action="/adm/searchcat">
1.129 matthew 387: $advanced_buttons
1.124 matthew 388: $hidden
1.129 matthew 389: <table>
1.130 matthew 390: <tr><td><font color="#800000" face="helvetica"><b>VIEW:</b></font></td>
391: <td>
1.124 matthew 392: ENDHEADER
1.139 matthew 393: $scrout.=&selectbox(undef,'viewselect',
394: $ENV{'form.viewselect'},
395: undef,undef,undef,
396: sort(keys(%Views)));
397: $scrout.="</td></tr>\n";
1.135 matthew 398: $scrout.=&searchphrasefield('title', 'title' ,$ENV{'form.title'});
399: $scrout.=&searchphrasefield('author', 'author' ,$ENV{'form.author'});
400: $scrout.=&searchphrasefield('subject', 'subject' ,$ENV{'form.subject'});
401: $scrout.=&searchphrasefield('keywords','keywords',$ENV{'form.keywords'});
402: $scrout.=&searchphrasefield('URL', 'url' ,$ENV{'form.url'});
403: $scrout.=&searchphrasefield('notes', 'notes' ,$ENV{'form.notes'});
404: $scrout.=&searchphrasefield('abstract','abstract',$ENV{'form.abstract'});
1.129 matthew 405: # Hack - an empty table row.
406: $scrout.="<tr><td> </td><td> </td></tr>\n";
407: $scrout.=&searchphrasefield('file<br />extension','mime',
408: $ENV{'form.mime'});
409: $scrout.="<tr><td> </td><td> </td></tr>\n";
410: $scrout.=&searchphrasefield('publisher<br />owner','owner',
411: $ENV{'form.owner'});
412: $scrout.="</table>\n";
1.131 matthew 413: $ENV{'form.category'}='any' unless length($ENV{'form.category'});
1.132 matthew 414: $scrout.=&selectbox('File Category','category',
1.131 matthew 415: $ENV{'form.category'},
416: 'any','Any category',
417: undef,
418: (&Apache::loncommon::filecategories()));
1.11 harris41 419: $ENV{'form.language'}='any' unless length($ENV{'form.language'});
1.133 matthew 420: #----------------------------------------------------------------
1.132 matthew 421: # Allow restriction to multiple domains.
422: # I make the crazy assumption that there will never be a domain 'any'.
423: #
1.133 matthew 424: $ENV{'form.domains'} = 'any' if (! exists($ENV{'form.domains'}));
425: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}}
426: : ($ENV{'form.domains'}) );
427: my %domain_hash = ();
428: foreach (@allowed_domains) {
429: $domain_hash{$_}++;
430: }
1.132 matthew 431: my @domains =&Apache::loncommon::get_domains();
432: # adjust the size of the select box
433: my $size = 4;
434: my $size = (scalar @domains < ($size - 1) ? scalar @domains + 1 : $size);
435: # standalone machines do not get to choose a domain to search.
436: if ((scalar @domains) == 1) {
437: $scrout .='<input type="hidden" name="domains" value="any" />'."\n";
438: } else {
1.133 matthew 439: $scrout.="\n".'<font color="#800000" face="helvetica"><b>'.
1.132 matthew 440: 'DOMAINS</b></font><br />'.
441: '<select name="domains" size="'.$size.'" multiple>'."\n".
1.133 matthew 442: '<option name="any" value="any" '.
443: ($domain_hash{'any'}? 'selected ' :'').
444: '>all domains</option>'."\n";
1.132 matthew 445: foreach my $dom (sort @domains) {
1.133 matthew 446: $scrout.="<option name=\"$dom\" ".
447: ($domain_hash{$dom} ? 'selected ' :'').">$dom</option>\n";
1.132 matthew 448: }
449: $scrout.="</select>\n";
450: }
1.133 matthew 451: #----------------------------------------------------------------
1.3 harris41 452: $scrout.=&selectbox('Limit by language','language',
1.111 harris41 453: $ENV{'form.language'},'any','Any Language',
454: \&{Apache::loncommon::languagedescription},
455: (&Apache::loncommon::languageids),
456: );
1.8 harris41 457: # ------------------------------------------------ Compute date selection boxes
458: $scrout.=<<CREATIONDATESTART;
1.3 harris41 459: <p>
460: <font color="#800000" face="helvetica"><b>LIMIT BY CREATION DATE RANGE:</b>
461: </font>
1.98 harris41 462: <br />
1.8 harris41 463: between:
464: CREATIONDATESTART
1.11 harris41 465: $scrout.=&dateboxes('creationdatestart',1,1,1976,
466: $ENV{'form.creationdatestart_month'},
467: $ENV{'form.creationdatestart_day'},
468: $ENV{'form.creationdatestart_year'},
469: );
1.124 matthew 470: $scrout.="and:\n";
1.11 harris41 471: $scrout.=&dateboxes('creationdateend',12,31,2051,
472: $ENV{'form.creationdateend_month'},
473: $ENV{'form.creationdateend_day'},
474: $ENV{'form.creationdateend_year'},
475: );
1.8 harris41 476: $scrout.="</p>";
477: $scrout.=<<LASTREVISIONDATESTART;
478: <p>
479: <font color="#800000" face="helvetica"><b>LIMIT BY LAST REVISION DATE RANGE:
480: </b></font>
1.98 harris41 481: <br />between:
1.8 harris41 482: LASTREVISIONDATESTART
1.11 harris41 483: $scrout.=&dateboxes('lastrevisiondatestart',1,1,1976,
484: $ENV{'form.lastrevisiondatestart_month'},
485: $ENV{'form.lastrevisiondatestart_day'},
486: $ENV{'form.lastrevisiondatestart_year'},
487: );
1.8 harris41 488: $scrout.=<<LASTREVISIONDATEEND;
489: and:
490: LASTREVISIONDATEEND
1.11 harris41 491: $scrout.=&dateboxes('lastrevisiondateend',12,31,2051,
492: $ENV{'form.lastrevisiondateend_month'},
493: $ENV{'form.lastrevisiondateend_day'},
494: $ENV{'form.lastrevisiondateend_year'},
495: );
1.8 harris41 496: $scrout.='</p>';
1.11 harris41 497: $ENV{'form.copyright'}='any' unless length($ENV{'form.copyright'});
1.8 harris41 498: $scrout.=&selectbox('Limit by copyright/distribution','copyright',
1.111 harris41 499: $ENV{'form.copyright'},
500: 'any','Any copyright/distribution',
501: \&{Apache::loncommon::copyrightdescription},
502: (&Apache::loncommon::copyrightids),
503: );
1.14 harris41 504: # ------------------------------------------- Compute customized metadata field
505: $scrout.=<<CUSTOMMETADATA;
506: <p>
1.77 harris41 507: <font color="#800000" face="helvetica"><b>LIMIT BY SPECIAL METADATA FIELDS:</b>
1.14 harris41 508: </font>
1.77 harris41 509: For resource-specific metadata, enter in an expression in the form of
1.100 harris41 510: <i>key</i>=<i>value</i> separated by operators such as AND, OR or NOT.<br />
1.14 harris41 511: <b>Example:</b> grandmother=75 OR grandfather=85
1.98 harris41 512: <br />
1.14 harris41 513: CUSTOMMETADATA
1.124 matthew 514: $scrout.=&simpletextfield('custommetadata',$ENV{'form.custommetadata'});
1.77 harris41 515: $scrout.=<<CUSTOMSHOW;
516: <p>
517: <font color="#800000" face="helvetica"><b>SHOW SPECIAL METADATA FIELDS:</b>
518: </font>
519: Enter in a space-separated list of special metadata fields to show
520: in a fielded listing for each record result.
1.98 harris41 521: <br />
1.77 harris41 522: CUSTOMSHOW
1.124 matthew 523: $scrout.=&simpletextfield('customshow',$ENV{'form.customshow'});
524: $scrout.=<<ENDDOCUMENT;
1.129 matthew 525: $advanced_buttons
1.8 harris41 526: </form>
527: </body>
528: </html>
529: ENDDOCUMENT
1.124 matthew 530: return $scrout;
531: }
1.8 harris41 532:
1.121 matthew 533: ######################################################################
534: ######################################################################
535:
536: =pod
537:
538: =item &make_persistent()
539:
540: Returns a scalar which holds the current ENV{'form.*'} values in
1.126 matthew 541: a 'hidden' html input tag. This allows search interface information
542: to be somewhat persistent.
1.122 matthew 543:
1.121 matthew 544: =cut
545:
546: ######################################################################
547: ######################################################################
548:
1.98 harris41 549: sub make_persistent {
1.133 matthew 550: my %save = %{shift()};
1.98 harris41 551: my $persistent='';
1.133 matthew 552: foreach (keys %save) {
1.98 harris41 553: if (/^form\./ && !/submit/) {
554: my $name=$_;
1.133 matthew 555: my @values = (ref($save{$name}) ? @{$save{$name}} : ($save{$name}));
1.98 harris41 556: $name=~s/^form\.//;
1.133 matthew 557: foreach (@values) {
558: s/\"/\'/g; # do not mess with html field syntax
559: $persistent.=<<END;
560: <input type="hidden" name="$name" value="$_" />
1.98 harris41 561: END
1.133 matthew 562: }
1.98 harris41 563: }
1.109 harris41 564: }
1.98 harris41 565: return $persistent;
566: }
567:
1.122 matthew 568:
569: ######################################################################
570: ######################################################################
571:
572: =pod
573:
574: =item HTML form building functions
575:
576: =over 4
577:
578: =item &simpletextfield()
579:
580: Inputs: $name,$value,$size
581:
582: Returns a text input field with the given name, value, and size.
583: If size is not specified, a value of 20 is used.
584:
585: =item &simplecheckbox()
586:
587: Inputs: $name,$value
588:
589: Returns a simple check box with the given $name.
590: If $value eq 'on' the box is checked.
591:
592: =item &searchphrasefield()
593:
594: Inputs: $title,$name,$value
595:
596: Returns html for a title line and an input field for entering search terms.
597: the instructions "Enter terms or phrases separated by search operators such
598: as AND, OR, or NOT." are given following the title. The entry field (which
599: is where the $name and $value are used) is an 80 column simpletextfield.
600:
601: =item &dateboxes()
602:
1.126 matthew 603: Returns html selection form elements for the specification of
604: the day, month, and year.
605:
1.122 matthew 606: =item &selectbox()
607:
1.129 matthew 608: Returns a scalar containing an html <select> form.
609:
610: Inputs:
611:
612: =over 4
613:
614: =item $title
615:
1.139 matthew 616: Printed above the select box, in uppercase. If undefined, only a select
617: box will be returned, with no additional html.
1.129 matthew 618:
619: =item $name
620:
621: The name element of the <select> tag.
622:
623: =item $default
624:
1.139 matthew 625: The default value of the form. Can be $anyvalue, or in @idlist.
1.129 matthew 626:
627: =item $anyvalue
628:
629: The <option value="..."> used to indicate a default of
1.139 matthew 630: none of the values. Can be undef.
1.129 matthew 631:
632: =item $anytag
633:
634: The text associate with $anyvalue above.
635:
636: =item $functionref
637:
638: Each element in @idlist will be passed as a parameter
639: to the function referenced here. The return value of the function should
640: be a scalar description of the items. If this value is undefined the
641: description of each item in @idlist will be the item name.
642:
643: =item @idlist
644:
645: The items to be selected from. One of these or $anyvalue will be the
646: value returned by the form element, $ENV{form.$name}.
647:
648: =back
1.126 matthew 649:
1.122 matthew 650: =back
651:
652: =cut
653:
654: ######################################################################
655: ######################################################################
1.8 harris41 656:
1.11 harris41 657: sub simpletextfield {
1.122 matthew 658: my ($name,$value,$size)=@_;
659: $size = 20 if (! defined($size));
660: return '<input type="text" name="'.$name.
661: '" size="'.$size.'" value="'.$value.'" />';
1.11 harris41 662: }
663:
664: sub simplecheckbox {
665: my ($name,$value)=@_;
666: my $checked='';
1.129 matthew 667: $checked="checked" if $value eq 'on';
1.122 matthew 668: return '<input type="checkbox" name="'.$name.'" '. $checked . ' />';
1.11 harris41 669: }
670:
1.8 harris41 671: sub searchphrasefield {
672: my ($title,$name,$value)=@_;
673: my $uctitle=uc($title);
1.129 matthew 674: return '<tr><td><font color="#800000" face="helvetica">'.
675: '<b>'.$uctitle.': </b></font></td><td>'.
676: &simpletextfield($name,$value,50)."</td></tr>\n";
1.8 harris41 677: }
1.3 harris41 678:
1.8 harris41 679: sub dateboxes {
1.11 harris41 680: my ($name,$defaultmonth,$defaultday,$defaultyear,
681: $currentmonth,$currentday,$currentyear)=@_;
682: ($defaultmonth,$defaultday,$defaultyear)=('','','');
1.117 matthew 683: #
684: # Day
685: my $day=<<END;
686: <select name="${name}_day">
687: <option value='$defaultday'> </option>
688: END
689: for (my $i = 1; $i<=31; $i++) {
690: $day.="<option value=\"$i\">$i</option>\n";
691: }
692: $day.="</select>\n";
693: $day=~s/(\"$currentday\")/$1 SELECTED/ if length($currentday);
694: #
695: # Month
1.11 harris41 696: my $month=<<END;
1.8 harris41 697: <select name="${name}_month">
1.11 harris41 698: <option value='$defaultmonth'> </option>
699: END
1.117 matthew 700: my $i = 1;
701: foreach (qw/January February March April May June
702: July August September October November December /){
703: $month .="<option value=\"$i\">$_</option>\n";
704: $i++;
705: }
706: $month.="</select>\n";
1.11 harris41 707: $month=~s/(\"$currentmonth\")/$1 SELECTED/ if length($currentmonth);
1.117 matthew 708: #
709: # Year (obviously)
1.11 harris41 710: my $year=<<END;
1.8 harris41 711: <select name="${name}_year">
1.11 harris41 712: <option value='$defaultyear'> </option>
1.3 harris41 713: END
1.117 matthew 714: my $maxyear = 2051;
715: for (my $i = 1976; $i<=$maxyear; $i++) {
716: $year.="<option value=\"$i\">$i</option>\n";
717: }
718: $year.="</select>\n";
1.11 harris41 719: $year=~s/(\"$currentyear\")/$1 SELECTED/ if length($currentyear);
720: return "$month$day$year";
1.3 harris41 721: }
722:
723: sub selectbox {
1.129 matthew 724: my ($title,$name,$default,$anyvalue,$anytag,$functionref,@idlist)=@_;
725: if (! defined($functionref)) { $functionref = sub { $_[0]}; }
1.139 matthew 726: my $selout='';
727: if (defined($title)) {
728: my $uctitle=uc($title);
729: $selout="\n".'<p><font color="#800000" face="helvetica">'.
730: '<b>'.$uctitle.': </b></font>';
731: }
732: $selout .= '<select name="'.$name.'">';
733: unshift @idlist,$anyvalue if (defined($anyvalue));
734: foreach (@idlist) {
1.122 matthew 735: $selout.='<option value="'.$_.'"';
1.129 matthew 736: if ($_ eq $default and !/^any$/) {
1.122 matthew 737: $selout.=' selected >'.&{$functionref}($_).'</option>';
1.111 harris41 738: }
1.129 matthew 739: elsif ($_ eq $default and /^$anyvalue$/) {
1.122 matthew 740: $selout.=' selected >'.$anytag.'</option>';
1.111 harris41 741: }
742: else {$selout.='>'.&{$functionref}($_).'</option>';}
1.109 harris41 743: }
1.139 matthew 744: return $selout.'</select>'.(defined($title)?'</p>':' ');
1.6 harris41 745: }
746:
1.122 matthew 747: ######################################################################
748: ######################################################################
749:
750: =pod
751:
1.134 matthew 752: =item &parse_advanced_search()
753:
754: Parse advanced search form and return the following:
755:
756: =over 4
757:
758: =item $query Scalar containing an SQL query.
1.126 matthew 759:
1.134 matthew 760: =item $customquery Scalar containing a custom query.
761:
762: =item $customshow Scalar containing commands to show custom metadata.
763:
764: =item $libraries_to_query Reference to array of domains to search.
765:
766: =back
1.122 matthew 767:
768: =cut
769:
770: ######################################################################
771: ######################################################################
1.134 matthew 772: sub parse_advanced_search {
773: my ($r)=@_;
1.32 harris41 774: my $fillflag=0;
1.64 harris41 775: # Clean up fields for safety
776: for my $field ('title','author','subject','keywords','url','version',
777: 'creationdatestart_month','creationdatestart_day',
778: 'creationdatestart_year','creationdateend_month',
779: 'creationdateend_day','creationdateend_year',
780: 'lastrevisiondatestart_month','lastrevisiondatestart_day',
781: 'lastrevisiondatestart_year','lastrevisiondateend_month',
782: 'lastrevisiondateend_day','lastrevisiondateend_year',
783: 'notes','abstract','mime','language','owner',
1.131 matthew 784: 'custommetadata','customshow','category') {
1.101 harris41 785: $ENV{"form.$field"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
1.64 harris41 786: }
1.117 matthew 787: foreach ('mode','form','element') {
788: # is this required? Hmmm.
789: next unless (exists($ENV{"form.$_"}));
790: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
791: $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
792: }
1.131 matthew 793: # Preprocess the category form element.
794: if ($ENV{'form.category'} ne 'any') {
795: my @extensions = &Apache::loncommon::filecategorytypes
796: ($ENV{'form.category'});
797: $ENV{'form.mime'} = join ' OR ',@extensions;
798: }
1.90 harris41 799: # Check to see if enough information was filled in
1.32 harris41 800: for my $field ('title','author','subject','keywords','url','version',
801: 'notes','abstract','mime','language','owner',
802: 'custommetadata') {
1.40 harris41 803: if (&filled($ENV{"form.$field"})) {
1.32 harris41 804: $fillflag++;
805: }
806: }
807: unless ($fillflag) {
808: &output_blank_field_error($r);
1.134 matthew 809: return ;
1.32 harris41 810: }
1.90 harris41 811: # Turn the form input into a SQL-based query
1.39 harris41 812: my $query='';
1.45 harris41 813: my @queries;
1.90 harris41 814: # Evaluate logical expression AND/OR/NOT phrase fields.
1.58 harris41 815: foreach my $field ('title','author','subject','notes','abstract','url',
1.129 matthew 816: 'keywords','version','owner','mime') {
1.44 harris41 817: if ($ENV{'form.'.$field}) {
1.45 harris41 818: push @queries,&build_SQL_query($field,$ENV{'form.'.$field});
1.131 matthew 819: }
1.44 harris41 820: }
1.135 matthew 821: # I dislike the hack below.
822: if ($ENV{'form.category'}) {
823: $ENV{'form.mime'}='';
824: }
1.90 harris41 825: # Evaluate option lists
1.58 harris41 826: if ($ENV{'form.language'} and $ENV{'form.language'} ne 'any') {
1.90 harris41 827: push @queries,"(language like \"$ENV{'form.language'}\")";
1.58 harris41 828: }
829: if ($ENV{'form.copyright'} and $ENV{'form.copyright'} ne 'any') {
1.90 harris41 830: push @queries,"(copyright like \"$ENV{'form.copyright'}\")";
1.58 harris41 831: }
1.90 harris41 832: # Evaluate date windows
1.60 harris41 833: my $datequery=&build_date_queries(
834: $ENV{'form.creationdatestart_month'},
835: $ENV{'form.creationdatestart_day'},
836: $ENV{'form.creationdatestart_year'},
837: $ENV{'form.creationdateend_month'},
838: $ENV{'form.creationdateend_day'},
839: $ENV{'form.creationdateend_year'},
840: $ENV{'form.lastrevisiondatestart_month'},
841: $ENV{'form.lastrevisiondatestart_day'},
842: $ENV{'form.lastrevisiondatestart_year'},
843: $ENV{'form.lastrevisiondateend_month'},
844: $ENV{'form.lastrevisiondateend_day'},
845: $ENV{'form.lastrevisiondateend_year'},
846: );
1.90 harris41 847: # Test to see if date windows are legitimate
1.61 harris41 848: if ($datequery=~/^Incorrect/) {
849: &output_date_error($r,$datequery);
1.134 matthew 850: return ;
1.61 harris41 851: }
852: elsif ($datequery) {
1.60 harris41 853: push @queries,$datequery;
854: }
1.90 harris41 855: # Process form information for custom metadata querying
1.134 matthew 856: my $customquery=undef;
1.64 harris41 857: if ($ENV{'form.custommetadata'}) {
858: $customquery=&build_custommetadata_query('custommetadata',
859: $ENV{'form.custommetadata'});
860: }
1.134 matthew 861: my $customshow=undef;
1.83 harris41 862: if ($ENV{'form.customshow'}) {
863: $customshow=$ENV{'form.customshow'};
864: $customshow=~s/[^\w\s]//g;
865: my @fields=split(/\s+/,$customshow);
866: $customshow=join(" ",@fields);
867: }
1.133 matthew 868: ## ---------------------------------------------------------------
1.132 matthew 869: ## Deal with restrictions to given domains
870: ##
871: my $libraries_to_query = undef;
872: # $ENV{'form.domains'} can be either a scalar or an array reference.
873: # We need an array.
874: my @allowed_domains = (ref($ENV{'form.domains'}) ? @{$ENV{'form.domains'}}
875: : ($ENV{'form.domains'}) );
876: my %domain_hash = ();
877: foreach (@allowed_domains) {
878: $domain_hash{$_}++;
879: }
880: foreach (keys(%Apache::lonnet::libserv)) {
881: if ($_ eq 'any') {
882: $libraries_to_query = undef;
883: last;
884: }
885: if (exists($domain_hash{$Apache::lonnet::hostdom{$_}})) {
886: push @$libraries_to_query,$_;
887: }
888: }
889: #
1.45 harris41 890: if (@queries) {
1.58 harris41 891: $query=join(" AND ",@queries);
1.46 harris41 892: $query="select * from metadata where $query";
1.126 matthew 893: } elsif ($customquery) {
1.134 matthew 894: $query = '';
1.45 harris41 895: }
1.134 matthew 896: return ($query,$customquery,$customshow,$libraries_to_query);
1.18 harris41 897: }
898:
1.122 matthew 899: ######################################################################
900: ######################################################################
901:
902: =pod
903:
1.134 matthew 904: =item &parse_basic_search()
1.122 matthew 905:
1.134 matthew 906: Parse the basic search form and return a scalar containing an sql query.
1.126 matthew 907:
1.122 matthew 908: =cut
909:
910: ######################################################################
911: ######################################################################
1.134 matthew 912: sub parse_basic_search {
913: my ($r)=@_;
1.64 harris41 914: # Clean up fields for safety
915: for my $field ('basicexp') {
916: $ENV{"form.$field"}=~s/[^\w\s\(\)\-]//g;
917: }
1.117 matthew 918: foreach ('mode','form','element') {
919: # is this required? Hmmm.
920: next unless (exists($ENV{"form.$_"}));
921: $ENV{"form.$_"}=&Apache::lonnet::unescape($ENV{"form.$_"});
922: $ENV{"form.$_"}=~s/[^\w\/\s\(\)\=\-\"\']//g;
923: }
1.64 harris41 924:
1.90 harris41 925: # Check to see if enough is filled in
1.26 harris41 926: unless (&filled($ENV{'form.basicexp'})) {
1.24 harris41 927: &output_blank_field_error($r);
928: return OK;
929: }
1.22 harris41 930:
1.90 harris41 931: # Build SQL query string based on form page
1.39 harris41 932: my $query='';
1.33 harris41 933: my $concatarg=join('," ",',
1.124 matthew 934: ('title', 'author', 'subject', 'notes', 'abstract',
935: 'keywords'));
1.95 harris41 936: $concatarg='title' if $ENV{'form.titleonly'};
1.94 harris41 937:
938: $query=&build_SQL_query('concat('.$concatarg.')',$ENV{'form.'.'basicexp'});
1.134 matthew 939: return 'select * from metadata where '.$query;
1.22 harris41 940: }
941:
1.122 matthew 942:
943: ######################################################################
944: ######################################################################
945:
946: =pod
947:
948: =item &build_SQL_query()
949:
1.126 matthew 950: Builds a SQL query string from a logical expression with AND/OR keywords
951: using Text::Query and &recursive_SQL_query_builder()
952:
1.122 matthew 953: =cut
954:
955: ######################################################################
956: ######################################################################
1.98 harris41 957: sub build_SQL_query {
958: my ($field_name,$logic_statement)=@_;
959: my $q=new Text::Query('abc',
960: -parse => 'Text::Query::ParseAdvanced',
961: -build => 'Text::Query::Build');
962: $q->prepare($logic_statement);
963: my $matchexp=${$q}{'matchexp'}; chomp $matchexp;
964: my $sql_query=&recursive_SQL_query_build($field_name,$matchexp);
965: return $sql_query;
966: }
967:
1.122 matthew 968: ######################################################################
969: ######################################################################
970:
971: =pod
972:
973: =item &build_custommetadata_query()
974:
1.126 matthew 975: Constructs a custom metadata query using a rather heinous regular
976: expression.
977:
1.122 matthew 978: =cut
979:
980: ######################################################################
981: ######################################################################
1.98 harris41 982: sub build_custommetadata_query {
983: my ($field_name,$logic_statement)=@_;
984: my $q=new Text::Query('abc',
985: -parse => 'Text::Query::ParseAdvanced',
986: -build => 'Text::Query::BuildAdvancedString');
987: $q->prepare($logic_statement);
988: my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
989: # quick fix to change literal into xml tag-matching
990: # will eventually have to write a separate builder module
1.122 matthew 991: # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
992: $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to
993: /\\<$1\\>?# \<wordone\>
994: \[\^\\<\]?# [^\<]
995: \*$2\[\^\\<\]?# *wordtwo[^\<]
996: \*\\<\\\/$1\\>?# *\<\/wordone\>
997: /g;
1.98 harris41 998: return $matchexp;
999: }
1000:
1.122 matthew 1001: ######################################################################
1002: ######################################################################
1003:
1004: =pod
1005:
1006: =item &recursive_SQL_query_build()
1007:
1.126 matthew 1008: Recursively constructs an SQL query. Takes as input $dkey and $pattern.
1009:
1.122 matthew 1010: =cut
1011:
1012: ######################################################################
1013: ######################################################################
1.98 harris41 1014: sub recursive_SQL_query_build {
1015: my ($dkey,$pattern)=@_;
1016: my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
1017: return $pattern unless @matches;
1018: foreach my $match (@matches) {
1019: $match=~/\[ (\w+)\s(.*) \]/;
1020: my ($key,$value)=($1,$2);
1021: my $replacement='';
1022: if ($key eq 'literal') {
1023: $replacement="($dkey like \"\%$value\%\")";
1024: }
1025: elsif ($key eq 'not') {
1026: $value=~s/like/not like/;
1027: # $replacement="($dkey not like $value)";
1028: $replacement="$value";
1029: }
1030: elsif ($key eq 'and') {
1031: $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
1032: $replacement="($1 AND $2)";
1033: }
1034: elsif ($key eq 'or') {
1035: $value=~/(.*[\"|\)]) ([|\(|\^].*)/;
1036: $replacement="($1 OR $2)";
1037: }
1038: substr($pattern,
1039: index($pattern,$match),
1040: length($match),
1041: $replacement
1042: );
1043: }
1044: &recursive_SQL_query_build($dkey,$pattern);
1045: }
1.22 harris41 1046:
1.122 matthew 1047: ######################################################################
1048: ######################################################################
1049:
1050: =pod
1051:
1052: =item &build_date_queries()
1053:
1.126 matthew 1054: Builds a SQL logic query to check time/date entries.
1055: Also reports errors (check for /^Incorrect/).
1056:
1.122 matthew 1057: =cut
1058:
1059: ######################################################################
1060: ######################################################################
1.98 harris41 1061: sub build_date_queries {
1062: my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
1063: $lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
1064: my @queries;
1065: if ($cmonth1 or $cday1 or $cyear1 or $cmonth2 or $cday2 or $cyear2) {
1066: unless ($cmonth1 and $cday1 and $cyear1 and
1067: $cmonth2 and $cday2 and $cyear2) {
1068: return "Incorrect entry for the creation date. You must specify ".
1069: "a starting month, day, and year and an ending month, ".
1070: "day, and year.";
1071: }
1072: my $cnumeric1=sprintf("%d%2d%2d",$cyear1,$cmonth1,$cday1);
1073: $cnumeric1+=0;
1074: my $cnumeric2=sprintf("%d%2d%2d",$cyear2,$cmonth2,$cday2);
1075: $cnumeric2+=0;
1076: if ($cnumeric1>$cnumeric2) {
1077: return "Incorrect entry for the creation date. The starting ".
1078: "date must occur before the ending date.";
1079: }
1080: my $cquery="(creationdate BETWEEN '$cyear1-$cmonth1-$cday1' AND '".
1081: "$cyear2-$cmonth2-$cday2 23:59:59')";
1082: push @queries,$cquery;
1083: }
1084: if ($lmonth1 or $lday1 or $lyear1 or $lmonth2 or $lday2 or $lyear2) {
1085: unless ($lmonth1 and $lday1 and $lyear1 and
1086: $lmonth2 and $lday2 and $lyear2) {
1087: return "Incorrect entry for the last revision date. You must ".
1088: "specify a starting month, day, and year and an ending ".
1089: "month, day, and year.";
1090: }
1091: my $lnumeric1=sprintf("%d%2d%2d",$lyear1,$lmonth1,$lday1);
1092: $lnumeric1+=0;
1093: my $lnumeric2=sprintf("%d%2d%2d",$lyear2,$lmonth2,$lday2);
1094: $lnumeric2+=0;
1095: if ($lnumeric1>$lnumeric2) {
1096: return "Incorrect entry for the last revision date. The ".
1097: "starting date must occur before the ending date.";
1098: }
1099: my $lquery="(lastrevisiondate BETWEEN '$lyear1-$lmonth1-$lday1' AND '".
1100: "$lyear2-$lmonth2-$lday2 23:59:59')";
1101: push @queries,$lquery;
1102: }
1103: if (@queries) {
1104: return join(" AND ",@queries);
1105: }
1106: return '';
1.18 harris41 1107: }
1.6 harris41 1108:
1.122 matthew 1109: ######################################################################
1110: ######################################################################
1111:
1112: =pod
1113:
1114: =item &output_results()
1115:
1116: Format and output results based on a reply list.
1117: There are two windows that this function writes to. The main search
1118: window ("srch") has a listing of the results. A secondary window ("popwin")
1119: gives the status of the network search (time elapsed, number of machines
1120: contacted, etc.)
1121:
1122: =cut
1123:
1124: ######################################################################
1125: ######################################################################
1.18 harris41 1126: sub output_results {
1.126 matthew 1127: # &Apache::lonnet::logthis("output_results:".time);
1.101 harris41 1128: my $fnum; # search result counter
1.134 matthew 1129: my ($mode,$r,$replyref,$hidden)=@_;
1.92 harris41 1130: my %rhash=%{$replyref};
1.44 harris41 1131: my $compiledresult='';
1.125 matthew 1132: my $timeremain=300; # (seconds)
1.98 harris41 1133: my $elapsetime=0;
1.93 harris41 1134: my $resultflag=0;
1135: my $tflag=1;
1.136 matthew 1136: ##
1137: ## Set viewing function
1138: ##
1.139 matthew 1139: my $viewfunction = $Views{$ENV{'form.viewselect'}};
1.136 matthew 1140: if (!defined($viewfunction)) {
1141: $r->print("Internal Error - Bad view selected.\n");
1142: $r->rflush();
1143: return;
1144: }
1.125 matthew 1145: #
1.93 harris41 1146: # make query information persistent to allow for subsequent revision
1.133 matthew 1147: my $persistent=&make_persistent(\%ENV);
1.136 matthew 1148: #
1149: # Begin producing output
1.130 matthew 1150: $r->print(&search_results_header($mode));
1.98 harris41 1151: $r->rflush();
1.136 matthew 1152: #
1.98 harris41 1153: # begin showing the cataloged results
1.129 matthew 1154: my $action = "/adm/searchcat";
1155: if ($mode eq 'Basic') {
1156: $action .= "?reqinterface=basic";
1157: } elsif ($mode eq 'Advanced') {
1158: $action .= "?reqinterface=advanced";
1159: }
1160: $r->print(<<CATALOGCONTROLS);
1161: <form name='results' method="post" action="$action">
1.118 www 1162: $hidden
1.98 harris41 1163: <input type='hidden' name='acts' value='' />
1.93 harris41 1164: <input type='button' value='Revise search request'
1.98 harris41 1165: onClick='this.form.submit();' />
1166: $importbutton
1.93 harris41 1167: $closebutton
1168: $persistent
1.98 harris41 1169: <hr />
1170: CATALOGCONTROLS
1.125 matthew 1171: #
1172: # make the pop-up window for status
1173: $r->print(&make_popwin(%rhash));
1.92 harris41 1174: $r->rflush();
1.125 matthew 1175: ##
1176: ## Prepare for the main loop below
1177: ##
1.93 harris41 1178: my $servercount=0;
1.98 harris41 1179: my $hitcountsum=0;
1.125 matthew 1180: my $servernum=(keys %rhash);
1181: my $serversleft=$servernum;
1182: ##
1183: ## Run until we run out of time or we run out of servers
1184: ##
1185: while($serversleft && $timeremain) {
1186: ##
1187: ## %rhash has servers deleted from it as results come in
1188: ## (within the foreach loop below).
1189: ##
1190: foreach my $rkey (sort keys %rhash) {
1.126 matthew 1191: # &Apache::lonnet::logthis("Server $rkey:".time);
1.93 harris41 1192: $servercount++;
1193: $compiledresult='';
1.92 harris41 1194: my $reply=$rhash{$rkey};
1.18 harris41 1195: my @results;
1.93 harris41 1196: if ($reply eq 'con_lost') {
1.125 matthew 1197: &popwin_imgupdate($r,$rkey,"srvbad.gif");
1198: $serversleft--;
1199: delete $rhash{$rkey};
1200: } else {
1201: # must do since 'use strict' checks for tainting
1202: $reply=~/^([\.\w]+)$/;
1203: my $replyfile=$r->dir_config('lonDaemons').'/tmp/'.$1;
1.93 harris41 1204: $reply=~/(.*?)\_/;
1.126 matthew 1205: for (my $counter=0;$counter<2;$counter++) {
1206: if (-e $replyfile && ! -e "$replyfile.end") {
1207: &popwin_imgupdate($r,$rkey,"srvhalf.gif");
1208: &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
1209: '"still transferring..."'.';');
1210: }
1211: # Are we finished transferring data?
1212: if (-e "$replyfile.end") {
1213: $serversleft--;
1214: delete $rhash{$rkey};
1215: if (-s $replyfile) {
1216: &popwin_imgupdate($r,$rkey,"srvgood.gif");
1217: my $fh;
1218: unless ($fh=Apache::File->new($replyfile)){
1219: # Is it really appropriate to die on this error?
1220: $r->print('ERROR: file '.
1221: $replyfile.' cannot be opened');
1222: return OK;
1223: }
1224: @results=<$fh> if $fh;
1.127 matthew 1225: my $hits =@results;
1.126 matthew 1226: &popwin_js($r,'popwin.hc["'.$rkey.'"]='.
1.127 matthew 1227: $hits.';');
1228: $hitcountsum+=$hits;
1.126 matthew 1229: &popwin_js($r,'popwin.document.forms.popremain.'.
1230: 'numhits.value='.$hitcountsum.';');
1231: } else {
1232: &popwin_imgupdate($r,$rkey,"srvempty.gif");
1233: &popwin_js($r,'popwin.hc["'.$rkey.'"]=0;');
1234: }
1235: last;
1236: } # end of if ( -e "$replyfile.end")
1237: last unless $timeremain;
1238: sleep 1; # wait for daemons to write files?
1239: $timeremain--;
1240: $elapsetime++;
1241: &popwin_js($r,"popwin.document.popremain.".
1242: "elapsetime.value=$elapsetime;");
1.93 harris41 1243: }
1.117 matthew 1244: &popwin_js($r,'popwin.document.whirly.'.
1245: 'src="/adm/lonIcons/lonanimend.gif";');
1.125 matthew 1246: } # end of if ($reply eq 'con_lost') else statement
1.126 matthew 1247: my %Fields = undef; # Holds the data to be sent to the various
1248: # *_view routines.
1.136 matthew 1249: my ($extrashow,$customfields,$customhash) =
1250: &handle_custom_fields(\@results);
1.126 matthew 1251: my @customfields = @$customfields;
1252: my %customhash = %$customhash;
1253: untie %hash if (keys %hash);
1254: #
1255: if (! tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
1256: $r->print('<html><head></head><body>Unable to tie hash to db '.
1257: 'file</body></html>');
1258: } else {
1.101 harris41 1259: if ($ENV{'form.launch'} eq '1') {
1260: &start_fresh_session();
1261: }
1262: foreach my $result (@results) {
1263: next if $result=~/^custom\=/;
1264: chomp $result;
1265: next unless $result;
1.126 matthew 1266: %Fields = &parse_raw_result($result,$rkey);
1.137 matthew 1267: #
1268: # Check copyright tags and skip results the user cannot use
1269: my (undef,undef,$resdom,$resname) = split('/',$Fields{'url'});
1270: # Check for priv
1271: if (($Fields{'copyright'} eq 'priv') &&
1272: (($ENV{'user.name'} ne $resname) &&
1273: ($ENV{'user.domain'} ne $resdom))) {
1274: next;
1275: }
1276: # Check for domain
1277: if (($Fields{'copyright'} eq 'domain') &&
1278: ($ENV{'user.domain'} ne $resdom)) {
1279: next;
1280: }
1281: #
1.126 matthew 1282: $Fields{'extrashow'}=$extrashow;
1.101 harris41 1283: if ($extrashow) {
1284: foreach my $field (@customfields) {
1285: my $value='';
1.126 matthew 1286: $value = $1 if ($customhash{$Fields{'url'}}=~/\<{$field}[^\>]*\>(.*?)\<\/{$field}[^\>]*\>/s);
1287: $Fields{'extrashow'}=~s/\<\!\-\- $field \-\-\>/ $value/g;
1288: }
1289: }
1290: $compiledresult.="\n<p>\n";
1291: if ($ENV{'form.catalogmode'} eq 'interactive') {
1292: my $titleesc=$Fields{'title'};
1293: $titleesc=~s/\'/\\'/; # '
1294: $compiledresult.=<<END if ($ENV{'form.catalogmode'} eq 'interactive');
1.8 harris41 1295: <font size='-1'><INPUT TYPE="button" NAME="returnvalues" VALUE="SELECT"
1.126 matthew 1296: onClick="javascript:select_data('$titleesc','$Fields{'url'}')">
1.8 harris41 1297: </font>
1.98 harris41 1298: <br />
1299: END
1.115 harris41 1300: }
1.101 harris41 1301: if ($ENV{'form.catalogmode'} eq 'groupsearch') {
1302: $fnum+=0;
1.126 matthew 1303: $hash{"pre_${fnum}_link"}=$Fields{'url'};
1304: $hash{"pre_${fnum}_title"}=$Fields{'title'};
1.101 harris41 1305: $compiledresult.=<<END;
1.118 www 1306: <font size='-1'>
1307: <input type="checkbox" name="returnvalues" value="SELECT"
1.98 harris41 1308: onClick="javascript:queue($fnum)" />
1309: </font>
1310: <br />
1.8 harris41 1311: END
1.101 harris41 1312: # <input type="hidden" name="title$fnum" value="$title" />
1313: # <input type="hidden" name="url$fnum" value="$url" />
1314: $fnum++;
1315: }
1.136 matthew 1316: # Render the result into html
1317: $compiledresult.= &$viewfunction(%Fields, hostname => $rkey );
1.130 matthew 1318: if ($compiledresult or $servercount!=$servernum) {
1319: $compiledresult.="<hr align='left' width='200' noshade />";
1320: }
1.101 harris41 1321: }
1322: untie %hash;
1.18 harris41 1323: }
1.93 harris41 1324: if ($compiledresult) {
1325: $resultflag=1;
1.126 matthew 1326: $r->print($compiledresult);
1.18 harris41 1327: }
1.126 matthew 1328: } # End of foreach loop over servers remaining
1329: } # End of big loop - while($serversleft && $timeremain)
1.93 harris41 1330: unless ($resultflag) {
1331: $r->print("\nThere were no results that matched your query\n");
1.43 harris41 1332: }
1.135 matthew 1333: $r->print('<script type="text/javascript">'.'popwin.close()</script>'.
1334: "\n");
1.126 matthew 1335: $r->print("</body>\n</html>\n");
1.135 matthew 1336: $r->rflush();
1.126 matthew 1337: return;
1338: }
1339:
1340: ###########################################################
1341: ###########################################################
1342:
1343: =pod
1344:
1345: =item &parse_raw_result()
1346:
1347: Takes a line from the file of results and parse it. Returns a hash
1348: with keys for the following fields:
1349: 'title', 'author', 'subject', 'url', 'keywords', 'version', 'notes',
1350: 'abstract', 'mime', 'lang', 'owner', 'copyright', 'creationdate',
1351: 'lastrevisiondate'.
1352:
1353: In addition, the following tags are set by calling the appropriate
1354: lonnet function: 'language', 'cprtag', 'mimetag'.
1355:
1356: The 'title' field is set to "Untitled" if the title field is blank.
1357:
1358: 'abstract' and 'keywords' are truncated to 200 characters.
1359:
1360: =cut
1361:
1362: ###########################################################
1363: ###########################################################
1364: sub parse_raw_result {
1365: my ($result,$hostname) = @_;
1366: # Check for a comma - if it is there then we do not need to unescape the
1367: # string. There seems to be some kind of problem with some items in
1368: # the database - the entire string gets sent out unescaped...?
1369: unless ($result =~ /,/) {
1370: $result = &Apache::lonnet::unescape($result);
1371: }
1372: my @fields=map {
1373: &Apache::lonnet::unescape($_);
1374: } (split(/\,/,$result));
1375: my ($title,$author,$subject,$url,$keywords,$version,
1376: $notes,$abstract,$mime,$lang,
1377: $creationdate,$lastrevisiondate,$owner,$copyright)=@fields;
1378: my %Fields =
1379: ( title => &Apache::lonnet::unescape($title),
1380: author => &Apache::lonnet::unescape($author),
1381: subject => &Apache::lonnet::unescape($subject),
1382: url => &Apache::lonnet::unescape($url),
1383: keywords => &Apache::lonnet::unescape($keywords),
1384: version => &Apache::lonnet::unescape($version),
1385: notes => &Apache::lonnet::unescape($notes),
1386: abstract => &Apache::lonnet::unescape($abstract),
1387: mime => &Apache::lonnet::unescape($mime),
1388: lang => &Apache::lonnet::unescape($lang),
1389: owner => &Apache::lonnet::unescape($owner),
1390: copyright => &Apache::lonnet::unescape($copyright),
1391: creationdate => &Apache::lonnet::unescape($creationdate),
1392: lastrevisiondate => &Apache::lonnet::unescape($lastrevisiondate)
1393: );
1394: $Fields{'language'} =
1395: &Apache::loncommon::languagedescription($Fields{'lang'});
1396: $Fields{'copyrighttag'} =
1397: &Apache::loncommon::copyrightdescription($Fields{'copyright'});
1398: $Fields{'mimetag'} =
1399: &Apache::loncommon::filedescription($Fields{'mime'});
1.134 matthew 1400: if ($Fields{'author'}=~/^(\s*|error)$/) {
1401: $Fields{'author'}="Unknown Author";
1402: }
1.126 matthew 1403: # Put spaces in the keyword list, if needed.
1404: $Fields{'keywords'}=~ s/,([A-z])/, $1/g;
1405: if ($Fields{'title'}=~ /^\s*$/ ) {
1406: $Fields{'title'}='Untitled';
1407: }
1408: unless ($ENV{'user.adv'}) {
1409: $Fields{'keywords'} = '- not displayed -';
1410: $Fields{'notes'} = '- not displayed -';
1411: $Fields{'abstract'} = '- not displayed -';
1412: $Fields{'subject'} = '- not displayed -';
1413: }
1414: if (length($Fields{'abstract'})>200) {
1415: $Fields{'abstract'} =
1416: substr($Fields{'abstract'},0,200).'...';
1417: }
1418: if (length($Fields{'keywords'})>200) {
1419: $Fields{'keywords'} =
1420: substr($Fields{'keywords'},0,200).'...';
1421: }
1422: return %Fields;
1423: }
1424:
1425: ###########################################################
1426: ###########################################################
1427:
1428: =pod
1429:
1430: =item &handle_custom_fields()
1431:
1432: =cut
1433:
1434: ###########################################################
1435: ###########################################################
1436: sub handle_custom_fields {
1437: my @results = @{shift()};
1438: my $customshow='';
1439: my $extrashow='';
1440: my @customfields;
1441: if ($ENV{'form.customshow'}) {
1442: $customshow=$ENV{'form.customshow'};
1443: $customshow=~s/[^\w\s]//g;
1444: my @fields=map {
1445: "<font color=\"#008000\">$_:</font><!-- $_ -->";
1446: } split(/\s+/,$customshow);
1447: @customfields=split(/\s+/,$customshow);
1448: if ($customshow) {
1449: $extrashow="<ul><li>".join("</li><li>",@fields)."</li></ul>\n";
1450: }
1451: }
1452: my $customdata='';
1453: my %customhash;
1454: foreach my $result (@results) {
1455: if ($result=~/^(custom\=.*)$/) { # grab all custom metadata
1456: my $tmp=$result;
1457: $tmp=~s/^custom\=//;
1458: my ($k,$v)=map {&Apache::lonnet::unescape($_);
1459: } split(/\,/,$tmp);
1460: $customhash{$k}=$v;
1461: }
1462: }
1463: return ($extrashow,\@customfields,\%customhash);
1.41 harris41 1464: }
1465:
1.122 matthew 1466: ######################################################################
1467: ######################################################################
1468:
1.125 matthew 1469: =pod
1470:
1471: =item &search_results_header
1472:
1.130 matthew 1473: Output the proper html headers and javascript code to deal with different
1474: calling modes.
1475:
1476: Takes most inputs directly from %ENV, except $mode.
1477:
1478: =over 4
1479:
1480: =item $mode is either (at this writing) 'Basic' or 'Advanced'
1481:
1482: =back
1.126 matthew 1483:
1.130 matthew 1484: The following environment variables are checked:
1.126 matthew 1485:
1486: =over 4
1487:
1488: =item 'form.catalogmode'
1489:
1490: Checked for 'interactive' and 'groupsearch'.
1491:
1492: =item 'form.mode'
1493:
1494: Checked for existance & 'edit' mode.
1495:
1496: =item 'form.form'
1497:
1498: =item 'form.element'
1499:
1500: =back
1501:
1.125 matthew 1502: =cut
1503:
1504: ######################################################################
1505: ######################################################################
1506: sub search_results_header {
1.130 matthew 1507: my ($mode) = @_;
1508: $mode = lc($mode);
1509: my $title;
1510: if ($mode eq 'advanced') {
1511: $title = "Advanced Search Results";
1512: } elsif ($mode eq 'basic') {
1513: $title = "Basic Search Results";
1514: }
1.125 matthew 1515: my $result = '';
1516: # output beginning of search page
1517: $result.=<<BEGINNING;
1518: <html>
1519: <head>
1.130 matthew 1520: <title>$title</title>
1.125 matthew 1521: BEGINNING
1522: # conditional output of script functions dependent on the mode in
1523: # which the search was invoked
1524: if ($ENV{'form.catalogmode'} eq 'interactive'){
1525: if (! exists($ENV{'form.mode'}) || $ENV{'form.mode'} ne 'edit') {
1526: $result.=<<SCRIPT;
1527: <script type="text/javascript">
1528: function select_data(title,url) {
1529: changeTitle(title);
1530: changeURL(url);
1531: self.close();
1532: }
1533: function changeTitle(val) {
1534: if (opener.inf.document.forms.resinfo.elements.t) {
1535: opener.inf.document.forms.resinfo.elements.t.value=val;
1536: }
1537: }
1538: function changeURL(val) {
1539: if (opener.inf.document.forms.resinfo.elements.u) {
1540: opener.inf.document.forms.resinfo.elements.u.value=val;
1541: }
1542: }
1543: </script>
1544: SCRIPT
1545: } elsif ($ENV{'form.mode'} eq 'edit') {
1546: my $form = $ENV{'form.form'};
1547: my $element = $ENV{'form.element'};
1548: $result.=<<SCRIPT;
1549: <script type="text/javascript">
1550: function select_data(title,url) {
1551: changeURL(url);
1552: self.close();
1553: }
1554: function changeTitle(val) {
1555: }
1556: function changeURL(val) {
1557: if (window.opener.document) {
1558: window.opener.document.forms["$form"].elements["$element"].value=val;
1559: } else {
1560: var url = 'forms[\"$form\"].elements[\"$element\"].value';
1561: alert("Unable to transfer data to "+url);
1562: }
1563: }
1564: </script>
1565: SCRIPT
1566: }
1567: }
1568: $result.=<<SCRIPT if $ENV{'form.catalogmode'} eq 'groupsearch';
1569: <script type="text/javascript">
1570: function select_data(title,url) {
1571: // alert('DEBUG: Should be storing '+title+' and '+url);
1572: }
1573: function queue(val) {
1574: if (eval("document.forms.results.returnvalues["+val+"].checked")) {
1575: document.forms.results.acts.value+='1a'+val+'b';
1576: }
1577: else {
1578: document.forms.results.acts.value+='0a'+val+'b';
1579: }
1580: }
1581: function select_group() {
1582: window.location=
1583: "/adm/groupsort?mode=$ENV{'form.mode'}&catalogmode=groupsearch&acts="+
1584: document.forms.results.acts.value;
1585: }
1586: </script>
1587: SCRIPT
1588: $result.=<<SCRIPT;
1589: <script type="text/javascript">
1590: function displayinfo(val) {
1591: popwin.document.forms.popremain.sdetails.value=val;
1592: }
1593: function openhelp(val) {
1594: openhelpwin=open('/adm/help/searchcat.html','helpscreen',
1595: 'scrollbars=1,width=400,height=300');
1596: openhelpwin.focus();
1597: }
1598: function abortsearch(val) {
1599: popwin.close();
1600: }
1601: </script>
1602: SCRIPT
1.130 matthew 1603: $result.=<<END;
1604: </head>
1605: <body bgcolor="#ffffff">
1606: <img align=right src=/adm/lonIcons/lonlogos.gif>
1607: <h1>$title</h1>
1608: END
1.125 matthew 1609: return $result;
1610: }
1611:
1612: ######################################################################
1613: ######################################################################
1614:
1615: =pod
1616:
1617: =item &make_popwin()
1618:
1619: Returns html with javascript in it to open up the status window.
1620:
1621: =cut
1622:
1623: ######################################################################
1624: ######################################################################
1625: sub make_popwin {
1626: my %rhash = @_;
1627: my $servernum=(keys %rhash);
1628: my $hcinit;
1629: my $grid="'<br />'+\n";
1630: # $sn is the server number, used ONLY to make sure we have
1631: # rows of 10 each. No longer used to index images.
1632: my $sn=1;
1633: foreach my $sk (sort keys %rhash) {
1634: $grid.="'<a href=\"";
1635: $grid.="javascript:opener.displayinfo('+";
1636: $grid.="\"'\"+'";
1637: $grid.=$sk;
1638: my $hc;
1639: if ($rhash{$sk} eq 'con_lost') {
1.135 matthew 1640: $hc="BAD CONNECTION ";
1.125 matthew 1641: }
1642: else {
1643: $hc="'+\"'\"+\"+hc['$sk']+\"+\"'\"+'";
1644: $hcinit.="hc[\"$sk\"]=\"not yet connected...\";";
1645: }
1646: $grid.=" hitcount=".$hc;
1.127 matthew 1647: $grid.=" domain=".$Apache::lonnet::hostdom{$sk};
1648: $grid.=" IP=".$Apache::lonnet::hostip{$sk};
1.125 matthew 1649: # '+"'"+'">'+
1650: $grid.="'+\"'\"+')\">'+";
1651: $grid.="\n";
1.127 matthew 1652: $grid.="'<img border=\"0\" name=\"img_".$Apache::lonnet::hostdom{$sk}.
1653: '_'.$sk."\" src=\"/adm/lonIcons/srvnull.gif\" alt=\"".$sk.
1654: "\" /></a>'+\n";
1.125 matthew 1655: $grid.="'<br />'+\n" unless $sn%10;
1656: $sn++;
1657: }
1658: my $result.=<<ENDPOP;
1659: <script type="text/javascript">
1660: popwin=open('','popwin','scrollbars=1,width=400,height=220');
1661: popwin.focus();
1662: popwin.document.writeln('<'+'html>');
1663: popwin.document.writeln('<'+'head>');
1664: popwin.document.writeln('<'+'script>');
1665: popwin.document.writeln('hc=new Array();$hcinit');
1666: popwin.document.writeln('<'+'/script>');
1667: popwin.document.writeln('<'+'/head>'+
1668: '<'+'body bgcolor="#FFFFFF">'+
1669: '<'+'image name="whirly" align="right" src="/adm/lonIcons/'+
1670: 'lonanim.gif" '+
1671: 'alt="animated logo" />'+
1672: '<'+'h3>Search Results Progress<'+'/h3>'+
1673: '<'+'form name="popremain">'+
1674: '<'+'tt>'+
1675: '<'+'br clear="all"/><i>PLEASE BE PATIENT</i>'+
1676: '<'+'br />SCANNING $servernum SERVERS'+
1677: '<'+'br clear="all" />Number of record hits found '+
1678: '<'+'input type="text" size="10" name="numhits"'+
1679: ' value="0" />'+
1680: '<'+'br clear="all" />Time elapsed '+
1681: '<'+'input type="text" size="10" name="elapsetime"'+
1682: ' value="0" />'+
1683: '<'+'br />'+
1684: 'SERVER GRID (click on any cell for details)'+
1685: $grid
1686: '<'+'br />'+
1687: 'Server details '+
1688: '<'+'input type="text" size="35" name="sdetails"'+
1689: ' value="" />'+
1690: '<'+'br />'+
1691: ' <'+'input type="button" name="button"'+
1692: ' value="close this window" '+
1693: ' onClick="javascript:opener.abortsearch()" />'+
1694: ' <'+'input type="button" name="button"'+
1695: ' value="help" onClick="javascript:opener.openhelp()" />'+
1696: '<'+'/tt>'+
1697: '<'+'/form>'+
1698: '<'+'/body><'+'/html>');
1699: popwin.document.close();
1700: </script>
1701: ENDPOP
1702: return $result;
1703: }
1704:
1705: ######################################################################
1706: ######################################################################
1707:
1.122 matthew 1708: =pod
1709:
1710: =item Metadata Viewing Functions
1711:
1712: Output is a HTML-ified string.
1713: Input arguments are title, author, subject, url, keywords, version,
1714: notes, short abstract, mime, language, creation date,
1.126 matthew 1715: last revision date, owner, copyright, hostname, and
1.122 matthew 1716: extra custom metadata to show.
1717:
1718: =over 4
1719:
1720: =item &detailed_citation_view()
1721:
1722: =cut
1723:
1724: ######################################################################
1725: ######################################################################
1.50 harris41 1726: sub detailed_citation_view {
1.126 matthew 1727: my %values = @_;
1.50 harris41 1728: my $result=<<END;
1.126 matthew 1729: <h3><a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
1730: target='search_preview'>$values{'title'}</a></h3>
1.56 harris41 1731: <p>
1.130 matthew 1732: <b>$values{'author'}</b>, <i>$values{'owner'}</i><br />
1733:
1734: <b>Subject: </b> $values{'subject'}<br />
1735: <b>Keyword(s): </b> $values{'keywords'}<br />
1736: <b>Notes: </b> $values{'notes'}<br />
1737: <b>MIME Type: </b> $values{'mimetag'}<br />
1738: <b>Language: </b> $values{'language'}<br />
1739: <b>Copyright/Distribution:</b> $values{'cprtag'}<br />
1.78 harris41 1740: </p>
1.126 matthew 1741: $values{'extrashow'}
1.78 harris41 1742: <p>
1.126 matthew 1743: $values{'shortabstract'}
1.50 harris41 1744: </p>
1745: END
1746: return $result;
1747: }
1748:
1.122 matthew 1749: ######################################################################
1750: ######################################################################
1751:
1752: =pod
1753:
1754: =item &summary_view()
1755:
1756: =cut
1757:
1758: ######################################################################
1759: ######################################################################
1.50 harris41 1760: sub summary_view {
1.126 matthew 1761: my %values = @_;
1.50 harris41 1762: my $result=<<END;
1.126 matthew 1763: <a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
1764: target='search_preview'>$values{'author'}</a><br />
1765: $values{'title'}<br />
1766: $values{'owner'} -- $values{'lastrevisiondate'}<br />
1767: $values{'copyrighttag'}<br />
1768: $values{'extrashow'}
1.50 harris41 1769: </p>
1770: END
1771: return $result;
1772: }
1773:
1.122 matthew 1774: ######################################################################
1775: ######################################################################
1776:
1777: =pod
1778:
1779: =item &fielded_format_view()
1780:
1781: =cut
1782:
1783: ######################################################################
1784: ######################################################################
1.50 harris41 1785: sub fielded_format_view {
1.126 matthew 1786: my %values = @_;
1.50 harris41 1787: my $result=<<END;
1.126 matthew 1788: <b>URL: </b> <a href="http://$ENV{'HTTP_HOST'}$values{'url'}"
1789: target='search_preview'>$values{'url'}</a>
1.56 harris41 1790: <br />
1.126 matthew 1791: <b>Title:</b> $values{'title'}<br />
1792: <b>Author(s):</b> $values{'author'}<br />
1793: <b>Subject:</b> $values{'subject'}<br />
1794: <b>Keyword(s):</b> $values{'keywords'}<br />
1795: <b>Notes:</b> $values{'notes'}<br />
1796: <b>MIME Type:</b> $values{'mimetag'}<br />
1797: <b>Language:</b> $values{'language'}<br />
1798: <b>Creation Date:</b> $values{'creationdate'}<br />
1799: <b>Last Revision Date:</b> $values{'lastrevisiondate'}<br />
1800: <b>Publisher/Owner:</b> $values{'owner'}<br />
1801: <b>Copyright/Distribution:</b> $values{'copyrighttag'}<br />
1802: <b>Repository Location:</b> $values{'hostname'}<br />
1803: <b>Abstract:</b> $values{'shortabstract'}<br />
1804: $values{'extrashow'}
1.50 harris41 1805: </p>
1806: END
1807: return $result;
1808: }
1809:
1.122 matthew 1810: ######################################################################
1811: ######################################################################
1812:
1813: =pod
1814:
1815: =item &xml_sgml_view()
1816:
1817: =back
1818:
1819: =cut
1820:
1821: ######################################################################
1822: ######################################################################
1.50 harris41 1823: sub xml_sgml_view {
1.126 matthew 1824: my %values = @_;
1.50 harris41 1825: my $result=<<END;
1.56 harris41 1826: <pre>
1827: <LonCapaResource>
1.126 matthew 1828: <url>$values{'url'}</url>
1829: <title>$values{'title'}</title>
1830: <author>$values{'author'}</author>
1831: <subject>$values{'subject'}</subject>
1832: <keywords>$values{'keywords'}</keywords>
1833: <notes>$values{'notes'}</notes>
1.56 harris41 1834: <mimeInfo>
1.126 matthew 1835: <mime>$values{'mime'}</mime>
1836: <mimetag>$values{'mimetag'}</mimetag>
1.56 harris41 1837: </mimeInfo>
1838: <languageInfo>
1.126 matthew 1839: <language>$values{'lang'}</language>
1840: <languagetag>$values{'language'}</languagetag>
1.56 harris41 1841: </languageInfo>
1.126 matthew 1842: <creationdate>$values{'creationdate'}</creationdate>
1843: <lastrevisiondate>$values{'lastrevisiondate'}</lastrevisiondate>
1844: <owner>$values{'owner'}</owner>
1.56 harris41 1845: <copyrightInfo>
1.126 matthew 1846: <copyright>$values{'copyright'}</copyright>
1847: <copyrighttag>$values{'copyrighttag'}</copyrighttag>
1.56 harris41 1848: </copyrightInfo>
1.126 matthew 1849: <repositoryLocation>$values{'hostname'}</repositoryLocation>
1850: <shortabstract>$values{'shortabstract'}</shortabstract>
1.57 harris41 1851: </LonCapaResource>
1.56 harris41 1852: </pre>
1.126 matthew 1853: $values{'extrashow'}
1.50 harris41 1854: END
1855: return $result;
1.60 harris41 1856: }
1857:
1.122 matthew 1858: ######################################################################
1859: ######################################################################
1860:
1861: =pod
1862:
1863: =item &filled() see if field is filled.
1864:
1865: =cut
1866:
1867: ######################################################################
1868: ######################################################################
1.98 harris41 1869: sub filled {
1870: my ($field)=@_;
1871: if ($field=~/\S/ && $field ne 'any') {
1872: return 1;
1.61 harris41 1873: }
1.98 harris41 1874: else {
1875: return 0;
1.61 harris41 1876: }
1.60 harris41 1877: }
1878:
1.122 matthew 1879: ######################################################################
1880: ######################################################################
1881:
1882: =pod
1883:
1884: =item &output_blank_field_error()
1885:
1886: =cut
1887:
1888: ######################################################################
1889: ######################################################################
1.98 harris41 1890: sub output_blank_field_error {
1891: my ($r)=@_;
1892: # make query information persistent to allow for subsequent revision
1.133 matthew 1893: my $persistent=&make_persistent(\%ENV);
1.98 harris41 1894:
1895: $r->print(<<BEGINNING);
1896: <html>
1897: <head>
1898: <title>The LearningOnline Network with CAPA</title>
1899: BEGINNING
1900: $r->print(<<RESULTS);
1901: </head>
1902: <body bgcolor="#ffffff">
1903: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
1904: <h1>Search Catalog</h1>
1905: <form method="post" action="/adm/searchcat">
1906: $persistent
1907: <input type='button' value='Revise search request'
1908: onClick='this.form.submit();' />
1909: $closebutton
1910: <hr />
1911: <h3>Helpful Message</h3>
1912: <p>
1913: Incorrect search query due to blank entry fields.
1914: You need to fill in the relevant
1915: fields on the search page in order for a query to be
1916: processed.
1917: </p>
1918: </body>
1919: </html>
1920: RESULTS
1921: }
1922:
1.122 matthew 1923: ######################################################################
1924: ######################################################################
1925:
1926: =pod
1927:
1928: =item &output_date_error()
1929:
1930: Output a full html page with an error message.
1931:
1932: =cut
1933:
1934: ######################################################################
1935: ######################################################################
1.60 harris41 1936: sub output_date_error {
1937: my ($r,$message)=@_;
1938: # make query information persistent to allow for subsequent revision
1.133 matthew 1939: my $persistent=&make_persistent(\%ENV);
1.60 harris41 1940:
1.122 matthew 1941: $r->print(<<RESULTS);
1.60 harris41 1942: <html>
1943: <head>
1944: <title>The LearningOnline Network with CAPA</title>
1945: </head>
1946: <body bgcolor="#ffffff">
1.98 harris41 1947: <img align='right' src='/adm/lonIcons/lonlogos.gif' />
1.60 harris41 1948: <h1>Search Catalog</h1>
1949: <form method="post" action="/adm/searchcat">
1950: $persistent
1951: <input type='button' value='Revise search request'
1.98 harris41 1952: onClick='this.form.submit();' />
1.60 harris41 1953: $closebutton
1.98 harris41 1954: <hr />
1.60 harris41 1955: <h3>Helpful Message</h3>
1956: <p>
1957: $message
1958: </p>
1959: </body>
1960: </html>
1961: RESULTS
1.101 harris41 1962: }
1963:
1.122 matthew 1964: ######################################################################
1965: ######################################################################
1966:
1967: =pod
1968:
1969: =item &start_fresh_session()
1970:
1971: Cleans the global %hash by removing all fields which begin with
1972: 'pre_' or 'store'.
1973:
1974: =cut
1975:
1976: ######################################################################
1977: ######################################################################
1.101 harris41 1978: sub start_fresh_session {
1979: delete $hash{'mode_catalog'};
1.109 harris41 1980: foreach (keys %hash) {
1.101 harris41 1981: if ($_ =~ /^pre_/) {
1982: delete $hash{$_};
1983: }
1984: if ($_ =~ /^store/) {
1985: delete $hash{$_};
1986: }
1.109 harris41 1987: }
1.3 harris41 1988: }
1.117 matthew 1989:
1.122 matthew 1990: ######################################################################
1991: ######################################################################
1992:
1993: =pod
1994:
1995: =item &popwin_js() send javascript to popwin
1996:
1997: =cut
1998:
1999: ######################################################################
2000: ######################################################################
1.117 matthew 2001: sub popwin_js {
2002: # Print javascript out to popwin, but make sure we dont generate
2003: # any javascript errors in doing so.
2004: my ($r,$text) = @_;
2005: $r->print(<<"END");
2006: <script type="text/javascript">
2007: if (! popwin.closed) {
2008: $text
2009: }
2010: </script>
2011: END
2012: $r->rflush();
2013: }
2014:
1.122 matthew 2015: ######################################################################
2016: ######################################################################
2017:
2018: =pod
2019:
2020: =item &popwin_imgupdate()
2021:
1.125 matthew 2022: Send a given image (and its location) out to the browser. Takes as
2023: input $r, loncapa server id, and an icon URL.
2024:
1.122 matthew 2025: =cut
2026:
2027: ######################################################################
2028: ######################################################################
1.117 matthew 2029: sub popwin_imgupdate {
1.125 matthew 2030: my ($r,$server,$icon) = @_;
1.127 matthew 2031: &popwin_js($r,'popwin.document.img_'.$Apache::lonnet::hostdom{$server}.
2032: '_'.$server.'.'.'src="/adm/lonIcons/'.$icon.'";');
1.117 matthew 2033: }
1.1 www 2034:
2035: 1;
1.98 harris41 2036:
1.1 www 2037: __END__
1.105 harris41 2038:
1.121 matthew 2039: =pod
1.105 harris41 2040:
1.121 matthew 2041: =back
1.105 harris41 2042:
2043: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>