loncom/interface/lonsearchcat.pm - view

File: [LON-CAPA] / loncom / interface / lonsearchcat.pm
Revision 1.116: download - view: text, annotated - select for diffs
Thu Mar 7 20:12:36 2002 UTC (22 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Minor cleanups, preparing for the road ahead.

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