loncom/interface/loncommon.pm - view

File: [LON-CAPA] / loncom / interface / loncommon.pm
Revision 1.46: download - view: text, annotated - select for diffs
Fri Jul 12 14:36:16 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

loncommon.pm:
  Removed old thesaurus code, including old global variables.
  Added two global variables:
    %Keywords is a hash of words considered 'keywords' by the thesaurus.
    $thesaurus_db_file holds the path to the thesaurus database file.
  Removed initialization of old thesaurus variables from BEGIN block and added
    initialization of new variables.
  Added:
    &get_related_words($keyword), which will return words related to $keyword.
    &initialize_keywords(), which initializes the %Keywords hash on demand.
  Replaced:
    &keyword() now uses the %Keywords hash, after initializing it.
lonsearchcat.pm:
  Added a checkbox on the advanced search to 'use related words', and
  code to add the words to the users query.  This support is preliminary
  and will change.

1: # The LearningOnline Network with CAPA 2: # a pile of common routines 3: # 4: # $Id: loncommon.pm,v 1.46 2002/07/12 14:36:16 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: # 2/13-12/7 Guy Albertelli 30: # 12/11,12/12,12/17 Scott Harrison 31: # 12/21 Gerd Kortemeyer 32: # 12/21 Scott Harrison 33: # 12/25,12/28 Gerd Kortemeyer 34: # YEAR=2002 35: # 1/4 Gerd Kortemeyer 36: # 6/24,7/2 H. K. Ng 37: 38: # Makes a table out of the previous attempts 39: # Inputs result_from_symbread, user, domain, course_id 40: # Reads in non-network-related .tab files 41: 42: # POD header: 43: 44: =pod 45: 46: =head1 NAME 47: 48: Apache::loncommon - pile of common routines 49: 50: =head1 SYNOPSIS 51: 52: Referenced by other mod_perl Apache modules. 53: 54: Invocation: 55: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS); 56: 57: =head1 INTRODUCTION 58: 59: Common collection of used subroutines. This collection helps remove 60: redundancy from other modules and increase efficiency of memory usage. 61: 62: Current things done: 63: 64: Makes a table out of the previous homework attempts 65: Inputs result_from_symbread, user, domain, course_id 66: Reads in non-network-related .tab files 67: 68: This is part of the LearningOnline Network with CAPA project 69: described at http://www.lon-capa.org. 70: 71: =head2 General Subroutines 72: 73: =over 4 74: 75: =cut 76: 77: # End of POD header 78: package Apache::loncommon; 79: 80: use strict; 81: use Apache::lonnet(); 82: use GDBM_File; 83: use POSIX qw(strftime); 84: use Apache::Constants qw(:common); 85: use Apache::lonmsg(); 86: my $readit; 87: 88: =pod 89: 90: =item Global Variables 91: 92: =over 4 93: 94: =cut 95: # ----------------------------------------------- Filetypes/Languages/Copyright 96: my %language; 97: my %cprtag; 98: my %fe; my %fd; 99: my %category_extensions; 100: 101: # ---------------------------------------------- Thesaurus variables 102: 103: =pod 104: 105: =item %Keywords 106: 107: A hash used by &keyword to determine if a word is considered a keyword. 108: 109: =item $thesaurus_db_file 110: 111: Scalar containing the full path to the thesaurus database. 112: 113: =cut 114: 115: my %Keywords; 116: my $thesaurus_db_file; 117: 118: 119: =pod 120: 121: =back 122: 123: =cut 124: 125: # ----------------------------------------------------------------------- BEGIN 126: 127: =pod 128: 129: =item BEGIN() 130: 131: Initialize values from language.tab, copyright.tab, filetypes.tab, 132: thesaurus.tab, and filecategories.tab. 133: 134: =cut 135: 136: # ----------------------------------------------------------------------- BEGIN 137: 138: BEGIN { 139: # Variable initialization 140: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db"; 141: # 142: unless ($readit) { 143: # ------------------------------------------------------------------- languages 144: { 145: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. 146: '/language.tab'); 147: if ($fh) { 148: while (<$fh>) { 149: next if /^\#/; 150: chomp; 151: my ($key,$val)=(split(/\s+/,$_,2)); 152: $language{$key}=$val; 153: } 154: } 155: } 156: # ------------------------------------------------------------------ copyrights 157: { 158: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}. 159: '/copyright.tab'); 160: if ($fh) { 161: while (<$fh>) { 162: next if /^\#/; 163: chomp; 164: my ($key,$val)=(split(/\s+/,$_,2)); 165: $cprtag{$key}=$val; 166: } 167: } 168: } 169: # ------------------------------------------------------------- file categories 170: { 171: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. 172: '/filecategories.tab'); 173: if ($fh) { 174: while (<$fh>) { 175: next if /^\#/; 176: chomp; 177: my ($extension,$category)=(split(/\s+/,$_,2)); 178: push @{$category_extensions{lc($category)}},$extension; 179: } 180: } 181: } 182: # ------------------------------------------------------------------ file types 183: { 184: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}. 185: '/filetypes.tab'); 186: if ($fh) { 187: while (<$fh>) { 188: next if (/^\#/); 189: chomp; 190: my ($ending,$emb,$descr)=split(/\s+/,$_,3); 191: if ($descr ne '') { 192: $fe{$ending}=lc($emb); 193: $fd{$ending}=$descr; 194: } 195: } 196: } 197: } 198: &Apache::lonnet::logthis( 199: "<font color=yellow>INFO: Read file types</font>"); 200: $readit=1; 201: } # end of unless($readit) 202: 203: } 204: # ============================================================= END BEGIN BLOCK 205: ############################################################### 206: ## HTML and Javascript Helper Functions ## 207: ############################################################### 208: 209: =pod 210: 211: =item browser_and_searcher_javascript 212: 213: Returns scalar containing javascript to open a browser window 214: or a searcher window. Also creates 215: 216: =over 4 217: 218: =item openbrowser(formname,elementname,only,omit) [javascript] 219: 220: inputs: formname, elementname, only, omit 221: 222: formname and elementname indicate the name of the html form and name of 223: the element that the results of the browsing selection are to be placed in. 224: 225: Specifying 'only' will restrict the browser to displaying only files 226: with the given extension. Can be a comma seperated list. 227: 228: Specifying 'omit' will restrict the browser to NOT displaying files 229: with the given extension. Can be a comma seperated list. 230: 231: =item opensearcher(formname, elementname) [javascript] 232: 233: Inputs: formname, elementname 234: 235: formname and elementname specify the name of the html form and the name 236: of the element the selection from the search results will be placed in. 237: 238: =back 239: 240: =cut 241: 242: ############################################################### 243: sub browser_and_searcher_javascript { 244: return <<END; 245: var editbrowser; 246: function openbrowser(formname,elementname,only,omit) { 247: var url = '/res/?'; 248: if (editbrowser == null) { 249: url += 'launch=1&'; 250: } 251: url += 'catalogmode=interactive&'; 252: url += 'mode=edit&'; 253: url += 'form=' + formname + '&'; 254: if (only != null) { 255: url += 'only=' + only + '&'; 256: } 257: if (omit != null) { 258: url += 'omit=' + omit + '&'; 259: } 260: url += 'element=' + elementname + ''; 261: var title = 'Browser'; 262: var options = 'scrollbars=1,resizable=1,menubar=0'; 263: options += ',width=700,height=600'; 264: editbrowser = open(url,title,options,'1'); 265: editbrowser.focus(); 266: } 267: var editsearcher; 268: function opensearcher(formname,elementname) { 269: var url = '/adm/searchcat?'; 270: if (editsearcher == null) { 271: url += 'launch=1&'; 272: } 273: url += 'catalogmode=interactive&'; 274: url += 'mode=edit&'; 275: url += 'form=' + formname + '&'; 276: url += 'element=' + elementname + ''; 277: var title = 'Search'; 278: var options = 'scrollbars=1,resizable=1,menubar=0'; 279: options += ',width=700,height=600'; 280: editsearcher = open(url,title,options,'1'); 281: editsearcher.focus(); 282: } 283: END 284: } 285: 286: 287: 288: ############################################################### 289: 290: =pod 291: 292: =item linked_select_forms(...) 293: 294: linked_select_forms returns a string containing a <script></script> block 295: and html for two <select> menus. The select menus will be linked in that 296: changing the value of the first menu will result in new values being placed 297: in the second menu. The values in the select menu will appear in alphabetical 298: order. 299: 300: linked_select_forms takes the following ordered inputs: 301: 302: =over 4 303: 304: =item $formname, the name of the <form> tag 305: 306: =item $middletext, the text which appears between the <select> tags 307: 308: =item $firstdefault, the default value for the first menu 309: 310: =item $firstselectname, the name of the first <select> tag 311: 312: =item $secondselectname, the name of the second <select> tag 313: 314: =item $hashref, a reference to a hash containing the data for the menus. 315: 316: =back 317: 318: Below is an example of such a hash. Only the 'text', 'default', and 319: 'select2' keys must appear as stated. keys(%menu) are the possible 320: values for the first select menu. The text that coincides with the 321: first menu value is given in $menu{$choice1}->{'text'}. The values 322: and text for the second menu are given in the hash pointed to by 323: $menu{$choice1}->{'select2'}. 324: 325: my %menu = ( A1 => { text =>"Choice A1" , 326: default => "B3", 327: select2 => { 328: B1 => "Choice B1", 329: B2 => "Choice B2", 330: B3 => "Choice B3", 331: B4 => "Choice B4" 332: } 333: }, 334: A2 => { text =>"Choice A2" , 335: default => "C2", 336: select2 => { 337: C1 => "Choice C1", 338: C2 => "Choice C2", 339: C3 => "Choice C3" 340: } 341: }, 342: A3 => { text =>"Choice A3" , 343: default => "D6", 344: select2 => { 345: D1 => "Choice D1", 346: D2 => "Choice D2", 347: D3 => "Choice D3", 348: D4 => "Choice D4", 349: D5 => "Choice D5", 350: D6 => "Choice D6", 351: D7 => "Choice D7" 352: } 353: } 354: ); 355: 356: =cut 357: 358: # ------------------------------------------------ 359: 360: sub linked_select_forms { 361: my ($formname, 362: $middletext, 363: $firstdefault, 364: $firstselectname, 365: $secondselectname, 366: $hashref 367: ) = @_; 368: my $second = "document.$formname.$secondselectname"; 369: my $first = "document.$formname.$firstselectname"; 370: # output the javascript to do the changing 371: my $result = ''; 372: $result.="<script>\n"; 373: $result.="var select2data = new Object();\n"; 374: $" = '","'; 375: my $debug = ''; 376: foreach my $s1 (sort(keys(%$hashref))) { 377: $result.="select2data.d_$s1 = new Object();\n"; 378: $result.="select2data.d_$s1.def = new String('". 379: $hashref->{$s1}->{'default'}."');\n"; 380: $result.="select2data.d_$s1.values = new Array("; 381: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } )); 382: $result.="\"@s2values\");\n"; 383: $result.="select2data.d_$s1.texts = new Array("; 384: my @s2texts; 385: foreach my $value (@s2values) { 386: push @s2texts, $hashref->{$s1}->{'select2'}->{$value}; 387: } 388: $result.="\"@s2texts\");\n"; 389: } 390: $"=' '; 391: $result.= <<"END"; 392: 393: function select1_changed() { 394: // Determine new choice 395: var newvalue = "d_" + $first.value; 396: // update select2 397: var values = select2data[newvalue].values; 398: var texts = select2data[newvalue].texts; 399: var select2def = select2data[newvalue].def; 400: var i; 401: // out with the old 402: for (i = 0; i < $second.options.length; i++) { 403: $second.options[i] = null; 404: } 405: // in with the nuclear 406: for (i=0;i<values.length; i++) { 407: $second.options[i] = new Option(values[i]); 408: $second.options[i].text = texts[i]; 409: if (values[i] == select2def) { 410: $second.options[i].selected = true; 411: } 412: } 413: } 414: </script> 415: END 416: # output the initial values for the selection lists 417: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n"; 418: foreach my $value (sort(keys(%$hashref))) { 419: $result.=" <option value=\"$value\" "; 420: $result.=" selected=\"true\" " if ($value eq $firstdefault); 421: $result.=">$hashref->{$value}->{'text'}</option>\n"; 422: } 423: $result .= "</select>\n"; 424: my %select2 = %{$hashref->{$firstdefault}->{'select2'}}; 425: $result .= $middletext; 426: $result .= "<select size=\"1\" name=\"$secondselectname\">\n"; 427: my $seconddefault = $hashref->{$firstdefault}->{'default'}; 428: foreach my $value (sort(keys(%select2))) { 429: $result.=" <option value=\"$value\" "; 430: $result.=" selected=\"true\" " if ($value eq $seconddefault); 431: $result.=">$select2{$value}</option>\n"; 432: } 433: $result .= "</select>\n"; 434: # return $debug; 435: return $result; 436: } # end of sub linked_select_forms { 437: 438: ############################################################### 439: 440: =pod 441: 442: =item help_open_topic($topic, $stayOnPage, $width, $height) 443: 444: Returns a string corresponding to an HTML link to the given help $topic, where $topic corresponds to the name of a .tex file in /home/httpd/html/adm/help/tex, with underscores replaced by spaces. 445: 446: $stayOnPage is a value that will be interpreted as a boolean. If true, the link will not open a new window. If false, the link will open a new window using Javascript. (Default is false.) 447: 448: $width and $height are optional numerical parameters that will override the width and height of the popped up window, which may be useful for certain help topics with big pictures included. 449: 450: =cut 451: 452: sub help_open_topic { 453: my ($topic, $stayOnPage, $width, $height) = @_; 454: $stayOnPage = 0 if (not defined $stayOnPage); 455: $width = 350 if (not defined $width); 456: $height = 400 if (not defined $height); 457: my $filename = $topic; 458: $filename =~ s/ /_/g; 459: 460: my $template; 461: 462: if (!$stayOnPage) 463: { 464: $template = <<"ENDTEMPLATE"; 465: <a href="javascript:void(open('/adm/help/${filename}.hlp', 'Help for $topic', 'menubar=0,s 466: crollbars=1,width=$width,height=$height'))"><image 467: src="/adm/help/gif/smallHelp.gif" 468: border="0" alt="(Help: $topic)"></a> 469: ENDTEMPLATE 470: } 471: else 472: { 473: $template = <<"ENDTEMPLATE"; 474: <a href="/adm/help/${filename}.hlp"><image 475: src="/adm/help/gif/smallHelp.gif" 476: border="0" alt="(Help: $topic)"></a> 477: ENDTEMPLATE 478: } 479: 480: return $template; 481: 482: } 483: 484: =pod 485: 486: =item csv_translate($text) 487: 488: Translate $text to allow it to be output as a 'comma seperated values' 489: format. 490: 491: =cut 492: 493: sub csv_translate { 494: my $text = shift; 495: $text =~ s/\"/\"\"/g; 496: $text =~ s/\n//g; 497: return $text; 498: } 499: 500: ############################################################### 501: ## Home server <option> list generating code ## 502: ############################################################### 503: #------------------------------------------- 504: 505: =pod 506: 507: =item get_domains() 508: 509: Returns an array containing each of the domains listed in the hosts.tab 510: file. 511: 512: =cut 513: 514: #------------------------------------------- 515: sub get_domains { 516: # The code below was stolen from "The Perl Cookbook", p 102, 1st ed. 517: my @domains; 518: my %seen; 519: foreach (sort values(%Apache::lonnet::hostdom)) { 520: push (@domains,$_) unless $seen{$_}++; 521: } 522: return @domains; 523: } 524: 525: #------------------------------------------- 526: 527: =pod 528: 529: =item select_dom_form($defdom,$name) 530: 531: Returns a string containing a <select name='$name' size='1'> form to 532: allow a user to select the domain to preform an operation in. 533: See loncreateuser.pm for an example invocation and use. 534: 535: =cut 536: 537: #------------------------------------------- 538: sub select_dom_form { 539: my ($defdom,$name) = @_; 540: my @domains = get_domains(); 541: my $selectdomain = "<select name=\"$name\" size=\"1\">\n"; 542: foreach (@domains) { 543: $selectdomain.="<option value=\"$_\" ". 544: ($_ eq $defdom ? 'selected' : ''). 545: ">$_</option>\n"; 546: } 547: $selectdomain.="</select>"; 548: return $selectdomain; 549: } 550: 551: #------------------------------------------- 552: 553: =pod 554: 555: =item get_home_servers($domain) 556: 557: Returns a hash which contains keys like '103l3' and values like 558: 'kirk.lite.msu.edu'. All of the keys will be for machines in the 559: given $domain. 560: 561: =cut 562: 563: #------------------------------------------- 564: sub get_home_servers { 565: my $domain = shift; 566: my %home_servers; 567: foreach (keys(%Apache::lonnet::libserv)) { 568: if ($Apache::lonnet::hostdom{$_} eq $domain) { 569: $home_servers{$_} = $Apache::lonnet::hostname{$_}; 570: } 571: } 572: return %home_servers; 573: } 574: 575: #------------------------------------------- 576: 577: =pod 578: 579: =item home_server_option_list($domain) 580: 581: returns a string which contains an <option> list to be used in a 582: <select> form input. See loncreateuser.pm for an example. 583: 584: =cut 585: 586: #------------------------------------------- 587: sub home_server_option_list { 588: my $domain = shift; 589: my %servers = &get_home_servers($domain); 590: my $result = ''; 591: foreach (sort keys(%servers)) { 592: $result.= 593: '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n"; 594: } 595: return $result; 596: } 597: ############################################################### 598: ## End of home server <option> list generating code ## 599: ############################################################### 600: 601: ############################################################### 602: ## Authentication changing form generation subroutines ## 603: ############################################################### 604: ## 605: ## All of the authform_xxxxxxx subroutines take their inputs in a 606: ## hash, and have reasonable default values. 607: ## 608: ## formname = the name given in the <form> tag. 609: #------------------------------------------- 610: 611: =pod 612: 613: =item authform_xxxxxx 614: 615: The authform_xxxxxx subroutines provide javascript and html forms which 616: handle some of the conveniences required for authentication forms. 617: This is not an optimal method, but it works. 618: 619: See loncreateuser.pm for invocation and use examples. 620: 621: =over 4 622: 623: =item authform_header 624: 625: =item authform_authorwarning 626: 627: =item authform_nochange 628: 629: =item authform_kerberos 630: 631: =item authform_internal 632: 633: =item authform_filesystem 634: 635: =back 636: 637: =cut 638: 639: #------------------------------------------- 640: sub authform_header{ 641: my %in = ( 642: formname => 'cu', 643: kerb_def_dom => 'MSU.EDU', 644: @_, 645: ); 646: $in{'formname'} = 'document.' . $in{'formname'}; 647: my $result=''; 648: $result.=<<"END"; 649: var current = new Object(); 650: current.radiovalue = 'nochange'; 651: current.argfield = null; 652: 653: function changed_radio(choice,currentform) { 654: var choicearg = choice + 'arg'; 655: // If a radio button in changed, we need to change the argfield 656: if (current.radiovalue != choice) { 657: current.radiovalue = choice; 658: if (current.argfield != null) { 659: currentform.elements[current.argfield].value = ''; 660: } 661: if (choice == 'nochange') { 662: current.argfield = null; 663: } else { 664: current.argfield = choicearg; 665: switch(choice) { 666: case 'krb': 667: currentform.elements[current.argfield].value = 668: "$in{'kerb_def_dom'}"; 669: break; 670: default: 671: break; 672: } 673: } 674: } 675: return; 676: } 677: 678: function changed_text(choice,currentform) { 679: var choicearg = choice + 'arg'; 680: if (currentform.elements[choicearg].value !='') { 681: switch (choice) { 682: case 'krb': currentform.elements[choicearg].value = 683: currentform.elements[choicearg].value.toUpperCase(); 684: break; 685: default: 686: } 687: // clear old field 688: if ((current.argfield != choicearg) && (current.argfield != null)) { 689: currentform.elements[current.argfield].value = ''; 690: } 691: current.argfield = choicearg; 692: } 693: set_auth_radio_buttons(choice,currentform); 694: return; 695: } 696: 697: function set_auth_radio_buttons(newvalue,currentform) { 698: var i=0; 699: while (i < currentform.login.length) { 700: if (currentform.login[i].value == newvalue) { break; } 701: i++; 702: } 703: if (i == currentform.login.length) { 704: return; 705: } 706: current.radiovalue = newvalue; 707: currentform.login[i].checked = true; 708: return; 709: } 710: END 711: return $result; 712: } 713: 714: sub authform_authorwarning{ 715: my $result=''; 716: $result=<<"END"; 717: <i>As a general rule, only authors or co-authors should be filesystem 718: authenticated (which allows access to the server filesystem).</i> 719: END 720: return $result; 721: } 722: 723: sub authform_nochange{ 724: my %in = ( 725: formname => 'document.cu', 726: kerb_def_dom => 'MSU.EDU', 727: @_, 728: ); 729: my $result=''; 730: $result.=<<"END"; 731: <input type="radio" name="login" value="nochange" checked="checked" 732: onclick="javascript:changed_radio('nochange',$in{'formname'});"> 733: Do not change login data 734: END 735: return $result; 736: } 737: 738: sub authform_kerberos{ 739: my %in = ( 740: formname => 'document.cu', 741: kerb_def_dom => 'MSU.EDU', 742: @_, 743: ); 744: my $result=''; 745: $result.=<<"END"; 746: <input type="radio" name="login" value="krb" 747: onclick="javascript:changed_radio('krb',$in{'formname'});" 748: onchange="javascript:changed_radio('krb',$in{'formname'});"> 749: Kerberos authenticated with domain 750: <input type="text" size="10" name="krbarg" value="" 751: onchange="javascript:changed_text('krb',$in{'formname'});"> 752: END 753: return $result; 754: } 755: 756: sub authform_internal{ 757: my %args = ( 758: formname => 'document.cu', 759: kerb_def_dom => 'MSU.EDU', 760: @_, 761: ); 762: my $result=''; 763: $result.=<<"END"; 764: <input type="radio" name="login" value="int" 765: onchange="javascript:changed_radio('int',$args{'formname'});" 766: onclick="javascript:changed_radio('int',$args{'formname'});"> 767: Internally authenticated (with initial password 768: <input type="text" size="10" name="intarg" value="" 769: onchange="javascript:changed_text('int',$args{'formname'});"> 770: END 771: return $result; 772: } 773: 774: sub authform_local{ 775: my %in = ( 776: formname => 'document.cu', 777: kerb_def_dom => 'MSU.EDU', 778: @_, 779: ); 780: my $result=''; 781: $result.=<<"END"; 782: <input type="radio" name="login" value="loc" 783: onchange="javascript:changed_radio('loc',$in{'formname'});" 784: onclick="javascript:changed_radio('loc',$in{'formname'});"> 785: Local Authentication with argument 786: <input type="text" size="10" name="locarg" value="" 787: onchange="javascript:changed_text('loc',$in{'formname'});"> 788: END 789: return $result; 790: } 791: 792: sub authform_filesystem{ 793: my %in = ( 794: formname => 'document.cu', 795: kerb_def_dom => 'MSU.EDU', 796: @_, 797: ); 798: my $result=''; 799: $result.=<<"END"; 800: <input type="radio" name="login" value="fsys" 801: onchange="javascript:changed_radio('fsys',$in{'formname'});" 802: onclick="javascript:changed_radio('fsys',$in{'formname'});"> 803: Filesystem authenticated (with initial password 804: <input type="text" size="10" name="fsysarg" value="" 805: onchange="javascript:changed_text('fsys',$in{'formname'});"> 806: END 807: return $result; 808: } 809: 810: ############################################################### 811: ## End Authentication changing form generation functions ## 812: ############################################################### 813: 814: ############################################################### 815: ## Thesaurus Functions ## 816: ############################################################### 817: 818: =pod 819: 820: =item initialize_keywords 821: 822: Initializes the package variable %Keywords if it is empty. Uses the 823: package variable $thesaurus_db_file. 824: 825: =cut 826: 827: ################################################### 828: 829: sub initialize_keywords { 830: return 1 if (scalar keys(%Keywords)); 831: # If we are here, %Keywords is empty, so fill it up 832: # Make sure the file we need exists... 833: if (! -e $thesaurus_db_file) { 834: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file". 835: " failed because it does not exist"); 836: return 0; 837: } 838: # Set up the hash as a database 839: my %thesaurus_db; 840: if (! tie(%thesaurus_db,'GDBM_File', 841: $thesaurus_db_file,&GDBM_READER,0640)){ 842: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ". 843: $thesaurus_db_file); 844: return 0; 845: } 846: # Get the average number of appearances of a word. 847: my $avecount = $thesaurus_db{'average.count'}; 848: # Put keywords (those that appear > average) into %Keywords 849: while (my ($word,$data)=each (%thesaurus_db)) { 850: my ($count,undef) = split /:/,$data; 851: $Keywords{$word}++ if ($count > $avecount); 852: } 853: untie %thesaurus_db; 854: # Remove special values from %Keywords. 855: foreach ('total.count','average.count') { 856: delete($Keywords{$_}) if (exists($Keywords{$_})); 857: } 858: return 1; 859: } 860: 861: ################################################### 862: 863: =pod 864: 865: =item keyword($word) 866: 867: Returns true if $word is a keyword. A keyword is a word that appears more 868: than the average number of times in the thesaurus database. Calls 869: &initialize_keywords 870: 871: =cut 872: 873: ################################################### 874: 875: sub keyword { 876: return if (!&initialize_keywords()); 877: my $word=lc(shift()); 878: $word=~s/\W//g; 879: return exists($Keywords{$word}); 880: } 881: 882: ################################################### 883: # Old code, to be removed soon # 884: ################################################### 885: # -------------------------------------------------------- Return related words 886: #sub related { 887: # my $newword=shift; 888: # $newword=~s/\W//g; 889: # $newword=~tr/A-Z/a-z/; 890: # my $tindex=$theindex{$newword}; 891: # if ($tindex) { 892: # my %found=(); 893: # foreach (split(/\,/,$therelated[$tindex])) { 894: ## - Related word found 895: # my ($ridx,$rcount)=split(/\:/,$_); 896: ## - Direct relation index 897: # my $directrel=$rcount/$thecount[$tindex]; 898: # if ($directrel>$thethreshold) { 899: # foreach (split(/\,/,$therelated[$ridx])) { 900: # my ($rridx,$rrcount)=split(/\:/,$_); 901: # if ($rridx==$tindex) { 902: ## - Determine reverse relation index 903: # my $revrel=$rrcount/$thecount[$ridx]; 904: ## - Calculate full index 905: # $found{$ridx}=$directrel*$revrel; 906: # if ($found{$ridx}>$thethreshold) { 907: # foreach (split(/\,/,$therelated[$ridx])) { 908: # my ($rrridx,$rrrcount)=split(/\:/,$_); 909: # unless ($found{$rrridx}) { 910: # my $revrevrel=$rrrcount/$thecount[$ridx]; 911: # if ( 912: # $directrel*$revrel*$revrevrel>$thethreshold 913: # ) { 914: # $found{$rrridx}= 915: # $directrel*$revrel*$revrevrel; 916: # } 917: # } 918: # } 919: # } 920: # } 921: # } 922: # } 923: # } 924: # } 925: # return (); 926: #} 927: 928: ############################################################### 929: 930: =pod 931: 932: =item get_related_words 933: 934: Look up a word in the thesaurus. Takes a scalar arguement and returns 935: an array of words. If the keyword is not in the thesaurus, an empty array 936: will be returned. The order of the words returned is determined by the 937: database which holds them. 938: 939: Uses global $thesaurus_db_file. 940: 941: =cut 942: 943: ############################################################### 944: 945: sub get_related_words { 946: my $keyword = shift; 947: my %thesaurus_db; 948: if (! -e $thesaurus_db_file) { 949: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ". 950: "failed because the file does not exist"); 951: return (); 952: } 953: if (! tie(%thesaurus_db,'GDBM_File', 954: $thesaurus_db_file,&GDBM_READER,0640)){ 955: return (); 956: } 957: my @Words=(); 958: if (exists($thesaurus_db{$keyword})) { 959: $_ = $thesaurus_db{$keyword}; 960: (undef,@Words) = split/:/; # The first element is the number of times 961: # the word appears. We do not need it now. 962: for (my $i=0;$i<=$#Words;$i++) { 963: ($Words[$i],undef)= split/\,/,$Words[$i]; 964: } 965: } 966: untie %thesaurus_db; 967: return @Words; 968: } 969: 970: ############################################################### 971: ## End Thesaurus Functions ## 972: ############################################################### 973: 974: # ---------------------------------------------------------------- Language IDs 975: sub languageids { 976: return sort(keys(%language)); 977: } 978: 979: # -------------------------------------------------------- Language Description 980: sub languagedescription { 981: return $language{shift(@_)}; 982: } 983: 984: # --------------------------------------------------------------- Copyright IDs 985: sub copyrightids { 986: return sort(keys(%cprtag)); 987: } 988: 989: # ------------------------------------------------------- Copyright Description 990: sub copyrightdescription { 991: return $cprtag{shift(@_)}; 992: } 993: 994: # ------------------------------------------------------------- File Categories 995: sub filecategories { 996: return sort(keys(%category_extensions)); 997: } 998: 999: # -------------------------------------- File Types within a specified category 1000: sub filecategorytypes { 1001: return @{$category_extensions{lc($_[0])}}; 1002: } 1003: 1004: # ------------------------------------------------------------------ File Types 1005: sub fileextensions { 1006: return sort(keys(%fe)); 1007: } 1008: 1009: # ------------------------------------------------------------- Embedding Style 1010: sub fileembstyle { 1011: return $fe{lc(shift(@_))}; 1012: } 1013: 1014: # ------------------------------------------------------------ Description Text 1015: sub filedescription { 1016: return $fd{lc(shift(@_))}; 1017: } 1018: 1019: # ------------------------------------------------------------ Description Text 1020: sub filedescriptionex { 1021: my $ex=shift; 1022: return '.'.$ex.' '.$fd{lc($ex)}; 1023: } 1024: 1025: # ---- Retrieve attempts by students 1026: # input 1027: # $symb - problem including path 1028: # $username,$domain - that of the student 1029: # $course - course name 1030: # $getattempt - leave blank if want all attempts, else put something. 1031: # $regexp - regular expression. If string matches regexp send to 1032: # $gradesub - routine that process the string if it matches regexp 1033: # 1034: # output 1035: # formatted as a table all the attempts, if any. 1036: # 1037: sub get_previous_attempt { 1038: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_; 1039: my $prevattempts=''; 1040: no strict 'refs'; 1041: if ($symb) { 1042: my (%returnhash)= 1043: &Apache::lonnet::restore($symb,$course,$domain,$username); 1044: if ($returnhash{'version'}) { 1045: my %lasthash=(); 1046: my $version; 1047: for ($version=1;$version<=$returnhash{'version'};$version++) { 1048: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) { 1049: $lasthash{$_}=$returnhash{$version.':'.$_}; 1050: } 1051: } 1052: $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">'; 1053: $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>'; 1054: foreach (sort(keys %lasthash)) { 1055: my ($ign,@parts) = split(/\./,$_); 1056: if ($#parts > 0) { 1057: my $data=$parts[-1]; 1058: pop(@parts); 1059: $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.' </td>'; 1060: } else { 1061: if ($#parts == 0) { 1062: $prevattempts.='<th>'.$parts[0].'</th>'; 1063: } else { 1064: $prevattempts.='<th>'.$ign.'</th>'; 1065: } 1066: } 1067: } 1068: if ($getattempt eq '') { 1069: for ($version=1;$version<=$returnhash{'version'};$version++) { 1070: $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>'; 1071: foreach (sort(keys %lasthash)) { 1072: my $value; 1073: if ($_ =~ /timestamp/) { 1074: $value=scalar(localtime($returnhash{$version.':'.$_})); 1075: } else { 1076: $value=$returnhash{$version.':'.$_}; 1077: } 1078: $prevattempts.='<td>'.$value.' </td>'; 1079: } 1080: } 1081: } 1082: $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>'; 1083: foreach (sort(keys %lasthash)) { 1084: my $value; 1085: if ($_ =~ /timestamp/) { 1086: $value=scalar(localtime($lasthash{$_})); 1087: } else { 1088: $value=$lasthash{$_}; 1089: } 1090: if ($_ =~/$regexp$/) {$value = &$gradesub($value)} 1091: $prevattempts.='<td>'.$value.' </td>'; 1092: } 1093: $prevattempts.='</tr></table></td></tr></table>'; 1094: } else { 1095: $prevattempts='Nothing submitted - no attempts.'; 1096: } 1097: } else { 1098: $prevattempts='No data.'; 1099: } 1100: } 1101: 1102: sub get_student_view { 1103: my ($symb,$username,$domain,$courseid) = @_; 1104: my ($map,$id,$feedurl) = split(/___/,$symb); 1105: my (%old,%moreenv); 1106: my @elements=('symb','courseid','domain','username'); 1107: foreach my $element (@elements) { 1108: $old{$element}=$ENV{'form.grade_'.$element}; 1109: $moreenv{'form.grade_'.$element}=eval '$'.$element #' 1110: } 1111: &Apache::lonnet::appenv(%moreenv); 1112: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); 1113: &Apache::lonnet::delenv('form.grade_'); 1114: foreach my $element (@elements) { 1115: $ENV{'form.grade_'.$element}=$old{$element}; 1116: } 1117: $userview=~s/\<body[^\>]*\>//gi; 1118: $userview=~s/\<\/body\>//gi; 1119: $userview=~s/\<html\>//gi; 1120: $userview=~s/\<\/html\>//gi; 1121: $userview=~s/\<head\>//gi; 1122: $userview=~s/\<\/head\>//gi; 1123: $userview=~s/action\s*\=/would_be_action\=/gi; 1124: return $userview; 1125: } 1126: 1127: sub get_student_answers { 1128: my ($symb,$username,$domain,$courseid) = @_; 1129: my ($map,$id,$feedurl) = split(/___/,$symb); 1130: my (%old,%moreenv); 1131: my @elements=('symb','courseid','domain','username'); 1132: foreach my $element (@elements) { 1133: $old{$element}=$ENV{'form.grade_'.$element}; 1134: $moreenv{'form.grade_'.$element}=eval '$'.$element #' 1135: } 1136: $moreenv{'form.grade_target'}='answer'; 1137: &Apache::lonnet::appenv(%moreenv); 1138: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl); 1139: &Apache::lonnet::delenv('form.grade_'); 1140: foreach my $element (@elements) { 1141: $ENV{'form.grade_'.$element}=$old{$element}; 1142: } 1143: return $userview; 1144: } 1145: 1146: ############################################### 1147: 1148: ############################################### 1149: 1150: sub get_unprocessed_cgi { 1151: my ($query,$possible_names)= @_; 1152: # $Apache::lonxml::debug=1; 1153: foreach (split(/&/,$query)) { 1154: my ($name, $value) = split(/=/,$_); 1155: $name = &Apache::lonnet::unescape($name); 1156: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) { 1157: $value =~ tr/+/ /; 1158: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 1159: &Apache::lonxml::debug("Seting :$name: to :$value:"); 1160: unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) }; 1161: } 1162: } 1163: } 1164: 1165: sub cacheheader { 1166: unless ($ENV{'request.method'} eq 'GET') { return ''; } 1167: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); 1168: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" /> 1169: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" /> 1170: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />'; 1171: return $output; 1172: } 1173: 1174: sub no_cache { 1175: my ($r) = @_; 1176: unless ($ENV{'request.method'} eq 'GET') { return ''; } 1177: #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); 1178: $r->no_cache(1); 1179: $r->header_out("Pragma" => "no-cache"); 1180: #$r->header_out("Expires" => $date); 1181: } 1182: 1183: sub add_to_env { 1184: my ($name,$value)=@_; 1185: if (defined($ENV{$name})) { 1186: if (ref($ENV{$name})) { 1187: #already have multiple values 1188: push(@{ $ENV{$name} },$value); 1189: } else { 1190: #first time seeing multiple values, convert hash entry to an arrayref 1191: my $first=$ENV{$name}; 1192: undef($ENV{$name}); 1193: push(@{ $ENV{$name} },$first,$value); 1194: } 1195: } else { 1196: $ENV{$name}=$value; 1197: } 1198: } 1199: 1200: =pod 1201: 1202: =back 1203: 1204: =head2 CSV Upload/Handling functions 1205: 1206: =over 4 1207: 1208: =item upfile_store($r) 1209: 1210: Store uploaded file, $r should be the HTTP Request object, 1211: needs $ENV{'form.upfile'} 1212: returns $datatoken to be put into hidden field 1213: 1214: =cut 1215: 1216: sub upfile_store { 1217: my $r=shift; 1218: $ENV{'form.upfile'}=~s/\r/\n/gs; 1219: $ENV{'form.upfile'}=~s/\f/\n/gs; 1220: $ENV{'form.upfile'}=~s/\n+/\n/gs; 1221: $ENV{'form.upfile'}=~s/\n+$//gs; 1222: 1223: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}. 1224: '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$; 1225: { 1226: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons'). 1227: '/tmp/'.$datatoken.'.tmp'); 1228: print $fh $ENV{'form.upfile'}; 1229: } 1230: return $datatoken; 1231: } 1232: 1233: =item load_tmp_file($r) 1234: 1235: Load uploaded file from tmp, $r should be the HTTP Request object, 1236: needs $ENV{'form.datatoken'}, 1237: sets $ENV{'form.upfile'} to the contents of the file 1238: 1239: =cut 1240: 1241: sub load_tmp_file { 1242: my $r=shift; 1243: my @studentdata=(); 1244: { 1245: my $fh; 1246: if ($fh=Apache::File->new($r->dir_config('lonDaemons'). 1247: '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) { 1248: @studentdata=<$fh>; 1249: } 1250: } 1251: $ENV{'form.upfile'}=join('',@studentdata); 1252: } 1253: 1254: =item upfile_record_sep() 1255: 1256: Separate uploaded file into records 1257: returns array of records, 1258: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'} 1259: 1260: =cut 1261: 1262: sub upfile_record_sep { 1263: if ($ENV{'form.upfiletype'} eq 'xml') { 1264: } else { 1265: return split(/\n/,$ENV{'form.upfile'}); 1266: } 1267: } 1268: 1269: =item record_sep($record) 1270: 1271: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'} 1272: 1273: =cut 1274: 1275: sub record_sep { 1276: my $record=shift; 1277: my %components=(); 1278: if ($ENV{'form.upfiletype'} eq 'xml') { 1279: } elsif ($ENV{'form.upfiletype'} eq 'space') { 1280: my $i=0; 1281: foreach (split(/\s+/,$record)) { 1282: my $field=$_; 1283: $field=~s/^(\"|\')//; 1284: $field=~s/(\"|\')$//; 1285: $components{$i}=$field; 1286: $i++; 1287: } 1288: } elsif ($ENV{'form.upfiletype'} eq 'tab') { 1289: my $i=0; 1290: foreach (split(/\t+/,$record)) { 1291: my $field=$_; 1292: $field=~s/^(\"|\')//; 1293: $field=~s/(\"|\')$//; 1294: $components{$i}=$field; 1295: $i++; 1296: } 1297: } else { 1298: my @allfields=split(/\,/,$record); 1299: my $i=0; 1300: my $j; 1301: for ($j=0;$j<=$#allfields;$j++) { 1302: my $field=$allfields[$j]; 1303: if ($field=~/^\s*(\"|\')/) { 1304: my $delimiter=$1; 1305: while (($field!~/$delimiter$/) && ($j<$#allfields)) { 1306: $j++; 1307: $field.=','.$allfields[$j]; 1308: } 1309: $field=~s/^\s*$delimiter//; 1310: $field=~s/$delimiter\s*$//; 1311: } 1312: $components{$i}=$field; 1313: $i++; 1314: } 1315: } 1316: return %components; 1317: } 1318: 1319: =item upfile_select_html() 1320: 1321: return HTML code to select file and specify its type 1322: 1323: =cut 1324: 1325: sub upfile_select_html { 1326: return (<<'ENDUPFORM'); 1327: <input type="file" name="upfile" size="50"> 1328: <br />Type: <select name="upfiletype"> 1329: <option value="csv">CSV (comma separated values, spreadsheet)</option> 1330: <option value="space">Space separated</option> 1331: <option value="tab">Tabulator separated</option> 1332: <option value="xml">HTML/XML</option> 1333: </select> 1334: ENDUPFORM 1335: } 1336: 1337: =item csv_print_samples($r,$records) 1338: 1339: Prints a table of sample values from each column uploaded $r is an 1340: Apache Request ref, $records is an arrayref from 1341: &Apache::loncommon::upfile_record_sep 1342: 1343: =cut 1344: 1345: sub csv_print_samples { 1346: my ($r,$records) = @_; 1347: my (%sone,%stwo,%sthree); 1348: %sone=&record_sep($$records[0]); 1349: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} 1350: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} 1351: 1352: $r->print('Samples<br /><table border="2"><tr>'); 1353: foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); } 1354: $r->print('</tr>'); 1355: foreach my $hash (\%sone,\%stwo,\%sthree) { 1356: $r->print('<tr>'); 1357: foreach (sort({$a <=> $b} keys(%sone))) { 1358: $r->print('<td>'); 1359: if (defined($$hash{$_})) { $r->print($$hash{$_}); } 1360: $r->print('</td>'); 1361: } 1362: $r->print('</tr>'); 1363: } 1364: $r->print('</tr></table><br />'."\n"); 1365: } 1366: 1367: =item csv_print_select_table($r,$records,$d) 1368: 1369: Prints a table to create associations between values and table columns. 1370: $r is an Apache Request ref, 1371: $records is an arrayref from &Apache::loncommon::upfile_record_sep, 1372: $d is an array of 2 element arrays (internal name, displayed name) 1373: 1374: =cut 1375: 1376: sub csv_print_select_table { 1377: my ($r,$records,$d) = @_; 1378: my $i=0;my %sone; 1379: %sone=&record_sep($$records[0]); 1380: $r->print('Associate columns with student attributes.'."\n". 1381: '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n"); 1382: foreach (@$d) { 1383: my ($value,$display)=@{ $_ }; 1384: $r->print('<tr><td>'.$display.'</td>'); 1385: 1386: $r->print('<td><select name=f'.$i. 1387: ' onchange="javascript:flip(this.form,'.$i.');">'); 1388: $r->print('<option value="none"></option>'); 1389: foreach (sort({$a <=> $b} keys(%sone))) { 1390: $r->print('<option value="'.$_.'">Column '.($_+1).'</option>'); 1391: } 1392: $r->print('</select></td></tr>'."\n"); 1393: $i++; 1394: } 1395: $i--; 1396: return $i; 1397: } 1398: 1399: =item csv_samples_select_table($r,$records,$d) 1400: 1401: Prints a table of sample values from the upload and can make associate samples to internal names. 1402: 1403: $r is an Apache Request ref, 1404: $records is an arrayref from &Apache::loncommon::upfile_record_sep, 1405: $d is an array of 2 element arrays (internal name, displayed name) 1406: 1407: =cut 1408: 1409: sub csv_samples_select_table { 1410: my ($r,$records,$d) = @_; 1411: my %sone; my %stwo; my %sthree; 1412: my $i=0; 1413: 1414: $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>'); 1415: %sone=&record_sep($$records[0]); 1416: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} 1417: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} 1418: 1419: foreach (sort keys %sone) { 1420: $r->print('<tr><td><select name=f'.$i. 1421: ' onchange="javascript:flip(this.form,'.$i.');">'); 1422: foreach (@$d) { 1423: my ($value,$display)=@{ $_ }; 1424: $r->print('<option value='.$value.'>'.$display.'</option>'); 1425: } 1426: $r->print('</select></td><td>'); 1427: if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); } 1428: if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); } 1429: if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); } 1430: $r->print('</td></tr>'); 1431: $i++; 1432: } 1433: $i--; 1434: return($i); 1435: } 1436: 1; 1437: __END__; 1438: 1439: =pod 1440: 1441: =back 1442: 1443: =head2 Access .tab File Data 1444: 1445: =over 4 1446: 1447: =item languageids() 1448: 1449: returns list of all language ids 1450: 1451: =item languagedescription() 1452: 1453: returns description of a specified language id 1454: 1455: =item copyrightids() 1456: 1457: returns list of all copyrights 1458: 1459: =item copyrightdescription() 1460: 1461: returns description of a specified copyright id 1462: 1463: =item filecategories() 1464: 1465: returns list of all file categories 1466: 1467: =item filecategorytypes() 1468: 1469: returns list of file types belonging to a given file 1470: category 1471: 1472: =item fileembstyle() 1473: 1474: returns embedding style for a specified file type 1475: 1476: =item filedescription() 1477: 1478: returns description for a specified file type 1479: 1480: =item filedescriptionex() 1481: 1482: returns description for a specified file type with 1483: extra formatting 1484: 1485: =back 1486: 1487: =head2 Alternate Problem Views 1488: 1489: =over 4 1490: 1491: =item get_previous_attempt() 1492: 1493: return string with previous attempt on problem 1494: 1495: =item get_student_view() 1496: 1497: show a snapshot of what student was looking at 1498: 1499: =item get_student_answers() 1500: 1501: show a snapshot of how student was answering problem 1502: 1503: =back 1504: 1505: =head2 HTTP Helper 1506: 1507: =over 4 1508: 1509: =item get_unprocessed_cgi($query,$possible_names) 1510: 1511: Modify the %ENV hash to contain unprocessed CGI form parameters held in 1512: $query. The parameters listed in $possible_names (an array reference), 1513: will be set in $ENV{'form.name'} if they do not already exist. 1514: 1515: Typically called with $ENV{'QUERY_STRING'} as the first parameter. 1516: $possible_names is an ref to an array of form element names. As an example: 1517: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']); 1518: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set. 1519: 1520: =item cacheheader() 1521: 1522: returns cache-controlling header code 1523: 1524: =item nocache() 1525: 1526: specifies header code to not have cache 1527: 1528: =item add_to_env($name,$value) 1529: 1530: adds $name to the %ENV hash with value 1531: $value, if $name already exists, the entry is converted to an array 1532: reference and $value is added to the array. 1533: 1534: =back 1535: 1536: =cut