Annotation of loncom/interface/loncommon.pm, revision 1.86
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.86 ! www 4: # $Id: loncommon.pm,v 1.85 2003/02/25 21:54:14 albertel 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.18 www 30: # 12/21 Gerd Kortemeyer
1.22 www 31: # 12/25,12/28 Gerd Kortemeyer
1.23 www 32: # YEAR=2002
33: # 1/4 Gerd Kortemeyer
1.43 ng 34: # 6/24,7/2 H. K. Ng
1.1 albertel 35:
36: # Makes a table out of the previous attempts
1.2 albertel 37: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 38: # Reads in non-network-related .tab files
1.1 albertel 39:
1.35 matthew 40: # POD header:
41:
1.45 matthew 42: =pod
43:
1.35 matthew 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.46 matthew 80: use GDBM_File;
1.51 www 81: use POSIX qw(strftime mktime);
1.1 albertel 82: use Apache::Constants qw(:common);
83: use Apache::lonmsg();
1.82 www 84: use Apache::lonmenu();
1.22 www 85: my $readit;
86:
1.46 matthew 87: =pod
88:
89: =item Global Variables
90:
91: =over 4
92:
93: =cut
1.20 www 94: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 95: my %language;
96: my %cprtag;
97: my %fe; my %fd;
1.41 ng 98: my %category_extensions;
1.12 harris41 99:
1.63 www 100: # ---------------------------------------------- Designs
101:
102: my %designhash;
103:
1.46 matthew 104: # ---------------------------------------------- Thesaurus variables
105:
106: =pod
107:
108: =item %Keywords
109:
110: A hash used by &keyword to determine if a word is considered a keyword.
111:
112: =item $thesaurus_db_file
113:
114: Scalar containing the full path to the thesaurus database.
115:
116: =cut
117:
118: my %Keywords;
119: my $thesaurus_db_file;
120:
121:
122: =pod
123:
124: =back
125:
126: =cut
1.20 www 127:
1.12 harris41 128: # ----------------------------------------------------------------------- BEGIN
1.41 ng 129:
130: =pod
131:
1.35 matthew 132: =item BEGIN()
133:
134: Initialize values from language.tab, copyright.tab, filetypes.tab,
1.45 matthew 135: thesaurus.tab, and filecategories.tab.
1.35 matthew 136:
137: =cut
1.45 matthew 138:
1.35 matthew 139: # ----------------------------------------------------------------------- BEGIN
140:
1.18 www 141: BEGIN {
1.46 matthew 142: # Variable initialization
143: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
144: #
1.22 www 145: unless ($readit) {
1.12 harris41 146: # ------------------------------------------------------------------- languages
147: {
148: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
149: '/language.tab');
1.16 harris41 150: if ($fh) {
151: while (<$fh>) {
152: next if /^\#/;
153: chomp;
154: my ($key,$val)=(split(/\s+/,$_,2));
155: $language{$key}=$val;
156: }
1.12 harris41 157: }
158: }
159: # ------------------------------------------------------------------ copyrights
160: {
1.16 harris41 161: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
162: '/copyright.tab');
163: if ($fh) {
164: while (<$fh>) {
165: next if /^\#/;
166: chomp;
167: my ($key,$val)=(split(/\s+/,$_,2));
168: $cprtag{$key}=$val;
169: }
1.12 harris41 170: }
171: }
1.63 www 172:
173: # -------------------------------------------------------------- domain designs
174:
175: my $filename;
176: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
177: opendir(DIR,$designdir);
178: while ($filename=readdir(DIR)) {
179: my ($domain)=($filename=~/^(\w+)\./);
180: {
181: my $fh=Apache::File->new($designdir.'/'.$filename);
182: if ($fh) {
183: while (<$fh>) {
184: next if /^\#/;
185: chomp;
186: my ($key,$val)=(split(/\=/,$_));
187: if ($val) { $designhash{$domain.'.'.$key}=$val; }
188: }
189: }
190: }
191:
192: }
193: closedir(DIR);
194:
195:
1.15 harris41 196: # ------------------------------------------------------------- file categories
197: {
198: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
1.16 harris41 199: '/filecategories.tab');
200: if ($fh) {
201: while (<$fh>) {
202: next if /^\#/;
203: chomp;
1.41 ng 204: my ($extension,$category)=(split(/\s+/,$_,2));
205: push @{$category_extensions{lc($category)}},$extension;
1.16 harris41 206: }
1.15 harris41 207: }
208: }
1.12 harris41 209: # ------------------------------------------------------------------ file types
210: {
1.16 harris41 211: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
212: '/filetypes.tab');
213: if ($fh) {
214: while (<$fh>) {
215: next if (/^\#/);
216: chomp;
217: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
218: if ($descr ne '') {
219: $fe{$ending}=lc($emb);
220: $fd{$ending}=$descr;
221: }
1.12 harris41 222: }
223: }
224: }
1.22 www 225: &Apache::lonnet::logthis(
1.46 matthew 226: "<font color=yellow>INFO: Read file types</font>");
1.22 www 227: $readit=1;
1.46 matthew 228: } # end of unless($readit)
1.32 matthew 229:
230: }
231: # ============================================================= END BEGIN BLOCK
1.42 matthew 232: ###############################################################
233: ## HTML and Javascript Helper Functions ##
234: ###############################################################
235:
236: =pod
237:
238: =item browser_and_searcher_javascript
239:
240: Returns scalar containing javascript to open a browser window
241: or a searcher window. Also creates
242:
243: =over 4
244:
245: =item openbrowser(formname,elementname,only,omit) [javascript]
246:
247: inputs: formname, elementname, only, omit
248:
249: formname and elementname indicate the name of the html form and name of
250: the element that the results of the browsing selection are to be placed in.
251:
252: Specifying 'only' will restrict the browser to displaying only files
253: with the given extension. Can be a comma seperated list.
254:
255: Specifying 'omit' will restrict the browser to NOT displaying files
256: with the given extension. Can be a comma seperated list.
257:
258: =item opensearcher(formname, elementname) [javascript]
259:
260: Inputs: formname, elementname
261:
262: formname and elementname specify the name of the html form and the name
263: of the element the selection from the search results will be placed in.
264:
265: =back
266:
267: =cut
268:
269: ###############################################################
270: sub browser_and_searcher_javascript {
271: return <<END;
1.50 matthew 272: var editbrowser = null;
1.42 matthew 273: function openbrowser(formname,elementname,only,omit) {
274: var url = '/res/?';
275: if (editbrowser == null) {
276: url += 'launch=1&';
277: }
278: url += 'catalogmode=interactive&';
279: url += 'mode=edit&';
280: url += 'form=' + formname + '&';
281: if (only != null) {
282: url += 'only=' + only + '&';
283: }
284: if (omit != null) {
285: url += 'omit=' + omit + '&';
286: }
287: url += 'element=' + elementname + '';
288: var title = 'Browser';
289: var options = 'scrollbars=1,resizable=1,menubar=0';
290: options += ',width=700,height=600';
291: editbrowser = open(url,title,options,'1');
292: editbrowser.focus();
293: }
294: var editsearcher;
295: function opensearcher(formname,elementname) {
296: var url = '/adm/searchcat?';
297: if (editsearcher == null) {
298: url += 'launch=1&';
299: }
300: url += 'catalogmode=interactive&';
301: url += 'mode=edit&';
302: url += 'form=' + formname + '&';
303: url += 'element=' + elementname + '';
304: var title = 'Search';
305: var options = 'scrollbars=1,resizable=1,menubar=0';
306: options += ',width=700,height=600';
307: editsearcher = open(url,title,options,'1');
308: editsearcher.focus();
309: }
310: END
311: }
312:
1.74 www 313: sub studentbrowser_javascript {
314: unless ($ENV{'request.course.id'}) { return ''; }
315: unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
316: return '';
317: }
318: return (<<'ENDSTDBRW');
319: <script type="text/javascript" language="Javascript" >
320: var stdeditbrowser;
321: function openstdbrowser(formname,uname,udom) {
322: var url = '/adm/pickstudent?';
323: var filter;
324: eval('filter=document.'+formname+'.'+uname+'.value;');
325: if (filter != null) {
326: if (filter != '') {
327: url += 'filter='+filter+'&';
328: }
329: }
330: url += 'form=' + formname + '&unameelement='+uname+
331: '&udomelement='+udom;
332: var title = 'Student Browser';
333: var options = 'scrollbars=1,resizable=1,menubar=0';
334: options += ',width=700,height=600';
335: stdeditbrowser = open(url,title,options,'1');
336: stdeditbrowser.focus();
337: }
338: </script>
339: ENDSTDBRW
340: }
1.42 matthew 341:
1.74 www 342: sub selectstudent_link {
343: my ($form,$unameele,$udomele)=@_;
344: unless ($ENV{'request.course.id'}) { return ''; }
345: unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
346: return '';
347: }
348: return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
349: '","'.$udomele.'");'."'>Select</a>";
350: }
1.42 matthew 351:
352: ###############################################################
353:
354: =pod
1.36 matthew 355:
356: =item linked_select_forms(...)
357:
358: linked_select_forms returns a string containing a <script></script> block
359: and html for two <select> menus. The select menus will be linked in that
360: changing the value of the first menu will result in new values being placed
361: in the second menu. The values in the select menu will appear in alphabetical
362: order.
363:
364: linked_select_forms takes the following ordered inputs:
365:
366: =over 4
367:
368: =item $formname, the name of the <form> tag
369:
370: =item $middletext, the text which appears between the <select> tags
371:
372: =item $firstdefault, the default value for the first menu
373:
374: =item $firstselectname, the name of the first <select> tag
375:
376: =item $secondselectname, the name of the second <select> tag
377:
378: =item $hashref, a reference to a hash containing the data for the menus.
379:
1.41 ng 380: =back
381:
1.36 matthew 382: Below is an example of such a hash. Only the 'text', 'default', and
383: 'select2' keys must appear as stated. keys(%menu) are the possible
384: values for the first select menu. The text that coincides with the
1.41 ng 385: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 386: and text for the second menu are given in the hash pointed to by
387: $menu{$choice1}->{'select2'}.
388:
1.41 ng 389: my %menu = ( A1 => { text =>"Choice A1" ,
1.36 matthew 390: default => "B3",
391: select2 => {
392: B1 => "Choice B1",
393: B2 => "Choice B2",
394: B3 => "Choice B3",
395: B4 => "Choice B4"
396: }
397: },
398: A2 => { text =>"Choice A2" ,
399: default => "C2",
400: select2 => {
401: C1 => "Choice C1",
402: C2 => "Choice C2",
403: C3 => "Choice C3"
404: }
405: },
406: A3 => { text =>"Choice A3" ,
407: default => "D6",
408: select2 => {
409: D1 => "Choice D1",
410: D2 => "Choice D2",
411: D3 => "Choice D3",
412: D4 => "Choice D4",
413: D5 => "Choice D5",
414: D6 => "Choice D6",
415: D7 => "Choice D7"
416: }
417: }
418: );
419:
420: =cut
421:
422: # ------------------------------------------------
423:
424: sub linked_select_forms {
425: my ($formname,
426: $middletext,
427: $firstdefault,
428: $firstselectname,
429: $secondselectname,
430: $hashref
431: ) = @_;
432: my $second = "document.$formname.$secondselectname";
433: my $first = "document.$formname.$firstselectname";
434: # output the javascript to do the changing
435: my $result = '';
436: $result.="<script>\n";
437: $result.="var select2data = new Object();\n";
438: $" = '","';
439: my $debug = '';
440: foreach my $s1 (sort(keys(%$hashref))) {
441: $result.="select2data.d_$s1 = new Object();\n";
442: $result.="select2data.d_$s1.def = new String('".
443: $hashref->{$s1}->{'default'}."');\n";
444: $result.="select2data.d_$s1.values = new Array(";
445: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
446: $result.="\"@s2values\");\n";
447: $result.="select2data.d_$s1.texts = new Array(";
448: my @s2texts;
449: foreach my $value (@s2values) {
450: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
451: }
452: $result.="\"@s2texts\");\n";
453: }
454: $"=' ';
455: $result.= <<"END";
456:
457: function select1_changed() {
458: // Determine new choice
459: var newvalue = "d_" + $first.value;
460: // update select2
461: var values = select2data[newvalue].values;
462: var texts = select2data[newvalue].texts;
463: var select2def = select2data[newvalue].def;
464: var i;
465: // out with the old
466: for (i = 0; i < $second.options.length; i++) {
467: $second.options[i] = null;
468: }
469: // in with the nuclear
470: for (i=0;i<values.length; i++) {
471: $second.options[i] = new Option(values[i]);
472: $second.options[i].text = texts[i];
473: if (values[i] == select2def) {
474: $second.options[i].selected = true;
475: }
476: }
477: }
478: </script>
479: END
480: # output the initial values for the selection lists
481: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
482: foreach my $value (sort(keys(%$hashref))) {
483: $result.=" <option value=\"$value\" ";
484: $result.=" selected=\"true\" " if ($value eq $firstdefault);
485: $result.=">$hashref->{$value}->{'text'}</option>\n";
486: }
487: $result .= "</select>\n";
488: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
489: $result .= $middletext;
490: $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
491: my $seconddefault = $hashref->{$firstdefault}->{'default'};
492: foreach my $value (sort(keys(%select2))) {
493: $result.=" <option value=\"$value\" ";
494: $result.=" selected=\"true\" " if ($value eq $seconddefault);
495: $result.=">$select2{$value}</option>\n";
496: }
497: $result .= "</select>\n";
498: # return $debug;
499: return $result;
500: } # end of sub linked_select_forms {
501:
1.33 matthew 502: ###############################################################
1.44 bowersj2 503:
1.45 matthew 504: =pod
1.44 bowersj2 505:
1.48 bowersj2 506: =item help_open_topic($topic, $text, $stayOnPage, $width, $height)
1.44 bowersj2 507:
508: 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.
509:
1.48 bowersj2 510: $text will optionally be linked to the same topic, allowing you to link text in addition to the graphic. If you do not want to link text, but wish to specify one of the later parameters, pass an empty string.
511:
1.44 bowersj2 512: $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.)
513:
514: $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.
515:
516: =cut
517:
518: sub help_open_topic {
1.48 bowersj2 519: my ($topic, $text, $stayOnPage, $width, $height) = @_;
520: $text = "" if (not defined $text);
1.44 bowersj2 521: $stayOnPage = 0 if (not defined $stayOnPage);
1.79 www 522: if ($ENV{'browser.interface'} eq 'textual') {
523: $stayOnPage=1;
524: }
1.44 bowersj2 525: $width = 350 if (not defined $width);
526: $height = 400 if (not defined $height);
527: my $filename = $topic;
528: $filename =~ s/ /_/g;
529:
1.48 bowersj2 530: my $template = "";
531: my $link;
1.44 bowersj2 532:
533: if (!$stayOnPage)
534: {
1.72 bowersj2 535: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.44 bowersj2 536: }
537: else
538: {
1.48 bowersj2 539: $link = "/adm/help/${filename}.hlp";
540: }
541:
542: # Add the text
543: if ($text ne "")
544: {
1.77 www 545: $template .=
546: "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>".
1.78 www 547: "<td bgcolor='#5555FF'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
1.48 bowersj2 548: }
549:
550: # Add the graphic
551: $template .= <<"ENDTEMPLATE";
1.77 www 552: <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
1.44 bowersj2 553: ENDTEMPLATE
1.78 www 554: if ($text ne '') { $template.='</td></tr></table>' };
1.44 bowersj2 555: return $template;
556:
557: }
1.37 matthew 558:
1.45 matthew 559: =pod
560:
1.37 matthew 561: =item csv_translate($text)
562:
563: Translate $text to allow it to be output as a 'comma seperated values'
564: format.
565:
566: =cut
567:
568: sub csv_translate {
569: my $text = shift;
570: $text =~ s/\"/\"\"/g;
571: $text =~ s/\n//g;
572: return $text;
573: }
574:
575: ###############################################################
1.33 matthew 576: ## Home server <option> list generating code ##
577: ###############################################################
1.35 matthew 578: #-------------------------------------------
579:
1.45 matthew 580: =pod
581:
1.35 matthew 582: =item get_domains()
583:
584: Returns an array containing each of the domains listed in the hosts.tab
585: file.
586:
587: =cut
588:
589: #-------------------------------------------
1.34 matthew 590: sub get_domains {
591: # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.
592: my @domains;
593: my %seen;
594: foreach (sort values(%Apache::lonnet::hostdom)) {
595: push (@domains,$_) unless $seen{$_}++;
596: }
597: return @domains;
598: }
599:
1.35 matthew 600: #-------------------------------------------
601:
1.45 matthew 602: =pod
603:
1.35 matthew 604: =item select_dom_form($defdom,$name)
605:
606: Returns a string containing a <select name='$name' size='1'> form to
607: allow a user to select the domain to preform an operation in.
608: See loncreateuser.pm for an example invocation and use.
609:
610: =cut
611:
612: #-------------------------------------------
1.34 matthew 613: sub select_dom_form {
614: my ($defdom,$name) = @_;
615: my @domains = get_domains();
616: my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
617: foreach (@domains) {
618: $selectdomain.="<option value=\"$_\" ".
619: ($_ eq $defdom ? 'selected' : '').
620: ">$_</option>\n";
621: }
622: $selectdomain.="</select>";
623: return $selectdomain;
624: }
625:
1.35 matthew 626: #-------------------------------------------
627:
1.45 matthew 628: =pod
629:
1.52 matthew 630: =item get_library_servers($domain)
1.35 matthew 631:
632: Returns a hash which contains keys like '103l3' and values like
633: 'kirk.lite.msu.edu'. All of the keys will be for machines in the
634: given $domain.
635:
636: =cut
637:
638: #-------------------------------------------
1.52 matthew 639: sub get_library_servers {
1.33 matthew 640: my $domain = shift;
1.52 matthew 641: my %library_servers;
1.33 matthew 642: foreach (keys(%Apache::lonnet::libserv)) {
643: if ($Apache::lonnet::hostdom{$_} eq $domain) {
1.52 matthew 644: $library_servers{$_} = $Apache::lonnet::hostname{$_};
1.33 matthew 645: }
646: }
1.52 matthew 647: return %library_servers;
1.33 matthew 648: }
649:
1.35 matthew 650: #-------------------------------------------
651:
1.45 matthew 652: =pod
653:
1.35 matthew 654: =item home_server_option_list($domain)
655:
656: returns a string which contains an <option> list to be used in a
657: <select> form input. See loncreateuser.pm for an example.
658:
659: =cut
660:
661: #-------------------------------------------
1.33 matthew 662: sub home_server_option_list {
663: my $domain = shift;
1.52 matthew 664: my %servers = &get_library_servers($domain);
1.33 matthew 665: my $result = '';
666: foreach (sort keys(%servers)) {
667: $result.=
668: '<option value="'.$_.'">'.$_.' '.$servers{$_}."</option>\n";
669: }
670: return $result;
671: }
672: ###############################################################
673: ## End of home server <option> list generating code ##
674: ###############################################################
1.32 matthew 675:
676: ###############################################################
677: ## Authentication changing form generation subroutines ##
678: ###############################################################
679: ##
680: ## All of the authform_xxxxxxx subroutines take their inputs in a
681: ## hash, and have reasonable default values.
682: ##
683: ## formname = the name given in the <form> tag.
1.35 matthew 684: #-------------------------------------------
685:
1.45 matthew 686: =pod
687:
1.35 matthew 688: =item authform_xxxxxx
689:
690: The authform_xxxxxx subroutines provide javascript and html forms which
691: handle some of the conveniences required for authentication forms.
692: This is not an optimal method, but it works.
693:
694: See loncreateuser.pm for invocation and use examples.
695:
696: =over 4
697:
698: =item authform_header
699:
700: =item authform_authorwarning
701:
702: =item authform_nochange
703:
704: =item authform_kerberos
705:
706: =item authform_internal
707:
708: =item authform_filesystem
709:
710: =back
711:
712: =cut
713:
714: #-------------------------------------------
1.32 matthew 715: sub authform_header{
716: my %in = (
717: formname => 'cu',
1.80 albertel 718: kerb_def_dom => '',
1.32 matthew 719: @_,
720: );
721: $in{'formname'} = 'document.' . $in{'formname'};
722: my $result='';
1.80 albertel 723:
724: #---------------------------------------------- Code for upper case translation
725: my $Javascript_toUpperCase;
726: unless ($in{kerb_def_dom}) {
727: $Javascript_toUpperCase =<<"END";
728: switch (choice) {
729: case 'krb': currentform.elements[choicearg].value =
730: currentform.elements[choicearg].value.toUpperCase();
731: break;
732: default:
733: }
734: END
735: } else {
736: $Javascript_toUpperCase = "";
737: }
738:
1.32 matthew 739: $result.=<<"END";
740: var current = new Object();
741: current.radiovalue = 'nochange';
742: current.argfield = null;
743:
744: function changed_radio(choice,currentform) {
745: var choicearg = choice + 'arg';
746: // If a radio button in changed, we need to change the argfield
747: if (current.radiovalue != choice) {
748: current.radiovalue = choice;
749: if (current.argfield != null) {
750: currentform.elements[current.argfield].value = '';
751: }
752: if (choice == 'nochange') {
753: current.argfield = null;
754: } else {
755: current.argfield = choicearg;
756: switch(choice) {
757: case 'krb':
758: currentform.elements[current.argfield].value =
759: "$in{'kerb_def_dom'}";
760: break;
761: default:
762: break;
763: }
764: }
765: }
766: return;
767: }
1.22 www 768:
1.32 matthew 769: function changed_text(choice,currentform) {
770: var choicearg = choice + 'arg';
771: if (currentform.elements[choicearg].value !='') {
1.80 albertel 772: $Javascript_toUpperCase
1.32 matthew 773: // clear old field
774: if ((current.argfield != choicearg) && (current.argfield != null)) {
775: currentform.elements[current.argfield].value = '';
776: }
777: current.argfield = choicearg;
778: }
779: set_auth_radio_buttons(choice,currentform);
780: return;
1.20 www 781: }
1.32 matthew 782:
783: function set_auth_radio_buttons(newvalue,currentform) {
784: var i=0;
785: while (i < currentform.login.length) {
786: if (currentform.login[i].value == newvalue) { break; }
787: i++;
788: }
789: if (i == currentform.login.length) {
790: return;
791: }
792: current.radiovalue = newvalue;
793: currentform.login[i].checked = true;
794: return;
795: }
796: END
797: return $result;
798: }
799:
800: sub authform_authorwarning{
801: my $result='';
802: $result=<<"END";
803: <i>As a general rule, only authors or co-authors should be filesystem
804: authenticated (which allows access to the server filesystem).</i>
805: END
806: return $result;
807: }
808:
809: sub authform_nochange{
810: my %in = (
811: formname => 'document.cu',
812: kerb_def_dom => 'MSU.EDU',
813: @_,
814: );
815: my $result='';
816: $result.=<<"END";
817: <input type="radio" name="login" value="nochange" checked="checked"
1.57 albertel 818: onclick="javascript:changed_radio('nochange',$in{'formname'});" />
1.32 matthew 819: Do not change login data
820: END
821: return $result;
822: }
823:
824: sub authform_kerberos{
825: my %in = (
826: formname => 'document.cu',
827: kerb_def_dom => 'MSU.EDU',
1.80 albertel 828: kerb_def_auth => 'krb4',
1.32 matthew 829: @_,
830: );
831: my $result='';
1.80 albertel 832: my $check4;
833: my $check5;
834: if ($in{'kerb_def_auth'} eq 'krb5') {
835: $check5 = " checked=\"on\"";
836: } else {
837: $check4 = " checked=\"on\"";
838: }
1.32 matthew 839: $result.=<<"END";
840: <input type="radio" name="login" value="krb"
841: onclick="javascript:changed_radio('krb',$in{'formname'});"
1.57 albertel 842: onchange="javascript:changed_radio('krb',$in{'formname'});" />
1.32 matthew 843: Kerberos authenticated with domain
1.80 albertel 844: <input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"
1.57 albertel 845: onchange="javascript:changed_text('krb',$in{'formname'});" />
1.80 albertel 846: <input type="radio" name="krbver" value="4" $check4 />Version 4
847: <input type="radio" name="krbver" value="5" $check5 />Version 5
1.32 matthew 848: END
849: return $result;
850: }
851:
852: sub authform_internal{
853: my %args = (
854: formname => 'document.cu',
855: kerb_def_dom => 'MSU.EDU',
856: @_,
857: );
858: my $result='';
859: $result.=<<"END";
860: <input type="radio" name="login" value="int"
861: onchange="javascript:changed_radio('int',$args{'formname'});"
1.57 albertel 862: onclick="javascript:changed_radio('int',$args{'formname'});" />
1.32 matthew 863: Internally authenticated (with initial password
864: <input type="text" size="10" name="intarg" value=""
1.75 www 865: onchange="javascript:changed_text('int',$args{'formname'});" />)
1.32 matthew 866: END
867: return $result;
868: }
869:
870: sub authform_local{
871: my %in = (
872: formname => 'document.cu',
873: kerb_def_dom => 'MSU.EDU',
874: @_,
875: );
876: my $result='';
877: $result.=<<"END";
878: <input type="radio" name="login" value="loc"
879: onchange="javascript:changed_radio('loc',$in{'formname'});"
1.57 albertel 880: onclick="javascript:changed_radio('loc',$in{'formname'});" />
1.32 matthew 881: Local Authentication with argument
882: <input type="text" size="10" name="locarg" value=""
1.57 albertel 883: onchange="javascript:changed_text('loc',$in{'formname'});" />
1.32 matthew 884: END
885: return $result;
886: }
887:
888: sub authform_filesystem{
889: my %in = (
890: formname => 'document.cu',
891: kerb_def_dom => 'MSU.EDU',
892: @_,
893: );
894: my $result='';
895: $result.=<<"END";
896: <input type="radio" name="login" value="fsys"
897: onchange="javascript:changed_radio('fsys',$in{'formname'});"
1.57 albertel 898: onclick="javascript:changed_radio('fsys',$in{'formname'});" />
1.32 matthew 899: Filesystem authenticated (with initial password
900: <input type="text" size="10" name="fsysarg" value=""
1.75 www 901: onchange="javascript:changed_text('fsys',$in{'formname'});">)
1.32 matthew 902: END
903: return $result;
904: }
905:
906: ###############################################################
907: ## End Authentication changing form generation functions ##
1.80 albertel 908: ###############################################################
909:
910: ###############################################################
911: ## Get Authentication Defaults for Domain ##
912: ###############################################################
913: ##
914: ## Returns default authentication type and an associated argument
915: ## as listed in file domain.tab
916: ##
917: #-------------------------------------------
918:
919: =pod
920:
921: =item get_auth_defaults
922:
923: get_auth_defaults($target_domain) returns the default authentication
924: type and an associated argument (initial password or a kerberos domain).
925: These values are stored in lonTabs/domain.tab
926:
927: ($def_auth, $def_arg) = &get_auth_defaults($target_domain);
928:
929: If target_domain is not found in domain.tab, returns nothing ('').
930:
931: =over 4
932:
933: =item get_auth_defaults
934:
935: =back
936:
937: =cut
938:
939: #-------------------------------------------
940: sub get_auth_defaults {
941: my $domain=shift;
942: return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});
943: }
944: ###############################################################
945: ## End Get Authentication Defaults for Domain ##
946: ###############################################################
947:
948: ###############################################################
949: ## Get Kerberos Defaults for Domain ##
950: ###############################################################
951: ##
952: ## Returns default kerberos version and an associated argument
953: ## as listed in file domain.tab. If not listed, provides
954: ## appropriate default domain and kerberos version.
955: ##
956: #-------------------------------------------
957:
958: =pod
959:
960: =item get_kerberos_defaults
961:
962: get_kerberos_defaults($target_domain) returns the default kerberos
963: version and domain. If not found in domain.tabs, it defaults to
964: version 4 and the domain of the server.
965:
966: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
967:
968: =over 4
969:
970: =item get_kerberos_defaults
971:
972: =back
973:
974: =cut
975:
976: #-------------------------------------------
977: sub get_kerberos_defaults {
978: my $domain=shift;
979: my ($krbdef,$krbdefdom) =
980: &Apache::loncommon::get_auth_defaults($domain);
981: unless ($krbdef =~/^krb/ && $krbdefdom) {
982: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
983: my $krbdefdom=$1;
984: $krbdefdom=~tr/a-z/A-Z/;
985: $krbdef = "krb4";
986: }
987: return ($krbdef,$krbdefdom);
988: }
989: ###############################################################
990: ## End Get Kerberos Defaults for Domain ##
1.32 matthew 991: ###############################################################
992:
1.46 matthew 993: ###############################################################
994: ## Thesaurus Functions ##
995: ###############################################################
1.20 www 996:
1.46 matthew 997: =pod
1.20 www 998:
1.46 matthew 999: =item initialize_keywords
1000:
1001: Initializes the package variable %Keywords if it is empty. Uses the
1002: package variable $thesaurus_db_file.
1003:
1004: =cut
1005:
1006: ###################################################
1007:
1008: sub initialize_keywords {
1009: return 1 if (scalar keys(%Keywords));
1010: # If we are here, %Keywords is empty, so fill it up
1011: # Make sure the file we need exists...
1012: if (! -e $thesaurus_db_file) {
1013: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
1014: " failed because it does not exist");
1015: return 0;
1016: }
1017: # Set up the hash as a database
1018: my %thesaurus_db;
1019: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 1020: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 1021: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
1022: $thesaurus_db_file);
1023: return 0;
1024: }
1025: # Get the average number of appearances of a word.
1026: my $avecount = $thesaurus_db{'average.count'};
1027: # Put keywords (those that appear > average) into %Keywords
1028: while (my ($word,$data)=each (%thesaurus_db)) {
1029: my ($count,undef) = split /:/,$data;
1030: $Keywords{$word}++ if ($count > $avecount);
1031: }
1032: untie %thesaurus_db;
1033: # Remove special values from %Keywords.
1034: foreach ('total.count','average.count') {
1035: delete($Keywords{$_}) if (exists($Keywords{$_}));
1036: }
1037: return 1;
1038: }
1039:
1040: ###################################################
1041:
1042: =pod
1043:
1044: =item keyword($word)
1045:
1046: Returns true if $word is a keyword. A keyword is a word that appears more
1047: than the average number of times in the thesaurus database. Calls
1048: &initialize_keywords
1049:
1050: =cut
1051:
1052: ###################################################
1.20 www 1053:
1054: sub keyword {
1.46 matthew 1055: return if (!&initialize_keywords());
1056: my $word=lc(shift());
1057: $word=~s/\W//g;
1058: return exists($Keywords{$word});
1.20 www 1059: }
1.46 matthew 1060:
1061: ###############################################################
1062:
1063: =pod
1.20 www 1064:
1.46 matthew 1065: =item get_related_words
1066:
1067: Look up a word in the thesaurus. Takes a scalar arguement and returns
1068: an array of words. If the keyword is not in the thesaurus, an empty array
1069: will be returned. The order of the words returned is determined by the
1070: database which holds them.
1071:
1072: Uses global $thesaurus_db_file.
1073:
1074: =cut
1075:
1076: ###############################################################
1077: sub get_related_words {
1078: my $keyword = shift;
1079: my %thesaurus_db;
1080: if (! -e $thesaurus_db_file) {
1081: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
1082: "failed because the file does not exist");
1083: return ();
1084: }
1085: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 1086: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 1087: return ();
1088: }
1089: my @Words=();
1090: if (exists($thesaurus_db{$keyword})) {
1091: $_ = $thesaurus_db{$keyword};
1092: (undef,@Words) = split/:/; # The first element is the number of times
1093: # the word appears. We do not need it now.
1094: for (my $i=0;$i<=$#Words;$i++) {
1095: ($Words[$i],undef)= split/\,/,$Words[$i];
1.20 www 1096: }
1097: }
1.46 matthew 1098: untie %thesaurus_db;
1099: return @Words;
1.14 harris41 1100: }
1.46 matthew 1101:
1102: ###############################################################
1103: ## End Thesaurus Functions ##
1104: ###############################################################
1.61 www 1105:
1106: # -------------------------------------------------------------- Plaintext name
1.81 albertel 1107: =pod
1108:
1109: =item plainname($uname,$udom)
1110:
1111: Gets a users name and returns it as a string in
1112: "first middle last generation"
1113: form
1114:
1115: =cut
1.61 www 1116:
1.81 albertel 1117: ###############################################################
1.61 www 1118: sub plainname {
1119: my ($uname,$udom)=@_;
1120: my %names=&Apache::lonnet::get('environment',
1121: ['firstname','middlename','lastname','generation'],
1122: $udom,$uname);
1.62 www 1123: my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
1.61 www 1124: $names{'lastname'}.' '.$names{'generation'};
1.62 www 1125: $name=~s/\s+$//;
1126: $name=~s/\s+/ /g;
1127: return $name;
1.61 www 1128: }
1.66 www 1129:
1130: # -------------------------------------------------------------------- Nickname
1.81 albertel 1131: =pod
1132:
1133: =item nickname($uname,$udom)
1134:
1135: Gets a users name and returns it as a string as
1136:
1137: ""nickname""
1.66 www 1138:
1.81 albertel 1139: if the user has a nickname or
1140:
1141: "first middle last generation"
1142:
1143: if the user does not
1144:
1145: =cut
1.66 www 1146:
1147: sub nickname {
1148: my ($uname,$udom)=@_;
1149: my %names=&Apache::lonnet::get('environment',
1150: ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);
1.68 albertel 1151: my $name=$names{'nickname'};
1.66 www 1152: if ($name) {
1153: $name='"'.$name.'"';
1154: } else {
1155: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
1156: $names{'lastname'}.' '.$names{'generation'};
1157: $name=~s/\s+$//;
1158: $name=~s/\s+/ /g;
1159: }
1160: return $name;
1161: }
1162:
1.61 www 1163:
1164: # ------------------------------------------------------------------ Screenname
1.81 albertel 1165:
1166: =pod
1167:
1168: =item screenname($uname,$udom)
1169:
1170: Gets a users screenname and returns it as a string
1171:
1172: =cut
1.61 www 1173:
1174: sub screenname {
1175: my ($uname,$udom)=@_;
1176: my %names=
1177: &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 1178: return $names{'screenname'};
1.62 www 1179: }
1180:
1181: # ------------------------------------------------------------- Message Wrapper
1182:
1183: sub messagewrapper {
1184: my ($link,$un,$do)=@_;
1185: return
1186: "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
1.74 www 1187: }
1188: # --------------------------------------------------------------- Notes Wrapper
1189:
1190: sub noteswrapper {
1191: my ($link,$un,$do)=@_;
1192: return
1193: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 1194: }
1195: # ------------------------------------------------------------- Aboutme Wrapper
1196:
1197: sub aboutmewrapper {
1.69 matthew 1198: my ($link,$username,$domain)=@_;
1199: return "<a href='/adm/$domain/$username/aboutme'>$link</a>";
1.62 www 1200: }
1201:
1202: # ------------------------------------------------------------ Syllabus Wrapper
1203:
1204:
1205: sub syllabuswrapper {
1.73 www 1206: my ($link,$un,$do,$tf)=@_;
1207: if ($tf) { $link='<font color="'.$tf.'">'.$link.'</font>'; }
1.62 www 1208: return "<a href='/public/$do/$un/syllabus'>$link</a>";
1.61 www 1209: }
1.14 harris41 1210:
1211: # ---------------------------------------------------------------- Language IDs
1212: sub languageids {
1.16 harris41 1213: return sort(keys(%language));
1.14 harris41 1214: }
1215:
1216: # -------------------------------------------------------- Language Description
1217: sub languagedescription {
1.16 harris41 1218: return $language{shift(@_)};
1.14 harris41 1219: }
1220:
1221: # --------------------------------------------------------------- Copyright IDs
1222: sub copyrightids {
1.16 harris41 1223: return sort(keys(%cprtag));
1.14 harris41 1224: }
1225:
1226: # ------------------------------------------------------- Copyright Description
1227: sub copyrightdescription {
1.16 harris41 1228: return $cprtag{shift(@_)};
1.14 harris41 1229: }
1230:
1231: # ------------------------------------------------------------- File Categories
1232: sub filecategories {
1.41 ng 1233: return sort(keys(%category_extensions));
1.15 harris41 1234: }
1.14 harris41 1235:
1.17 harris41 1236: # -------------------------------------- File Types within a specified category
1.15 harris41 1237: sub filecategorytypes {
1.41 ng 1238: return @{$category_extensions{lc($_[0])}};
1.14 harris41 1239: }
1240:
1241: # ------------------------------------------------------------------ File Types
1242: sub fileextensions {
1.16 harris41 1243: return sort(keys(%fe));
1.14 harris41 1244: }
1245:
1246: # ------------------------------------------------------------- Embedding Style
1247: sub fileembstyle {
1.16 harris41 1248: return $fe{lc(shift(@_))};
1.14 harris41 1249: }
1250:
1251: # ------------------------------------------------------------ Description Text
1252: sub filedescription {
1.16 harris41 1253: return $fd{lc(shift(@_))};
1254: }
1255:
1256: # ------------------------------------------------------------ Description Text
1257: sub filedescriptionex {
1258: my $ex=shift;
1259: return '.'.$ex.' '.$fd{lc($ex)};
1.12 harris41 1260: }
1.1 albertel 1261:
1.40 ng 1262: # ---- Retrieve attempts by students
1263: # input
1264: # $symb - problem including path
1265: # $username,$domain - that of the student
1266: # $course - course name
1267: # $getattempt - leave blank if want all attempts, else put something.
1.43 ng 1268: # $regexp - regular expression. If string matches regexp send to
1269: # $gradesub - routine that process the string if it matches regexp
1.40 ng 1270: #
1271: # output
1272: # formatted as a table all the attempts, if any.
1273: #
1.1 albertel 1274: sub get_previous_attempt {
1.43 ng 1275: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1 albertel 1276: my $prevattempts='';
1.43 ng 1277: no strict 'refs';
1.1 albertel 1278: if ($symb) {
1.3 albertel 1279: my (%returnhash)=
1280: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 1281: if ($returnhash{'version'}) {
1282: my %lasthash=();
1283: my $version;
1284: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.19 harris41 1285: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
1.1 albertel 1286: $lasthash{$_}=$returnhash{$version.':'.$_};
1.19 harris41 1287: }
1.1 albertel 1288: }
1.43 ng 1289: $prevattempts='<table border="0" width="100%"><tr><td bgcolor="#777777">';
1.40 ng 1290: $prevattempts.='<table border="0" width="100%"><tr bgcolor="#e6ffff"><td>History</td>';
1.16 harris41 1291: foreach (sort(keys %lasthash)) {
1.31 albertel 1292: my ($ign,@parts) = split(/\./,$_);
1.41 ng 1293: if ($#parts > 0) {
1.31 albertel 1294: my $data=$parts[-1];
1295: pop(@parts);
1.40 ng 1296: $prevattempts.='<td>Part '.join('.',@parts).'<br />'.$data.' </td>';
1.31 albertel 1297: } else {
1.41 ng 1298: if ($#parts == 0) {
1299: $prevattempts.='<th>'.$parts[0].'</th>';
1300: } else {
1301: $prevattempts.='<th>'.$ign.'</th>';
1302: }
1.31 albertel 1303: }
1.16 harris41 1304: }
1.40 ng 1305: if ($getattempt eq '') {
1306: for ($version=1;$version<=$returnhash{'version'};$version++) {
1307: $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Transaction '.$version.'</td>';
1308: foreach (sort(keys %lasthash)) {
1309: my $value;
1310: if ($_ =~ /timestamp/) {
1311: $value=scalar(localtime($returnhash{$version.':'.$_}));
1312: } else {
1313: $value=$returnhash{$version.':'.$_};
1314: }
1315: $prevattempts.='<td>'.$value.' </td>';
1316: }
1317: }
1.1 albertel 1318: }
1.40 ng 1319: $prevattempts.='</tr><tr bgcolor="#ffffe6"><td>Current</td>';
1.16 harris41 1320: foreach (sort(keys %lasthash)) {
1.5 albertel 1321: my $value;
1322: if ($_ =~ /timestamp/) {
1323: $value=scalar(localtime($lasthash{$_}));
1324: } else {
1325: $value=$lasthash{$_};
1326: }
1.49 ng 1327: if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
1.40 ng 1328: $prevattempts.='<td>'.$value.' </td>';
1.16 harris41 1329: }
1.40 ng 1330: $prevattempts.='</tr></table></td></tr></table>';
1.1 albertel 1331: } else {
1332: $prevattempts='Nothing submitted - no attempts.';
1333: }
1334: } else {
1335: $prevattempts='No data.';
1336: }
1.10 albertel 1337: }
1338:
1339: sub get_student_view {
1.64 sakharuk 1340: my ($symb,$username,$domain,$courseid,$target) = @_;
1.10 albertel 1341: my ($map,$id,$feedurl) = split(/___/,$symb);
1342: my (%old,%moreenv);
1343: my @elements=('symb','courseid','domain','username');
1344: foreach my $element (@elements) {
1345: $old{$element}=$ENV{'form.grade_'.$element};
1346: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
1347: }
1.64 sakharuk 1348: if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
1.11 albertel 1349: &Apache::lonnet::appenv(%moreenv);
1350: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
1351: &Apache::lonnet::delenv('form.grade_');
1352: foreach my $element (@elements) {
1353: $ENV{'form.grade_'.$element}=$old{$element};
1354: }
1355: $userview=~s/\<body[^\>]*\>//gi;
1356: $userview=~s/\<\/body\>//gi;
1357: $userview=~s/\<html\>//gi;
1358: $userview=~s/\<\/html\>//gi;
1359: $userview=~s/\<head\>//gi;
1360: $userview=~s/\<\/head\>//gi;
1361: $userview=~s/action\s*\=/would_be_action\=/gi;
1362: return $userview;
1363: }
1364:
1365: sub get_student_answers {
1366: my ($symb,$username,$domain,$courseid) = @_;
1367: my ($map,$id,$feedurl) = split(/___/,$symb);
1368: my (%old,%moreenv);
1369: my @elements=('symb','courseid','domain','username');
1370: foreach my $element (@elements) {
1371: $old{$element}=$ENV{'form.grade_'.$element};
1372: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
1373: }
1374: $moreenv{'form.grade_target'}='answer';
1.10 albertel 1375: &Apache::lonnet::appenv(%moreenv);
1376: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
1377: &Apache::lonnet::delenv('form.grade_');
1378: foreach my $element (@elements) {
1379: $ENV{'form.grade_'.$element}=$old{$element};
1380: }
1381: return $userview;
1.1 albertel 1382: }
1.37 matthew 1383:
1384: ###############################################
1.51 www 1385:
1386:
1387: sub timehash {
1388: my @ltime=localtime(shift);
1389: return ( 'seconds' => $ltime[0],
1390: 'minutes' => $ltime[1],
1391: 'hours' => $ltime[2],
1392: 'day' => $ltime[3],
1393: 'month' => $ltime[4]+1,
1394: 'year' => $ltime[5]+1900,
1395: 'weekday' => $ltime[6],
1396: 'dayyear' => $ltime[7]+1,
1397: 'dlsav' => $ltime[8] );
1398: }
1399:
1400: sub maketime {
1401: my %th=@_;
1402: return POSIX::mktime(
1403: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1404: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));
1405: }
1406:
1.70 www 1407:
1408: #########################################
1409: #
1410: # Retro-fixing of un-backward-compatible time format
1411:
1412: sub unsqltime {
1413: my $timestamp=shift;
1414: if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
1415: $timestamp=&maketime(
1416: 'year'=>$1,'month'=>$2,'day'=>$3,
1417: 'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
1418: }
1419: return $timestamp;
1420: }
1421:
1422: #########################################
1.51 www 1423:
1424: sub findallcourses {
1425: my %courses=();
1426: my $now=time;
1427: foreach (keys %ENV) {
1428: if ($_=~/^user\.role\.\w+\.\/(\w+)\/(\w+)/) {
1429: my ($starttime,$endtime)=$ENV{$_};
1430: my $active=1;
1431: if ($starttime) {
1432: if ($now<$starttime) { $active=0; }
1433: }
1434: if ($endtime) {
1435: if ($now>$endtime) { $active=0; }
1436: }
1437: if ($active) { $courses{$1.'_'.$2}=1; }
1438: }
1439: }
1440: return keys %courses;
1441: }
1.37 matthew 1442:
1.54 www 1443: ###############################################
1.60 matthew 1444: ###############################################
1445:
1446: =pod
1447:
1.63 www 1448: =item &determinedomain()
1.60 matthew 1449:
1450: Inputs: $domain (usually will be undef)
1451:
1.63 www 1452: Returns: Determines which domain should be used for designs
1.60 matthew 1453:
1454: =cut
1.54 www 1455:
1.60 matthew 1456: ###############################################
1.63 www 1457: sub determinedomain {
1458: my $domain=shift;
1459: if (! $domain) {
1.60 matthew 1460: # Determine domain if we have not been given one
1461: $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
1462: if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
1463: if ($ENV{'request.role.domain'}) {
1464: $domain=$ENV{'request.role.domain'};
1465: }
1466: }
1.63 www 1467: return $domain;
1468: }
1469: ###############################################
1470: =pod
1471:
1472: =item &domainlogo()
1473:
1474: Inputs: $domain (usually will be undef)
1475:
1476: Returns: A link to a domain logo, if the domain logo exists.
1477: If the domain logo does not exist, a description of the domain.
1478:
1479: =cut
1480: ###############################################
1481: sub domainlogo {
1482: my $domain = &determinedomain(shift);
1483: # See if there is a logo
1.59 www 1484: if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
1.83 albertel 1485: my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
1486: if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
1487: return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
1488: '/adm/lonDomLogos/'.$domain.'.gif" />';
1.60 matthew 1489: } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
1490: return $Apache::lonnet::domaindescription{$domain};
1.59 www 1491: } else {
1.60 matthew 1492: return '';
1.59 www 1493: }
1494: }
1.63 www 1495: ##############################################
1496:
1497: =pod
1498:
1499: =item &designparm()
1500:
1501: Inputs: $which parameter; $domain (usually will be undef)
1502:
1503: Returns: value of designparamter $which
1504:
1505: =cut
1506: ##############################################
1507: sub designparm {
1508: my ($which,$domain)=@_;
1509: $domain=&determinedomain($domain);
1510: if ($designhash{$domain.'.'.$which}) {
1511: return $designhash{$domain.'.'.$which};
1512: } else {
1513: return $designhash{'default.'.$which};
1514: }
1515: }
1.59 www 1516:
1.60 matthew 1517: ###############################################
1518: ###############################################
1519:
1520: =pod
1521:
1522: =item &bodytag()
1523:
1524: Returns a uniform header for LON-CAPA web pages.
1525:
1526: Inputs:
1527:
1528: $title, A title to be displayed on the page.
1529: $function, the current role (can be undef).
1530: $addentries, extra parameters for the <body> tag.
1531: $bodyonly, if defined, only return the <body> tag.
1532: $domain, if defined, force a given domain.
1.86 ! www 1533: $forcereg, if page should register as content page (relevant for
! 1534: text interface only)
1.60 matthew 1535:
1536: Returns: A uniform header for LON-CAPA web pages.
1537: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
1538: If $bodyonly is undef or zero, an html string containing a <body> tag and
1539: other decorations will be returned.
1540:
1541: =cut
1542:
1543: ###############################################
1.63 www 1544:
1545:
1.60 matthew 1546: ###############################################
1.54 www 1547: sub bodytag {
1.86 ! www 1548: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
1.55 www 1549: unless ($function) {
1550: $function='student';
1551: if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
1552: $function='coordinator';
1553: }
1554: if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
1555: $function='admin';
1556: }
1557: if (($ENV{'request.role'}=~/^(au|ca)/) ||
1558: ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
1559: $function='author';
1560: }
1561: }
1.63 www 1562: my $img=&designparm($function.'.img',$domain);
1563: my $pgbg=&designparm($function.'.pgbg',$domain);
1564: my $tabbg=&designparm($function.'.tabbg',$domain);
1565: my $font=&designparm($function.'.font',$domain);
1566: my $link=&designparm($function.'.link',$domain);
1567: my $alink=&designparm($function.'.alink',$domain);
1568: my $vlink=&designparm($function.'.vlink',$domain);
1569: my $sidebg=&designparm($function.'.sidebg',$domain);
1570:
1571: # role and realm
1.55 www 1572: my ($role,$realm)
1573: =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
1574: # realm
1.54 www 1575: if ($ENV{'request.course.id'}) {
1.55 www 1576: $realm=
1577: $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
1.54 www 1578: }
1.55 www 1579: unless ($realm) { $realm=' '; }
1580: # Set messages
1.60 matthew 1581: my $messages=&domainlogo($domain);
1.55 www 1582: # Output
1.83 albertel 1583: my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
1584: if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
1.60 matthew 1585: my $bodytag = <<END;
1.54 www 1586: <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
1587: $addentries>
1.60 matthew 1588: END
1589: if ($bodyonly) {
1590: return $bodytag;
1.79 www 1591: } elsif ($ENV{'browser.interface'} eq 'textual') {
1.86 ! www 1592: return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
! 1593: $forcereg).
1.82 www 1594: '<h1>LON-CAPA: '.$title.'</h1>';
1.60 matthew 1595: } else {
1596: return(<<ENDBODY);
1597: $bodytag
1.55 www 1598: <table width="100%" cellspacing="0" border="0" cellpadding="0">
1599: <tr><td bgcolor="$font">
1.83 albertel 1600: <img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td>
1.63 www 1601: <td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
1.55 www 1602: </tr>
1.54 www 1603: <tr>
1.55 www 1604: <td rowspan="3" bgcolor="$tabbg">
1605: <font size="5"><b>$title</b></font>
1.54 www 1606: <td bgcolor="$tabbg" align="right">
1607: <font size="2">
1608: $ENV{'environment.firstname'}
1609: $ENV{'environment.middlename'}
1610: $ENV{'environment.lastname'}
1611: $ENV{'environment.generation'}
1.55 www 1612: </font>
1.54 www 1613: </td>
1614: </tr>
1615: <tr><td bgcolor="$tabbg" align="right">
1.55 www 1616: <font size="2">$role</font>
1.54 www 1617: </td></tr>
1.55 www 1618: <tr>
1619: <td bgcolor="$tabbg" align="right"><font size="2">$realm</font> </td></tr>
1.54 www 1620: </table><br>
1621: ENDBODY
1.60 matthew 1622: }
1.54 www 1623: }
1.37 matthew 1624: ###############################################
1.1 albertel 1625:
1.6 albertel 1626: sub get_unprocessed_cgi {
1.25 albertel 1627: my ($query,$possible_names)= @_;
1.26 matthew 1628: # $Apache::lonxml::debug=1;
1.16 harris41 1629: foreach (split(/&/,$query)) {
1.6 albertel 1630: my ($name, $value) = split(/=/,$_);
1.25 albertel 1631: $name = &Apache::lonnet::unescape($name);
1632: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
1633: $value =~ tr/+/ /;
1634: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1635: &Apache::lonxml::debug("Seting :$name: to :$value:");
1.30 albertel 1636: unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 1637: }
1.16 harris41 1638: }
1.6 albertel 1639: }
1640:
1.7 albertel 1641: sub cacheheader {
1.23 www 1642: unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.8 albertel 1643: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.7 albertel 1644: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1645: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
1646: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1647: return $output;
1648: }
1649:
1.9 albertel 1650: sub no_cache {
1651: my ($r) = @_;
1.23 www 1652: unless ($ENV{'request.method'} eq 'GET') { return ''; }
1.24 albertel 1653: #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
1.9 albertel 1654: $r->no_cache(1);
1655: $r->header_out("Pragma" => "no-cache");
1.24 albertel 1656: #$r->header_out("Expires" => $date);
1.9 albertel 1657: }
1.25 albertel 1658:
1659: sub add_to_env {
1660: my ($name,$value)=@_;
1.28 albertel 1661: if (defined($ENV{$name})) {
1.27 albertel 1662: if (ref($ENV{$name})) {
1.25 albertel 1663: #already have multiple values
1664: push(@{ $ENV{$name} },$value);
1665: } else {
1666: #first time seeing multiple values, convert hash entry to an arrayref
1667: my $first=$ENV{$name};
1668: undef($ENV{$name});
1669: push(@{ $ENV{$name} },$first,$value);
1670: }
1671: } else {
1672: $ENV{$name}=$value;
1673: }
1.31 albertel 1674: }
1675:
1.41 ng 1676: =pod
1.45 matthew 1677:
1678: =back
1.41 ng 1679:
1680: =head2 CSV Upload/Handling functions
1.38 albertel 1681:
1.41 ng 1682: =over 4
1683:
1684: =item upfile_store($r)
1685:
1686: Store uploaded file, $r should be the HTTP Request object,
1687: needs $ENV{'form.upfile'}
1688: returns $datatoken to be put into hidden field
1689:
1690: =cut
1.31 albertel 1691:
1692: sub upfile_store {
1693: my $r=shift;
1694: $ENV{'form.upfile'}=~s/\r/\n/gs;
1695: $ENV{'form.upfile'}=~s/\f/\n/gs;
1696: $ENV{'form.upfile'}=~s/\n+/\n/gs;
1697: $ENV{'form.upfile'}=~s/\n+$//gs;
1698:
1699: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
1700: '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
1701: {
1702: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
1703: '/tmp/'.$datatoken.'.tmp');
1704: print $fh $ENV{'form.upfile'};
1705: }
1706: return $datatoken;
1707: }
1708:
1.56 matthew 1709: =pod
1710:
1.41 ng 1711: =item load_tmp_file($r)
1712:
1713: Load uploaded file from tmp, $r should be the HTTP Request object,
1714: needs $ENV{'form.datatoken'},
1715: sets $ENV{'form.upfile'} to the contents of the file
1716:
1717: =cut
1.31 albertel 1718:
1719: sub load_tmp_file {
1720: my $r=shift;
1721: my @studentdata=();
1722: {
1723: my $fh;
1724: if ($fh=Apache::File->new($r->dir_config('lonDaemons').
1725: '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
1726: @studentdata=<$fh>;
1727: }
1728: }
1729: $ENV{'form.upfile'}=join('',@studentdata);
1730: }
1731:
1.56 matthew 1732: =pod
1733:
1.41 ng 1734: =item upfile_record_sep()
1735:
1736: Separate uploaded file into records
1737: returns array of records,
1738: needs $ENV{'form.upfile'} and $ENV{'form.upfiletype'}
1739:
1740: =cut
1.31 albertel 1741:
1742: sub upfile_record_sep {
1743: if ($ENV{'form.upfiletype'} eq 'xml') {
1744: } else {
1745: return split(/\n/,$ENV{'form.upfile'});
1746: }
1747: }
1748:
1.56 matthew 1749: =pod
1750:
1.41 ng 1751: =item record_sep($record)
1752:
1753: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $ENV{'form.upfiletype'}
1754:
1755: =cut
1756:
1.31 albertel 1757: sub record_sep {
1758: my $record=shift;
1759: my %components=();
1760: if ($ENV{'form.upfiletype'} eq 'xml') {
1761: } elsif ($ENV{'form.upfiletype'} eq 'space') {
1762: my $i=0;
1763: foreach (split(/\s+/,$record)) {
1764: my $field=$_;
1765: $field=~s/^(\"|\')//;
1766: $field=~s/(\"|\')$//;
1767: $components{$i}=$field;
1768: $i++;
1769: }
1770: } elsif ($ENV{'form.upfiletype'} eq 'tab') {
1771: my $i=0;
1772: foreach (split(/\t+/,$record)) {
1773: my $field=$_;
1774: $field=~s/^(\"|\')//;
1775: $field=~s/(\"|\')$//;
1776: $components{$i}=$field;
1777: $i++;
1778: }
1779: } else {
1780: my @allfields=split(/\,/,$record);
1781: my $i=0;
1782: my $j;
1783: for ($j=0;$j<=$#allfields;$j++) {
1784: my $field=$allfields[$j];
1785: if ($field=~/^\s*(\"|\')/) {
1786: my $delimiter=$1;
1787: while (($field!~/$delimiter$/) && ($j<$#allfields)) {
1788: $j++;
1789: $field.=','.$allfields[$j];
1790: }
1791: $field=~s/^\s*$delimiter//;
1792: $field=~s/$delimiter\s*$//;
1793: }
1794: $components{$i}=$field;
1795: $i++;
1796: }
1797: }
1798: return %components;
1799: }
1800:
1.56 matthew 1801: =pod
1802:
1.41 ng 1803: =item upfile_select_html()
1804:
1805: return HTML code to select file and specify its type
1806:
1807: =cut
1808:
1.31 albertel 1809: sub upfile_select_html {
1810: return (<<'ENDUPFORM');
1.57 albertel 1811: <input type="file" name="upfile" size="50" />
1.31 albertel 1812: <br />Type: <select name="upfiletype">
1813: <option value="csv">CSV (comma separated values, spreadsheet)</option>
1814: <option value="space">Space separated</option>
1815: <option value="tab">Tabulator separated</option>
1816: <option value="xml">HTML/XML</option>
1817: </select>
1818: ENDUPFORM
1819: }
1820:
1.56 matthew 1821: =pod
1822:
1.41 ng 1823: =item csv_print_samples($r,$records)
1824:
1825: Prints a table of sample values from each column uploaded $r is an
1826: Apache Request ref, $records is an arrayref from
1827: &Apache::loncommon::upfile_record_sep
1828:
1829: =cut
1830:
1.31 albertel 1831: sub csv_print_samples {
1832: my ($r,$records) = @_;
1833: my (%sone,%stwo,%sthree);
1834: %sone=&record_sep($$records[0]);
1835: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
1836: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
1837:
1838: $r->print('Samples<br /><table border="2"><tr>');
1839: foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }
1840: $r->print('</tr>');
1841: foreach my $hash (\%sone,\%stwo,\%sthree) {
1842: $r->print('<tr>');
1843: foreach (sort({$a <=> $b} keys(%sone))) {
1844: $r->print('<td>');
1845: if (defined($$hash{$_})) { $r->print($$hash{$_}); }
1846: $r->print('</td>');
1847: }
1848: $r->print('</tr>');
1849: }
1850: $r->print('</tr></table><br />'."\n");
1851: }
1852:
1.56 matthew 1853: =pod
1854:
1.41 ng 1855: =item csv_print_select_table($r,$records,$d)
1856:
1857: Prints a table to create associations between values and table columns.
1858: $r is an Apache Request ref,
1859: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1860: $d is an array of 2 element arrays (internal name, displayed name)
1861:
1862: =cut
1863:
1.31 albertel 1864: sub csv_print_select_table {
1865: my ($r,$records,$d) = @_;
1866: my $i=0;my %sone;
1867: %sone=&record_sep($$records[0]);
1868: $r->print('Associate columns with student attributes.'."\n".
1869: '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
1870: foreach (@$d) {
1871: my ($value,$display)=@{ $_ };
1872: $r->print('<tr><td>'.$display.'</td>');
1873:
1874: $r->print('<td><select name=f'.$i.
1.32 matthew 1875: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 1876: $r->print('<option value="none"></option>');
1877: foreach (sort({$a <=> $b} keys(%sone))) {
1878: $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
1879: }
1880: $r->print('</select></td></tr>'."\n");
1881: $i++;
1882: }
1883: $i--;
1884: return $i;
1885: }
1.56 matthew 1886:
1887: =pod
1.31 albertel 1888:
1.41 ng 1889: =item csv_samples_select_table($r,$records,$d)
1890:
1891: Prints a table of sample values from the upload and can make associate samples to internal names.
1892:
1893: $r is an Apache Request ref,
1894: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1895: $d is an array of 2 element arrays (internal name, displayed name)
1896:
1897: =cut
1898:
1.31 albertel 1899: sub csv_samples_select_table {
1900: my ($r,$records,$d) = @_;
1901: my %sone; my %stwo; my %sthree;
1902: my $i=0;
1903:
1904: $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
1905: %sone=&record_sep($$records[0]);
1906: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
1907: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
1908:
1909: foreach (sort keys %sone) {
1910: $r->print('<tr><td><select name=f'.$i.
1.32 matthew 1911: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 1912: foreach (@$d) {
1913: my ($value,$display)=@{ $_ };
1914: $r->print('<option value='.$value.'>'.$display.'</option>');
1915: }
1916: $r->print('</select></td><td>');
1917: if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
1918: if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
1919: if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
1920: $r->print('</td></tr>');
1921: $i++;
1922: }
1923: $i--;
1924: return($i);
1.25 albertel 1925: }
1.84 albertel 1926:
1.85 albertel 1927: =pod
1928:
1929: =item check_if_partid_hidden($id,$symb,$udom,$uname)
1930:
1931: Returns either 1 or undef
1932:
1933: 1 if the part is to be hidden, undef if it is to be shown
1934:
1935: Arguments are:
1936:
1937: $id the id of the part to be checked
1938: $symb, optional the symb of the resource to check
1939: $udom, optional the domain of the user to check for
1940: $uname, optional the username of the user to check for
1941:
1942: =cut
1.84 albertel 1943:
1944: sub check_if_partid_hidden {
1945: my ($id,$symb,$udom,$uname) = @_;
1946: my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_hiddenparts',
1947: $symb,$udom,$uname);
1948: my @hiddenlist=split(/,/,$hiddenparts);
1949: foreach my $checkid (@hiddenlist) {
1950: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }
1951: }
1952: return undef;
1953: }
1954:
1955:
1956:
1.1 albertel 1957: 1;
1958: __END__;
1.17 harris41 1959:
1.41 ng 1960: =pod
1961:
1962: =back
1963:
1964: =head2 Access .tab File Data
1965:
1966: =over 4
1967:
1.35 matthew 1968: =item languageids()
1.17 harris41 1969:
1.35 matthew 1970: returns list of all language ids
1.17 harris41 1971:
1.35 matthew 1972: =item languagedescription()
1.17 harris41 1973:
1.35 matthew 1974: returns description of a specified language id
1.17 harris41 1975:
1.35 matthew 1976: =item copyrightids()
1.17 harris41 1977:
1.35 matthew 1978: returns list of all copyrights
1.17 harris41 1979:
1.35 matthew 1980: =item copyrightdescription()
1.17 harris41 1981:
1.35 matthew 1982: returns description of a specified copyright id
1.17 harris41 1983:
1.35 matthew 1984: =item filecategories()
1.17 harris41 1985:
1.35 matthew 1986: returns list of all file categories
1.17 harris41 1987:
1.35 matthew 1988: =item filecategorytypes()
1.17 harris41 1989:
1.35 matthew 1990: returns list of file types belonging to a given file
1.17 harris41 1991: category
1992:
1.35 matthew 1993: =item fileembstyle()
1.17 harris41 1994:
1.35 matthew 1995: returns embedding style for a specified file type
1.17 harris41 1996:
1.35 matthew 1997: =item filedescription()
1.17 harris41 1998:
1.35 matthew 1999: returns description for a specified file type
1.17 harris41 2000:
1.35 matthew 2001: =item filedescriptionex()
1.17 harris41 2002:
1.35 matthew 2003: returns description for a specified file type with
1.17 harris41 2004: extra formatting
2005:
1.41 ng 2006: =back
2007:
2008: =head2 Alternate Problem Views
2009:
2010: =over 4
2011:
1.35 matthew 2012: =item get_previous_attempt()
1.17 harris41 2013:
1.35 matthew 2014: return string with previous attempt on problem
1.17 harris41 2015:
1.35 matthew 2016: =item get_student_view()
1.17 harris41 2017:
1.35 matthew 2018: show a snapshot of what student was looking at
1.17 harris41 2019:
1.35 matthew 2020: =item get_student_answers()
1.17 harris41 2021:
1.35 matthew 2022: show a snapshot of how student was answering problem
1.17 harris41 2023:
1.41 ng 2024: =back
2025:
2026: =head2 HTTP Helper
2027:
2028: =over 4
2029:
2030: =item get_unprocessed_cgi($query,$possible_names)
2031:
2032: Modify the %ENV hash to contain unprocessed CGI form parameters held in
2033: $query. The parameters listed in $possible_names (an array reference),
2034: will be set in $ENV{'form.name'} if they do not already exist.
1.17 harris41 2035:
1.41 ng 2036: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
2037: $possible_names is an ref to an array of form element names. As an example:
2038: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
2039: will result in $ENV{'form.uname'} and $ENV{'form.udom'} being set.
1.17 harris41 2040:
1.35 matthew 2041: =item cacheheader()
1.17 harris41 2042:
1.35 matthew 2043: returns cache-controlling header code
1.17 harris41 2044:
1.65 matthew 2045: =item no_cache($r)
1.17 harris41 2046:
1.35 matthew 2047: specifies header code to not have cache
1.25 albertel 2048:
1.35 matthew 2049: =item add_to_env($name,$value)
1.25 albertel 2050:
1.35 matthew 2051: adds $name to the %ENV hash with value
1.25 albertel 2052: $value, if $name already exists, the entry is converted to an array
2053: reference and $value is added to the array.
1.17 harris41 2054:
2055: =back
2056:
2057: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface