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