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