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