loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.112: download - view: text, annotated - select for diffs
Thu Dec 13 14:00:37 2001 UTC (22 years, 7 months ago) by harris41
Branches: MAIN
CVS tags: HEAD

use Apache::loncommon added -Scott Harrison

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