1: # The LearningOnline Network with CAPA
2: # a pile of common routines
3: #
4: # $Id: loncommon.pm,v 1.32 2002/04/22 15:26:46 matthew Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # YEAR=2001
29: # 2/13-12/7 Guy Albertelli
30: # 12/11,12/12,12/17 Scott Harrison
31: # 12/21 Gerd Kortemeyer
32: # 12/21 Scott Harrison
33: # 12/25,12/28 Gerd Kortemeyer
34: # YEAR=2002
35: # 1/4 Gerd Kortemeyer
36:
37: # Makes a table out of the previous attempts
38: # Inputs result_from_symbread, user, domain, course_id
39: # Reads in non-network-related .tab files
40:
41: package Apache::loncommon;
42:
43: use strict;
44: use Apache::lonnet();
45: use POSIX qw(strftime);
46: use Apache::Constants qw(:common);
47: use Apache::lonmsg();
48:
49: my $readit;
50:
51: # ----------------------------------------------- Filetypes/Languages/Copyright
52: my %language;
53: my %cprtag;
54: my %fe; my %fd;
55: my %fc;
56:
57: # -------------------------------------------------------------- Thesaurus data
58: my @therelated;
59: my @theword;
60: my @thecount;
61: my %theindex;
62: my $thetotalcount;
63: my $thefuzzy=2;
64: my $thethreshold=0.1/$thefuzzy;
65: my $theavecount;
66:
67: # ----------------------------------------------------------------------- BEGIN
68: BEGIN {
69:
70: unless ($readit) {
71: # ------------------------------------------------------------------- languages
72: {
73: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
74: '/language.tab');
75: if ($fh) {
76: while (<$fh>) {
77: next if /^\#/;
78: chomp;
79: my ($key,$val)=(split(/\s+/,$_,2));
80: $language{$key}=$val;
81: }
82: }
83: }
84: # ------------------------------------------------------------------ copyrights
85: {
86: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.
87: '/copyright.tab');
88: if ($fh) {
89: while (<$fh>) {
90: next if /^\#/;
91: chomp;
92: my ($key,$val)=(split(/\s+/,$_,2));
93: $cprtag{$key}=$val;
94: }
95: }
96: }
97: # ------------------------------------------------------------- file categories
98: {
99: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
100: '/filecategories.tab');
101: if ($fh) {
102: while (<$fh>) {
103: next if /^\#/;
104: chomp;
105: my ($key,$val)=(split(/\s+/,$_,2));
106: push @{$fc{$key}},$val;
107: }
108: }
109: }
110: # ------------------------------------------------------------------ file types
111: {
112: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
113: '/filetypes.tab');
114: if ($fh) {
115: while (<$fh>) {
116: next if (/^\#/);
117: chomp;
118: my ($ending,$emb,$descr)=split(/\s+/,$_,3);
119: if ($descr ne '') {
120: $fe{$ending}=lc($emb);
121: $fd{$ending}=$descr;
122: }
123: }
124: }
125: }
126: # -------------------------------------------------------------- Thesaurus data
127: {
128: my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
129: '/thesaurus.dat');
130: if ($fh) {
131: while (<$fh>) {
132: my ($tword,$tindex,$tcount,$trelated)=split(/\@/,$_);
133: $theindex{$tword}=$tindex;
134: $theword[$tindex]=$tword;
135: $thecount[$tindex]=$tcount;
136: $thetotalcount+=$tcount;
137: $therelated[$tindex]=$trelated;
138: }
139: }
140: $theavecount=$thetotalcount/$#thecount;
141: }
142: &Apache::lonnet::logthis(
143: "<font color=yellow>INFO: Read file types and thesaurus</font>");
144: $readit=1;
145: }
146:
147: }
148: # ============================================================= END BEGIN BLOCK
149:
150: ###############################################################
151: ## Authentication changing form generation subroutines ##
152: ###############################################################
153: ##
154: ## All of the authform_xxxxxxx subroutines take their inputs in a
155: ## hash, and have reasonable default values.
156: ##
157: ## formname = the name given in the <form> tag.
158: sub authform_header{
159: my %in = (
160: formname => 'cu',
161: kerb_def_dom => 'MSU.EDU',
162: @_,
163: );
164: $in{'formname'} = 'document.' . $in{'formname'};
165: my $result='';
166: $result.=<<"END";
167: var current = new Object();
168: current.radiovalue = 'nochange';
169: current.argfield = null;
170:
171: function changed_radio(choice,currentform) {
172: var choicearg = choice + 'arg';
173: // If a radio button in changed, we need to change the argfield
174: if (current.radiovalue != choice) {
175: current.radiovalue = choice;
176: if (current.argfield != null) {
177: currentform.elements[current.argfield].value = '';
178: }
179: if (choice == 'nochange') {
180: current.argfield = null;
181: } else {
182: current.argfield = choicearg;
183: switch(choice) {
184: case 'krb':
185: currentform.elements[current.argfield].value =
186: "$in{'kerb_def_dom'}";
187: break;
188: default:
189: break;
190: }
191: }
192: }
193: return;
194: }
195:
196: function changed_text(choice,currentform) {
197: var choicearg = choice + 'arg';
198: if (currentform.elements[choicearg].value !='') {
199: switch (choice) {
200: case 'krb': currentform.elements[choicearg].value =
201: currentform.elements[choicearg].value.toUpperCase();
202: break;
203: default:
204: }
205: // clear old field
206: if ((current.argfield != choicearg) && (current.argfield != null)) {
207: currentform.elements[current.argfield].value = '';
208: }
209: current.argfield = choicearg;
210: }
211: set_auth_radio_buttons(choice,currentform);
212: return;
213: }
214:
215: function set_auth_radio_buttons(newvalue,currentform) {
216: var i=0;
217: while (i < currentform.login.length) {
218: if (currentform.login[i].value == newvalue) { break; }
219: i++;
220: }
221: if (i == currentform.login.length) {
222: return;
223: }
224: current.radiovalue = newvalue;
225: currentform.login[i].checked = true;
226: return;
227: }
228: END
229: return $result;
230: }
231:
232: sub authform_authorwarning{
233: my $result='';
234: $result=<<"END";
235: <i>As a general rule, only authors or co-authors should be filesystem
236: authenticated (which allows access to the server filesystem).</i>
237: END
238: return $result;
239: }
240:
241: sub authform_nochange{
242: my %in = (
243: formname => 'document.cu',
244: kerb_def_dom => 'MSU.EDU',
245: @_,
246: );
247: my $result='';
248: $result.=<<"END";
249: <input type="radio" name="login" value="nochange" checked="checked"
250: onclick="javascript:changed_radio('nochange',$in{'formname'});">
251: Do not change login data
252: END
253: return $result;
254: }
255:
256: sub authform_kerberos{
257: my %in = (
258: formname => 'document.cu',
259: kerb_def_dom => 'MSU.EDU',
260: @_,
261: );
262: my $result='';
263: $result.=<<"END";
264: <input type="radio" name="login" value="krb"
265: onclick="javascript:changed_radio('krb',$in{'formname'});"
266: onchange="javascript:changed_radio('krb',$in{'formname'});">
267: Kerberos authenticated with domain
268: <input type="text" size="10" name="krbarg" value=""
269: onchange="javascript:changed_text('krb',$in{'formname'});">
270: END
271: return $result;
272: }
273:
274: sub authform_internal{
275: my %args = (
276: formname => 'document.cu',
277: kerb_def_dom => 'MSU.EDU',
278: @_,
279: );
280: my $result='';
281: $result.=<<"END";
282: <input type="radio" name="login" value="int"
283: onchange="javascript:changed_radio('int',$args{'formname'});"
284: onclick="javascript:changed_radio('int',$args{'formname'});">
285: Internally authenticated (with initial password
286: <input type="text" size="10" name="intarg" value=""
287: onchange="javascript:changed_text('int',$args{'formname'});">
288: END
289: return $result;
290: }
291:
292: sub authform_local{
293: my %in = (
294: formname => 'document.cu',
295: kerb_def_dom => 'MSU.EDU',
296: @_,
297: );
298: my $result='';
299: $result.=<<"END";
300: <input type="radio" name="login" value="loc"
301: onchange="javascript:changed_radio('loc',$in{'formname'});"
302: onclick="javascript:changed_radio('loc',$in{'formname'});">
303: Local Authentication with argument
304: <input type="text" size="10" name="locarg" value=""
305: onchange="javascript:changed_text('loc',$in{'formname'});">
306: END
307: return $result;
308: }
309:
310: sub authform_filesystem{
311: my %in = (
312: formname => 'document.cu',
313: kerb_def_dom => 'MSU.EDU',
314: @_,
315: );
316: my $result='';
317: $result.=<<"END";
318: <input type="radio" name="login" value="fsys"
319: onchange="javascript:changed_radio('fsys',$in{'formname'});"
320: onclick="javascript:changed_radio('fsys',$in{'formname'});">
321: Filesystem authenticated (with initial password
322: <input type="text" size="10" name="fsysarg" value=""
323: onchange="javascript:changed_text('fsys',$in{'formname'});">
324: END
325: return $result;
326: }
327:
328: ###############################################################
329: ## End Authentication changing form generation functions ##
330: ###############################################################
331:
332:
333:
334: # ---------------------------------------------------------- Is this a keyword?
335:
336: sub keyword {
337: my $newword=shift;
338: $newword=~s/\W//g;
339: $newword=~tr/A-Z/a-z/;
340: my $tindex=$theindex{$newword};
341: if ($tindex) {
342: if ($thecount[$tindex]>$theavecount) {
343: return 1;
344: }
345: }
346: return 0;
347: }
348: # -------------------------------------------------------- Return related words
349:
350: sub related {
351: my $newword=shift;
352: $newword=~s/\W//g;
353: $newword=~tr/A-Z/a-z/;
354: my $tindex=$theindex{$newword};
355: if ($tindex) {
356: my %found=();
357: foreach (split(/\,/,$therelated[$tindex])) {
358: # - Related word found
359: my ($ridx,$rcount)=split(/\:/,$_);
360: # - Direct relation index
361: my $directrel=$rcount/$thecount[$tindex];
362: if ($directrel>$thethreshold) {
363: foreach (split(/\,/,$therelated[$ridx])) {
364: my ($rridx,$rrcount)=split(/\:/,$_);
365: if ($rridx==$tindex) {
366: # - Determine reverse relation index
367: my $revrel=$rrcount/$thecount[$ridx];
368: # - Calculate full index
369: $found{$ridx}=$directrel*$revrel;
370: if ($found{$ridx}>$thethreshold) {
371: foreach (split(/\,/,$therelated[$ridx])) {
372: my ($rrridx,$rrrcount)=split(/\:/,$_);
373: unless ($found{$rrridx}) {
374: my $revrevrel=$rrrcount/$thecount[$ridx];
375: if (
376: $directrel*$revrel*$revrevrel>$thethreshold
377: ) {
378: $found{$rrridx}=
379: $directrel*$revrel*$revrevrel;
380: }
381: }
382: }
383: }
384: }
385: }
386: }
387: }
388: }
389: return ();
390: }
391:
392: # ---------------------------------------------------------------- Language IDs
393: sub languageids {
394: return sort(keys(%language));
395: }
396:
397: # -------------------------------------------------------- Language Description
398: sub languagedescription {
399: return $language{shift(@_)};
400: }
401:
402: # --------------------------------------------------------------- Copyright IDs
403: sub copyrightids {
404: return sort(keys(%cprtag));
405: }
406:
407: # ------------------------------------------------------- Copyright Description
408: sub copyrightdescription {
409: return $cprtag{shift(@_)};
410: }
411:
412: # ------------------------------------------------------------- File Categories
413: sub filecategories {
414: return sort(keys(%fc));
415: }
416:
417: # -------------------------------------- File Types within a specified category
418: sub filecategorytypes {
419: return @{$fc{lc(shift(@_))}};
420: }
421:
422: # ------------------------------------------------------------------ File Types
423: sub fileextensions {
424: return sort(keys(%fe));
425: }
426:
427: # ------------------------------------------------------------- Embedding Style
428: sub fileembstyle {
429: return $fe{lc(shift(@_))};
430: }
431:
432: # ------------------------------------------------------------ Description Text
433: sub filedescription {
434: return $fd{lc(shift(@_))};
435: }
436:
437: # ------------------------------------------------------------ Description Text
438: sub filedescriptionex {
439: my $ex=shift;
440: return '.'.$ex.' '.$fd{lc($ex)};
441: }
442:
443: sub get_previous_attempt {
444: my ($symb,$username,$domain,$course)=@_;
445: my $prevattempts='';
446: if ($symb) {
447: my (%returnhash)=
448: &Apache::lonnet::restore($symb,$course,$domain,$username);
449: if ($returnhash{'version'}) {
450: my %lasthash=();
451: my $version;
452: for ($version=1;$version<=$returnhash{'version'};$version++) {
453: foreach (sort(split(/\:/,$returnhash{$version.':keys'}))) {
454: $lasthash{$_}=$returnhash{$version.':'.$_};
455: }
456: }
457: $prevattempts='<table border=2></tr><th>History</th>';
458: foreach (sort(keys %lasthash)) {
459: my ($ign,@parts) = split(/\./,$_);
460: if (@parts) {
461: my $data=$parts[-1];
462: pop(@parts);
463: $prevattempts.='<th>Part '.join('.',@parts).'<br />'.$data.'</th>';
464: } else {
465: $prevattempts.='<th>'.$ign.'</th>';
466: }
467: }
468: for ($version=1;$version<=$returnhash{'version'};$version++) {
469: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
470: foreach (sort(keys %lasthash)) {
471: my $value;
472: if ($_ =~ /timestamp/) {
473: $value=scalar(localtime($returnhash{$version.':'.$_}));
474: } else {
475: $value=$returnhash{$version.':'.$_};
476: }
477: $prevattempts.='<td>'.$value.'</td>';
478: }
479: }
480: $prevattempts.='</tr><tr><th>Current</th>';
481: foreach (sort(keys %lasthash)) {
482: my $value;
483: if ($_ =~ /timestamp/) {
484: $value=scalar(localtime($lasthash{$_}));
485: } else {
486: $value=$lasthash{$_};
487: }
488: $prevattempts.='<td>'.$value.'</td>';
489: }
490: $prevattempts.='</tr></table>';
491: } else {
492: $prevattempts='Nothing submitted - no attempts.';
493: }
494: } else {
495: $prevattempts='No data.';
496: }
497: }
498:
499: sub get_student_view {
500: my ($symb,$username,$domain,$courseid) = @_;
501: my ($map,$id,$feedurl) = split(/___/,$symb);
502: my (%old,%moreenv);
503: my @elements=('symb','courseid','domain','username');
504: foreach my $element (@elements) {
505: $old{$element}=$ENV{'form.grade_'.$element};
506: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
507: }
508: &Apache::lonnet::appenv(%moreenv);
509: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
510: &Apache::lonnet::delenv('form.grade_');
511: foreach my $element (@elements) {
512: $ENV{'form.grade_'.$element}=$old{$element};
513: }
514: $userview=~s/\<body[^\>]*\>//gi;
515: $userview=~s/\<\/body\>//gi;
516: $userview=~s/\<html\>//gi;
517: $userview=~s/\<\/html\>//gi;
518: $userview=~s/\<head\>//gi;
519: $userview=~s/\<\/head\>//gi;
520: $userview=~s/action\s*\=/would_be_action\=/gi;
521: return $userview;
522: }
523:
524: sub get_student_answers {
525: my ($symb,$username,$domain,$courseid) = @_;
526: my ($map,$id,$feedurl) = split(/___/,$symb);
527: my (%old,%moreenv);
528: my @elements=('symb','courseid','domain','username');
529: foreach my $element (@elements) {
530: $old{$element}=$ENV{'form.grade_'.$element};
531: $moreenv{'form.grade_'.$element}=eval '$'.$element #'
532: }
533: $moreenv{'form.grade_target'}='answer';
534: &Apache::lonnet::appenv(%moreenv);
535: my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
536: &Apache::lonnet::delenv('form.grade_');
537: foreach my $element (@elements) {
538: $ENV{'form.grade_'.$element}=$old{$element};
539: }
540: $userview=~s/\<body[^\>]*\>//gi;
541: $userview=~s/\<\/body\>//gi;
542: $userview=~s/\<html\>//gi;
543: $userview=~s/\<\/html\>//gi;
544: $userview=~s/\<head\>//gi;
545: $userview=~s/\<\/head\>//gi;
546: $userview=~s/action\s*\=/would_be_action\=/gi;
547: return $userview;
548: }
549:
550: sub get_unprocessed_cgi {
551: my ($query,$possible_names)= @_;
552: # $Apache::lonxml::debug=1;
553: foreach (split(/&/,$query)) {
554: my ($name, $value) = split(/=/,$_);
555: $name = &Apache::lonnet::unescape($name);
556: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
557: $value =~ tr/+/ /;
558: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
559: &Apache::lonxml::debug("Seting :$name: to :$value:");
560: unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
561: }
562: }
563: }
564:
565: sub cacheheader {
566: unless ($ENV{'request.method'} eq 'GET') { return ''; }
567: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
568: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
569: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
570: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
571: return $output;
572: }
573:
574: sub no_cache {
575: my ($r) = @_;
576: unless ($ENV{'request.method'} eq 'GET') { return ''; }
577: #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
578: $r->no_cache(1);
579: $r->header_out("Pragma" => "no-cache");
580: #$r->header_out("Expires" => $date);
581: }
582:
583: sub add_to_env {
584: my ($name,$value)=@_;
585: if (defined($ENV{$name})) {
586: if (ref($ENV{$name})) {
587: #already have multiple values
588: push(@{ $ENV{$name} },$value);
589: } else {
590: #first time seeing multiple values, convert hash entry to an arrayref
591: my $first=$ENV{$name};
592: undef($ENV{$name});
593: push(@{ $ENV{$name} },$first,$value);
594: }
595: } else {
596: $ENV{$name}=$value;
597: }
598: }
599:
600: #---CSV Upload/Handling functions
601:
602: # ========================================================= Store uploaded file
603: # needs $ENV{'form.upfile'}
604: # return $datatoken to be put into hidden field
605:
606: sub upfile_store {
607: my $r=shift;
608: $ENV{'form.upfile'}=~s/\r/\n/gs;
609: $ENV{'form.upfile'}=~s/\f/\n/gs;
610: $ENV{'form.upfile'}=~s/\n+/\n/gs;
611: $ENV{'form.upfile'}=~s/\n+$//gs;
612:
613: my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
614: '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
615: {
616: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
617: '/tmp/'.$datatoken.'.tmp');
618: print $fh $ENV{'form.upfile'};
619: }
620: return $datatoken;
621: }
622:
623: # ================================================= Load uploaded file from tmp
624: # needs $ENV{'form.datatoken'}
625: # sets $ENV{'form.upfile'} to the contents of the file
626:
627: sub load_tmp_file {
628: my $r=shift;
629: my @studentdata=();
630: {
631: my $fh;
632: if ($fh=Apache::File->new($r->dir_config('lonDaemons').
633: '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {
634: @studentdata=<$fh>;
635: }
636: }
637: $ENV{'form.upfile'}=join('',@studentdata);
638: }
639:
640: # ========================================= Separate uploaded file into records
641: # returns array of records
642: # needs $ENV{'form.upfile'}
643: # needs $ENV{'form.upfiletype'}
644:
645: sub upfile_record_sep {
646: if ($ENV{'form.upfiletype'} eq 'xml') {
647: } else {
648: return split(/\n/,$ENV{'form.upfile'});
649: }
650: }
651:
652: # =============================================== Separate a record into fields
653: # needs $ENV{'form.upfiletype'}
654: # takes $record as arg
655: sub record_sep {
656: my $record=shift;
657: my %components=();
658: if ($ENV{'form.upfiletype'} eq 'xml') {
659: } elsif ($ENV{'form.upfiletype'} eq 'space') {
660: my $i=0;
661: foreach (split(/\s+/,$record)) {
662: my $field=$_;
663: $field=~s/^(\"|\')//;
664: $field=~s/(\"|\')$//;
665: $components{$i}=$field;
666: $i++;
667: }
668: } elsif ($ENV{'form.upfiletype'} eq 'tab') {
669: my $i=0;
670: foreach (split(/\t+/,$record)) {
671: my $field=$_;
672: $field=~s/^(\"|\')//;
673: $field=~s/(\"|\')$//;
674: $components{$i}=$field;
675: $i++;
676: }
677: } else {
678: my @allfields=split(/\,/,$record);
679: my $i=0;
680: my $j;
681: for ($j=0;$j<=$#allfields;$j++) {
682: my $field=$allfields[$j];
683: if ($field=~/^\s*(\"|\')/) {
684: my $delimiter=$1;
685: while (($field!~/$delimiter$/) && ($j<$#allfields)) {
686: $j++;
687: $field.=','.$allfields[$j];
688: }
689: $field=~s/^\s*$delimiter//;
690: $field=~s/$delimiter\s*$//;
691: }
692: $components{$i}=$field;
693: $i++;
694: }
695: }
696: return %components;
697: }
698:
699: # =============================== HTML code to select file and specify its type
700: sub upfile_select_html {
701: return (<<'ENDUPFORM');
702: <input type="file" name="upfile" size="50">
703: <br />Type: <select name="upfiletype">
704: <option value="csv">CSV (comma separated values, spreadsheet)</option>
705: <option value="space">Space separated</option>
706: <option value="tab">Tabulator separated</option>
707: <option value="xml">HTML/XML</option>
708: </select>
709: ENDUPFORM
710: }
711:
712: # ===================Prints a table of sample values from each column uploaded
713: # $r is an Apache Request ref
714: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
715: sub csv_print_samples {
716: my ($r,$records) = @_;
717: my (%sone,%stwo,%sthree);
718: %sone=&record_sep($$records[0]);
719: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
720: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
721:
722: $r->print('Samples<br /><table border="2"><tr>');
723: foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column '.($_+1).'</th>'); }
724: $r->print('</tr>');
725: foreach my $hash (\%sone,\%stwo,\%sthree) {
726: $r->print('<tr>');
727: foreach (sort({$a <=> $b} keys(%sone))) {
728: $r->print('<td>');
729: if (defined($$hash{$_})) { $r->print($$hash{$_}); }
730: $r->print('</td>');
731: }
732: $r->print('</tr>');
733: }
734: $r->print('</tr></table><br />'."\n");
735: }
736:
737: # ======Prints a table to create associations between values and table columns
738: # $r is an Apache Request ref
739: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
740: # $d is an array of 2 element arrays (internal name, displayed name)
741: sub csv_print_select_table {
742: my ($r,$records,$d) = @_;
743: my $i=0;my %sone;
744: %sone=&record_sep($$records[0]);
745: $r->print('Associate columns with student attributes.'."\n".
746: '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");
747: foreach (@$d) {
748: my ($value,$display)=@{ $_ };
749: $r->print('<tr><td>'.$display.'</td>');
750:
751: $r->print('<td><select name=f'.$i.
752: ' onchange="javascript:flip(this.form,'.$i.');">');
753: $r->print('<option value="none"></option>');
754: foreach (sort({$a <=> $b} keys(%sone))) {
755: $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');
756: }
757: $r->print('</select></td></tr>'."\n");
758: $i++;
759: }
760: $i--;
761: return $i;
762: }
763:
764: # ===================Prints a table of sample values from the upload and
765: # can make associate samples to internal names
766: # $r is an Apache Request ref
767: # $records is an arrayref from &Apache::loncommon::upfile_record_sep
768: # $d is an array of 2 element arrays (internal name, displayed name)
769: sub csv_samples_select_table {
770: my ($r,$records,$d) = @_;
771: my %sone; my %stwo; my %sthree;
772: my $i=0;
773:
774: $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');
775: %sone=&record_sep($$records[0]);
776: if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
777: if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
778:
779: foreach (sort keys %sone) {
780: $r->print('<tr><td><select name=f'.$i.
781: ' onchange="javascript:flip(this.form,'.$i.');">');
782: foreach (@$d) {
783: my ($value,$display)=@{ $_ };
784: $r->print('<option value='.$value.'>'.$display.'</option>');
785: }
786: $r->print('</select></td><td>');
787: if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
788: if (defined($stwo{$_})) { $r->print($stwo{$_}."</br>\n"); }
789: if (defined($sthree{$_})) { $r->print($sthree{$_}."</br>\n"); }
790: $r->print('</td></tr>');
791: $i++;
792: }
793: $i--;
794: return($i);
795: }
796: 1;
797: __END__;
798:
799:
800: =head1 NAME
801:
802: Apache::loncommon - pile of common routines
803:
804: =head1 SYNOPSIS
805:
806: Referenced by other mod_perl Apache modules.
807:
808: Invocation:
809: &Apache::loncommon::SUBROUTINENAME(ARGUMENTS);
810:
811: =head1 INTRODUCTION
812:
813: Common collection of used subroutines. This collection helps remove
814: redundancy from other modules and increase efficiency of memory usage.
815:
816: Current things done:
817:
818: Makes a table out of the previous homework attempts
819: Inputs result_from_symbread, user, domain, course_id
820: Reads in non-network-related .tab files
821:
822: This is part of the LearningOnline Network with CAPA project
823: described at http://www.lon-capa.org.
824:
825: =head1 HANDLER SUBROUTINE
826:
827: There is no handler subroutine.
828:
829: =head1 OTHER SUBROUTINES
830:
831: =over 4
832:
833: =item *
834:
835: BEGIN() : initialize values from language.tab, copyright.tab, filetypes.tab,
836: and filecategories.tab.
837:
838: =item *
839:
840: languageids() : returns list of all language ids
841:
842: =item *
843:
844: languagedescription() : returns description of a specified language id
845:
846: =item *
847:
848: copyrightids() : returns list of all copyrights
849:
850: =item *
851:
852: copyrightdescription() : returns description of a specified copyright id
853:
854: =item *
855:
856: filecategories() : returns list of all file categories
857:
858: =item *
859:
860: filecategorytypes() : returns list of file types belonging to a given file
861: category
862:
863: =item *
864:
865: fileembstyle() : returns embedding style for a specified file type
866:
867: =item *
868:
869: filedescription() : returns description for a specified file type
870:
871: =item *
872:
873: filedescriptionex() : returns description for a specified file type with
874: extra formatting
875:
876: =item *
877:
878: get_previous_attempt() : return string with previous attempt on problem
879:
880: =item *
881:
882: get_student_view() : show a snapshot of what student was looking at
883:
884: =item *
885:
886: get_student_answers() : show a snapshot of how student was answering problem
887:
888: =item *
889:
890: get_unprocessed_cgi() : get unparsed CGI parameters
891:
892: =item *
893:
894: cacheheader() : returns cache-controlling header code
895:
896: =item *
897:
898: nocache() : specifies header code to not have cache
899:
900: =item *
901:
902: add_to_env($name,$value) : adds $name to the %ENV hash with value
903: $value, if $name already exists, the entry is converted to an array
904: reference and $value is added to the array.
905:
906: =back
907:
908: =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