File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonspreadsheet.pm
Revision
1.119:
download - view:
text,
annotated -
select for diffs
Mon Oct 21 17:59:36 2002 UTC (21 years, 8 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
Module-wide changes: There are no longer seperate $safeeval and $sheetdata
entities. There is only $sheet, which will eventually become an object of
sorts. Most functions earlier took $safeeval and $sheetdata as parameters
but now only take $sheet.
Many comments added to the variables inside the safe space. The safe space
has not been changed in this commit, so there are no speedups to show off.
No longer print a student status selection dialog on non-course spreadsheets.
Still have the bug in which not all student export data makes it into the
course sheet.
1: #
2: # $Id: lonspreadsheet.pm,v 1.119 2002/10/21 17:59:36 matthew Exp $
3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
26: # The LearningOnline Network with CAPA
27: # Spreadsheet/Grades Display Handler
28: #
29: # POD required stuff:
30:
31: =head1 NAME
32:
33: lonspreadsheet
34:
35: =head1 SYNOPSIS
36:
37: Spreadsheet interface to internal LON-CAPA data
38:
39: =head1 DESCRIPTION
40:
41: Lonspreadsheet provides course coordinators the ability to manage their
42: students grades online. The students are able to view their own grades, but
43: not the grades of their peers. The spreadsheet is highly customizable,
44: offering the ability to use Perl code to manipulate data, as well as many
45: built-in functions.
46:
47: =head2 Functions available to user of lonspreadsheet
48:
49: =over 4
50:
51: =cut
52:
53: package Apache::lonspreadsheet;
54:
55: use strict;
56: use Safe;
57: use Safe::Hole;
58: use Opcode;
59: use Apache::lonnet;
60: use Apache::Constants qw(:common :http);
61: use GDBM_File;
62: use HTML::TokeParser;
63: use Apache::lonhtmlcommon;
64: use Apache::loncoursedata;
65: #
66: # Caches for coursewide information
67: #
68: my %Section;
69:
70: #
71: # Caches for previously calculated spreadsheets
72: #
73:
74: my %oldsheets;
75: my %loadedcaches;
76: my %expiredates;
77:
78: #
79: # Cache for stores of an individual user
80: #
81:
82: my $cachedassess;
83: my %cachedstores;
84:
85: #
86: # These cache hashes need to be independent of user, resource and course
87: # (user and course can/should be in the keys)
88: #
89:
90: my %spreadsheets;
91: my %courserdatas;
92: my %userrdatas;
93: my %defaultsheets;
94: my %updatedata;
95:
96: #
97: # These global hashes are dependent on user, course and resource,
98: # and need to be initialized every time when a sheet is calculated
99: #
100: my %courseopt;
101: my %useropt;
102: my %parmhash;
103:
104: #
105: # Some hashes for stats on timing and performance
106: #
107:
108: my %starttimes;
109: my %usedtimes;
110: my %numbertimes;
111:
112: # Stuff that only the screen handler can know
113:
114: my $includedir;
115: my $tmpdir;
116:
117: # =============================================================================
118: # ===================================== Implements an instance of a spreadsheet
119:
120: ##
121: ## mask - used to reside in the safe space.
122: ##
123: sub mask {
124: my ($lower,$upper)=@_;
125:
126: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
127: my $la=$1;
128: my $ld=$2;
129:
130: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
131: my $ua=$1;
132: my $ud=$2;
133: my $alpha='';
134: my $num='';
135:
136: if (($la eq '*') || ($ua eq '*')) {
137: $alpha='[A-Za-z]';
138: } else {
139: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
140: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
141: $alpha='['.$la.'-'.$ua.']';
142: } else {
143: $alpha='['.$la.'-Za-'.$ua.']';
144: }
145: }
146: if (($ld eq '*') || ($ud eq '*')) {
147: $num='\d+';
148: } else {
149: if (length($ld)!=length($ud)) {
150: $num.='(';
151: foreach ($ld=~m/\d/g) {
152: $num.='['.$_.'-9]';
153: }
154: if (length($ud)-length($ld)>1) {
155: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
156: }
157: $num.='|';
158: foreach ($ud=~m/\d/g) {
159: $num.='[0-'.$_.']';
160: }
161: $num.=')';
162: } else {
163: my @lda=($ld=~m/\d/g);
164: my @uda=($ud=~m/\d/g);
165: my $i;
166: my $j=0;
167: my $notdone=1;
168: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
169: if ($lda[$i]==$uda[$i]) {
170: $num.=$lda[$i];
171: $j=$i;
172: } else {
173: $notdone=0;
174: }
175: }
176: if ($j<$#lda-1) {
177: $num.='('.$lda[$j+1];
178: for ($i=$j+2;$i<=$#lda;$i++) {
179: $num.='['.$lda[$i].'-9]';
180: }
181: if ($uda[$j+1]-$lda[$j+1]>1) {
182: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
183: ($#lda-$j-1).'}';
184: }
185: $num.='|'.$uda[$j+1];
186: for ($i=$j+2;$i<=$#uda;$i++) {
187: $num.='[0-'.$uda[$i].']';
188: }
189: $num.=')';
190: } else {
191: if ($lda[$#lda]!=$uda[$#uda]) {
192: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
193: }
194: }
195: }
196: }
197: return '^'.$alpha.$num."\$";
198: }
199:
200:
201:
202: sub initsheet {
203: my $safeeval = new Safe(shift);
204: my $safehole = new Safe::Hole;
205: $safeeval->permit("entereval");
206: $safeeval->permit(":base_math");
207: $safeeval->permit("sort");
208: $safeeval->deny(":base_io");
209: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
210: $safehole->wrap(\&Apache::lonspreadsheet::mask,$safeeval,'&mask');
211: $safehole->wrap(\&Apache::lonspreadsheet::templaterow,$safeeval,'&templaterow');
212: $safeeval->share('$@');
213: my $code=<<'ENDDEFS';
214: # ---------------------------------------------------- Inside of the safe space
215:
216: #
217: # f: formulas
218: # t: intermediate format (variable references expanded)
219: # v: output values
220: # c: preloaded constants (A-column)
221: # rl: row label
222: # os: other spreadsheets (for student spreadsheet only)
223:
224: undef %sheet_values; # Holds the (computed, final) values for the sheet
225: # This is only written to by &calc, the spreadsheet computation routine.
226: # It is read by many functions
227: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,
228: # which does the translation of strings like C5 into the value in C5.
229: # Used in &calc - %t holds the values that are actually eval'd.
230: undef %f; # Holds the formulas for each cell. This is the users
231: # (spreadsheet authors) data for each cell.
232: # set by &setformulas and returned by &getformulas
233: # &setformulas is called by &readsheet, &tmpread, &updateclasssheet,
234: # &updatestudentassesssheet, &loadstudent, &loadcourse
235: # &getformulas is called by &writesheet, &tmpwrite, &updateclasssheet,
236: # &updatestudentassesssheet, &loadstudent, &loadcourse, &loadassessment,
237: undef %c; # Holds the constants for a sheet. In the assessment
238: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed,
239: # &sett, and &setconstants. There is no &getconstants.
240: # &setconstants is called by &loadstudent, &loadcourse, &load assessment,
241: undef %rowlabel; # Holds the 'prefix' for each row. Set by &setrowlabels.
242: # &setrowlabels is called by &updateclasssheet, &updatestudentassesssheet,
243: undef @os; # Holds the names of other spreadsheets - this is used to specify
244: # the spreadsheets that are available for the assessment sheet.
245: # Set by &setothersheets. &setothersheets is called by &handler. A
246: # related subroutine is &othersheets.
247:
248: $maxrow = 0;
249: $sheettype = '';
250:
251: # filename/reference of the sheet
252: $filename = '';
253:
254: # user data
255: $uname = '';
256: $uhome = '';
257: $udom = '';
258:
259: # course data
260:
261: $csec = '';
262: $chome= '';
263: $cnum = '';
264: $cdom = '';
265: $cid = '';
266: $coursefilename = '';
267:
268: # symb
269:
270: $usymb = '';
271:
272: # error messages
273: $errormsg = '';
274:
275:
276: #-------------------------------------------------------
277:
278: =item UWCALC(hashname,modules,units,date)
279:
280: returns the proportion of the module
281: weights not previously completed by the student.
282:
283: =over 4
284:
285: =item hashname
286:
287: name of the hash the module dates have been inserted into
288:
289: =item modules
290:
291: reference to a cell which contains a comma deliminated list of modules
292: covered by the assignment.
293:
294: =item units
295:
296: reference to a cell which contains a comma deliminated list of module
297: weights with respect to the assignment
298:
299: =item date
300:
301: reference to a cell which contains the date the assignment was completed.
302:
303: =back
304:
305: =cut
306:
307: #-------------------------------------------------------
308: sub UWCALC {
309: my ($hashname,$modules,$units,$date) = @_;
310: my @Modules = split(/,/,$modules);
311: my @Units = split(/,/,$units);
312: my $total_weight;
313: foreach (@Units) {
314: $total_weight += $_;
315: }
316: my $usum=0;
317: for (my $i=0; $i<=$#Modules; $i++) {
318: if (&HASH($hashname,$Modules[$i]) eq $date) {
319: $usum += $Units[$i];
320: }
321: }
322: return $usum/$total_weight;
323: }
324:
325: #-------------------------------------------------------
326:
327: =item CDLSUM(list)
328:
329: returns the sum of the elements in a cell which contains
330: a Comma Deliminate List of numerical values.
331: 'list' is a reference to a cell which contains a comma deliminated list.
332:
333: =cut
334:
335: #-------------------------------------------------------
336: sub CDLSUM {
337: my ($list)=@_;
338: my $sum;
339: foreach (split/,/,$list) {
340: $sum += $_;
341: }
342: return $sum;
343: }
344:
345: #-------------------------------------------------------
346:
347: =item CDLITEM(list,index)
348:
349: returns the item at 'index' in a Comma Deliminated List.
350:
351: =over 4
352:
353: =item list
354:
355: reference to a cell which contains a comma deliminated list.
356:
357: =item index
358:
359: the Perl index of the item requested (first element in list has
360: an index of 0)
361:
362: =back
363:
364: =cut
365:
366: #-------------------------------------------------------
367: sub CDLITEM {
368: my ($list,$index)=@_;
369: my @Temp = split/,/,$list;
370: return $Temp[$index];
371: }
372:
373: #-------------------------------------------------------
374:
375: =item CDLHASH(name,key,value)
376:
377: loads a comma deliminated list of keys into
378: the hash 'name', all with a value of 'value'.
379:
380: =over 4
381:
382: =item name
383:
384: name of the hash.
385:
386: =item key
387:
388: (a pointer to) a comma deliminated list of keys.
389:
390: =item value
391:
392: a single value to be entered for each key.
393:
394: =back
395:
396: =cut
397:
398: #-------------------------------------------------------
399: sub CDLHASH {
400: my ($name,$key,$value)=@_;
401: my @Keys;
402: my @Values;
403: # Check to see if we have multiple $key values
404: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
405: my $keymask = &mask($key);
406: # Assume the keys are addresses
407: my @Temp = grep /$keymask/,keys(%sheet_values);
408: @Keys = $sheet_values{@Temp};
409: } else {
410: $Keys[0]= $key;
411: }
412: my @Temp;
413: foreach $key (@Keys) {
414: @Temp = (@Temp, split/,/,$key);
415: }
416: @Keys = @Temp;
417: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
418: my $valmask = &mask($value);
419: my @Temp = grep /$valmask/,keys(%sheet_values);
420: @Values =$sheet_values{@Temp};
421: } else {
422: $Values[0]= $value;
423: }
424: $value = $Values[0];
425: # Add values to hash
426: for (my $i = 0; $i<=$#Keys; $i++) {
427: my $key = $Keys[$i];
428: if (! exists ($hashes{$name}->{$key})) {
429: $hashes{$name}->{$key}->[0]=$value;
430: } else {
431: my @Temp = sort(@{$hashes{$name}->{$key}},$value);
432: $hashes{$name}->{$key} = \@Temp;
433: }
434: }
435: return "hash '$name' updated";
436: }
437:
438: #-------------------------------------------------------
439:
440: =item GETHASH(name,key,index)
441:
442: returns the element in hash 'name'
443: reference by the key 'key', at index 'index' in the values list.
444:
445: =cut
446:
447: #-------------------------------------------------------
448: sub GETHASH {
449: my ($name,$key,$index)=@_;
450: if (! defined($index)) {
451: $index = 0;
452: }
453: if ($key =~ /^[A-z]\d+$/) {
454: $key = $sheet_values{$key};
455: }
456: return $hashes{$name}->{$key}->[$index];
457: }
458:
459: #-------------------------------------------------------
460:
461: =item CLEARHASH(name)
462:
463: clears all the values from the hash 'name'
464:
465: =item CLEARHASH(name,key)
466:
467: clears all the values from the hash 'name' associated with the given key.
468:
469: =cut
470:
471: #-------------------------------------------------------
472: sub CLEARHASH {
473: my ($name,$key)=@_;
474: if (defined($key)) {
475: if (exists($hashes{$name}->{$key})) {
476: $hashes{$name}->{$key}=undef;
477: return "hash '$name' key '$key' cleared";
478: }
479: } else {
480: if (exists($hashes{$name})) {
481: $hashes{$name}=undef;
482: return "hash '$name' cleared";
483: }
484: }
485: return "Error in clearing hash";
486: }
487:
488: #-------------------------------------------------------
489:
490: =item HASH(name,key,value)
491:
492: loads values into an internal hash. If a key
493: already has a value associated with it, the values are sorted numerically.
494:
495: =item HASH(name,key)
496:
497: returns the 0th value in the hash 'name' associated with 'key'.
498:
499: =cut
500:
501: #-------------------------------------------------------
502: sub HASH {
503: my ($name,$key,$value)=@_;
504: my @Keys;
505: undef @Keys;
506: my @Values;
507: # Check to see if we have multiple $key values
508: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
509: my $keymask = &mask($key);
510: # Assume the keys are addresses
511: my @Temp = grep /$keymask/,keys(%sheet_values);
512: @Keys = $sheet_values{@Temp};
513: } else {
514: $Keys[0]= $key;
515: }
516: # If $value is empty, return the first value associated
517: # with the first key.
518: if (! $value) {
519: return $hashes{$name}->{$Keys[0]}->[0];
520: }
521: # Check to see if we have multiple $value(s)
522: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
523: my $valmask = &mask($value);
524: my @Temp = grep /$valmask/,keys(%sheet_values);
525: @Values =$sheet_values{@Temp};
526: } else {
527: $Values[0]= $value;
528: }
529: # Add values to hash
530: for (my $i = 0; $i<=$#Keys; $i++) {
531: my $key = $Keys[$i];
532: my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
533: if (! exists ($hashes{$name}->{$key})) {
534: $hashes{$name}->{$key}->[0]=$value;
535: } else {
536: my @Temp = sort(@{$hashes{$name}->{$key}},$value);
537: $hashes{$name}->{$key} = \@Temp;
538: }
539: }
540: return $Values[-1];
541: }
542:
543: #-------------------------------------------------------
544:
545: =item NUM(range)
546:
547: returns the number of items in the range.
548:
549: =cut
550:
551: #-------------------------------------------------------
552: sub NUM {
553: my $mask=mask(@_);
554: my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
555: return $num;
556: }
557:
558: sub BIN {
559: my ($low,$high,$lower,$upper)=@_;
560: my $mask=mask($lower,$upper);
561: my $num=0;
562: foreach (grep /$mask/,keys(%sheet_values)) {
563: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
564: $num++;
565: }
566: }
567: return $num;
568: }
569:
570:
571: #-------------------------------------------------------
572:
573: =item SUM(range)
574:
575: returns the sum of items in the range.
576:
577: =cut
578:
579: #-------------------------------------------------------
580: sub SUM {
581: my $mask=mask(@_);
582: my $sum=0;
583: foreach (grep /$mask/,keys(%sheet_values)) {
584: $sum+=$sheet_values{$_};
585: }
586: return $sum;
587: }
588:
589: #-------------------------------------------------------
590:
591: =item MEAN(range)
592:
593: compute the average of the items in the range.
594:
595: =cut
596:
597: #-------------------------------------------------------
598: sub MEAN {
599: my $mask=mask(@_);
600: my $sum=0; my $num=0;
601: foreach (grep /$mask/,keys(%sheet_values)) {
602: $sum+=$sheet_values{$_};
603: $num++;
604: }
605: if ($num) {
606: return $sum/$num;
607: } else {
608: return undef;
609: }
610: }
611:
612: #-------------------------------------------------------
613:
614: =item STDDEV(range)
615:
616: compute the standard deviation of the items in the range.
617:
618: =cut
619:
620: #-------------------------------------------------------
621: sub STDDEV {
622: my $mask=mask(@_);
623: my $sum=0; my $num=0;
624: foreach (grep /$mask/,keys(%sheet_values)) {
625: $sum+=$sheet_values{$_};
626: $num++;
627: }
628: unless ($num>1) { return undef; }
629: my $mean=$sum/$num;
630: $sum=0;
631: foreach (grep /$mask/,keys(%sheet_values)) {
632: $sum+=($sheet_values{$_}-$mean)**2;
633: }
634: return sqrt($sum/($num-1));
635: }
636:
637: #-------------------------------------------------------
638:
639: =item PROD(range)
640:
641: compute the product of the items in the range.
642:
643: =cut
644:
645: #-------------------------------------------------------
646: sub PROD {
647: my $mask=mask(@_);
648: my $prod=1;
649: foreach (grep /$mask/,keys(%sheet_values)) {
650: $prod*=$sheet_values{$_};
651: }
652: return $prod;
653: }
654:
655: #-------------------------------------------------------
656:
657: =item MAX(range)
658:
659: compute the maximum of the items in the range.
660:
661: =cut
662:
663: #-------------------------------------------------------
664: sub MAX {
665: my $mask=mask(@_);
666: my $max='-';
667: foreach (grep /$mask/,keys(%sheet_values)) {
668: unless ($max) { $max=$sheet_values{$_}; }
669: if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; }
670: }
671: return $max;
672: }
673:
674: #-------------------------------------------------------
675:
676: =item MIN(range)
677:
678: compute the minimum of the items in the range.
679:
680: =cut
681:
682: #-------------------------------------------------------
683: sub MIN {
684: my $mask=mask(@_);
685: my $min='-';
686: foreach (grep /$mask/,keys(%sheet_values)) {
687: unless ($max) { $max=$sheet_values{$_}; }
688: if (($sheet_values{$_}<$min) || ($min eq '-')) {
689: $min=$sheet_values{$_};
690: }
691: }
692: return $min;
693: }
694:
695: #-------------------------------------------------------
696:
697: =item SUMMAX(num,lower,upper)
698:
699: compute the sum of the largest 'num' items in the range from
700: 'lower' to 'upper'
701:
702: =cut
703:
704: #-------------------------------------------------------
705: sub SUMMAX {
706: my ($num,$lower,$upper)=@_;
707: my $mask=mask($lower,$upper);
708: my @inside=();
709: foreach (grep /$mask/,keys(%sheet_values)) {
710: push (@inside,$sheet_values{$_});
711: }
712: @inside=sort(@inside);
713: my $sum=0; my $i;
714: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
715: $sum+=$inside[$i];
716: }
717: return $sum;
718: }
719:
720: #-------------------------------------------------------
721:
722: =item SUMMIN(num,lower,upper)
723:
724: compute the sum of the smallest 'num' items in the range from
725: 'lower' to 'upper'
726:
727: =cut
728:
729: #-------------------------------------------------------
730: sub SUMMIN {
731: my ($num,$lower,$upper)=@_;
732: my $mask=mask($lower,$upper);
733: my @inside=();
734: foreach (grep /$mask/,keys(%sheet_values)) {
735: $inside[$#inside+1]=$sheet_values{$_};
736: }
737: @inside=sort(@inside);
738: my $sum=0; my $i;
739: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
740: $sum+=$inside[$i];
741: }
742: return $sum;
743: }
744:
745: #-------------------------------------------------------
746:
747: =item MINPARM(parametername)
748:
749: Returns the minimum value of the parameters matching the parametername.
750: parametername should be a string such as 'duedate'.
751:
752: =cut
753:
754: #-------------------------------------------------------
755: sub MINPARM {
756: my ($expression) = @_;
757: my $min = undef;
758: study($expression);
759: foreach $parameter (keys(%c)) {
760: next if ($parameter !~ /$expression/);
761: if ((! defined($min)) || ($min > $c{$parameter})) {
762: $min = $c{$parameter}
763: }
764: }
765: return $min;
766: }
767:
768: #-------------------------------------------------------
769:
770: =item MAXPARM(parametername)
771:
772: Returns the maximum value of the parameters matching the input parameter name.
773: parametername should be a string such as 'duedate'.
774:
775: =cut
776:
777: #-------------------------------------------------------
778: sub MAXPARM {
779: my ($expression) = @_;
780: my $max = undef;
781: study($expression);
782: foreach $parameter (keys(%c)) {
783: next if ($parameter !~ /$expression/);
784: if ((! defined($min)) || ($max < $c{$parameter})) {
785: $max = $c{$parameter}
786: }
787: }
788: return $max;
789: }
790:
791: #--------------------------------------------------------
792: sub expandnamed {
793: my $expression=shift;
794: if ($expression=~/^\&/) {
795: my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
796: my @vars=split(/\W+/,$formula);
797: my %values=();
798: undef %values;
799: foreach ( @vars ) {
800: my $varname=$_;
801: if ($varname=~/\D/) {
802: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
803: $varname=~s/$var/\(\\w\+\)/g;
804: foreach (keys(%c)) {
805: if ($_=~/$varname/) {
806: $values{$1}=1;
807: }
808: }
809: }
810: }
811: if ($func eq 'EXPANDSUM') {
812: my $result='';
813: foreach (keys(%values)) {
814: my $thissum=$formula;
815: $thissum=~s/$var/$_/g;
816: $result.=$thissum.'+';
817: }
818: $result=~s/\+$//;
819: return $result;
820: } else {
821: return 0;
822: }
823: } else {
824: # it is not a function, so it is a parameter name
825: # We should do the following:
826: # 1. Take the list of parameter names
827: # 2. look through the list for ones that match the parameter we want
828: # 3. If there are no collisions, return the one that matches
829: # 4. If there is a collision, return 'bad parameter name error'
830: my $returnvalue = '';
831: my @matches = ();
832: $#matches = -1;
833: study $expression;
834: foreach $parameter (keys(%c)) {
835: push @matches,$parameter if ($parameter =~ /$expression/);
836: }
837: if ($#matches == 0) {
838: $returnvalue = '$c{\''.$matches[0].'\'}';
839: } elsif ($#matches > 0) {
840: # more than one match. Look for a concise one
841: $returnvalue = "'non-unique parameter name : $expression'";
842: foreach (@matches) {
843: if (/^$expression$/) {
844: $returnvalue = '$c{\''.$_.'\'}';
845: }
846: }
847: } else {
848: $returnvalue = "'bad parameter name : $expression'";
849: }
850: return $returnvalue;
851: }
852: }
853:
854: sub sett {
855: %t=();
856: my $pattern='';
857: if ($sheettype eq 'assesscalc') {
858: $pattern='A';
859: } else {
860: $pattern='[A-Z]';
861: }
862: # Deal with the template row
863: foreach (keys(%f)) {
864: next if ($_!~/template\_(\w)/);
865: my $col=$1;
866: next if ($col=~/^$pattern/);
867: foreach (keys(%f)) {
868: next if ($_!~/A(\d+)/);
869: my $trow=$1;
870: next if (! $trow);
871: # Get the name of this cell
872: my $lb=$col.$trow;
873: # Grab the template declaration
874: $t{$lb}=$f{'template_'.$col};
875: # Replace '#' with the row number
876: $t{$lb}=~s/\#/$trow/g;
877: # Replace '....' with ','
878: $t{$lb}=~s/\.\.+/\,/g;
879: # Replace 'A0' with the value from 'A0'
880: $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
881: # Replace parameters
882: $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
883: }
884: }
885: # Deal with the normal cells
886: foreach (keys(%f)) {
887: if (exists($f{$_}) && ($_!~/template\_/)) {
888: my $matches=($_=~/^$pattern(\d+)/);
889: if (($matches) && ($1)) {
890: unless ($f{$_}=~/^\!/) {
891: $t{$_}=$c{$_};
892: }
893: } else {
894: $t{$_}=$f{$_};
895: $t{$_}=~s/\.\.+/\,/g;
896: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
897: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
898: }
899: }
900: }
901: # For inserted lines, [B-Z] is also valid
902: unless ($sheettype eq 'assesscalc') {
903: foreach (keys(%f)) {
904: if ($_=~/[B-Z](\d+)/) {
905: if ($f{'A'.$1}=~/^[\~\-]/) {
906: $t{$_}=$f{$_};
907: $t{$_}=~s/\.\.+/\,/g;
908: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
909: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
910: }
911: }
912: }
913: }
914: # For some reason 'A0' gets special treatment... This seems superfluous
915: # but I imagine it is here for a reason.
916: $t{'A0'}=$f{'A0'};
917: $t{'A0'}=~s/\.\.+/\,/g;
918: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
919: $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
920: }
921:
922: sub calc {
923: undef %sheet_values;
924: &sett();
925: my $notfinished=1;
926: my $lastcalc='';
927: my $depth=0;
928: while ($notfinished) {
929: $notfinished=0;
930: foreach (keys(%t)) {
931: my $old=$sheet_values{$_};
932: $sheet_values{$_}=eval $t{$_};
933: if ($@) {
934: undef %sheet_values;
935: return $_.': '.$@;
936: }
937: if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
938: }
939: $depth++;
940: if ($depth>100) {
941: undef %sheet_values;
942: return $lastcalc.': Maximum calculation depth exceeded';
943: }
944: }
945: return '';
946: }
947:
948: #
949: # This is actually used for the student spreadsheet, not the assessment sheet
950: # Do not be fooled by the name!
951: #
952: sub outrowassess {
953: # $n is the current row number
954: my $n=shift;
955: my @cols=();
956: if ($n) {
957: my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n});
958: if ($rowlabel{$usy}) {
959: $cols[0]=$rowlabel{$usy}.'<br>'.
960: '<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'.
961: '<option name="default">Default</option>';
962: } else {
963: $cols[0]='';
964: }
965: foreach (@os) {
966: $cols[0].='<option name="'.$_.'"';
967: if ($ufn eq $_) {
968: $cols[0].=' selected';
969: }
970: $cols[0].='>'.$_.'</option>';
971: }
972: $cols[0].='</select>';
973: } else {
974: $cols[0]='<b><font size=+1>Export</font></b>';
975: }
976: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
977: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
978: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
979: 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
980: my $fm=$f{$_.$n};
981: $fm=~s/[\'\"]/\&\#34;/g;
982: push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
983: }
984: return @cols;
985: }
986:
987: sub outrow {
988: my $n=shift;
989: my @cols=();
990: if ($n) {
991: $cols[0]=$rowlabel{$f{'A'.$n}};
992: } else {
993: $cols[0]='<b><font size=+1>Export</font></b>';
994: }
995: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
996: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
997: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
998: 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
999: my $fm=$f{$_.$n};
1000: $fm=~s/[\'\"]/\&\#34;/g;
1001: push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
1002: }
1003: return @cols;
1004: }
1005:
1006: sub exportrowa {
1007: my @exportarray=();
1008: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1009: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
1010: push(@exportarray,$sheet_values{$_.'0'});
1011: }
1012: return @exportarray;
1013: }
1014:
1015: sub templaterow {
1016: my @cols=();
1017: $cols[0]='<b><font size=+1>Template</font></b>';
1018: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1019: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
1020: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
1021: 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
1022: my $fm=$f{'template_'.$_};
1023: $fm=~s/[\'\"]/\&\#34;/g;
1024: push(@cols,"'template_$_','$fm'".'___eq___'.$fm);
1025: }
1026: return @cols;
1027: }
1028:
1029:
1030: # ------------------------------------------- End of "Inside of the safe space"
1031: ENDDEFS
1032: $safeeval->reval($code);
1033: return $safeeval;
1034: }
1035:
1036:
1037: # ------------------------------------------------ Add or change formula values
1038: sub setformulas {
1039: my ($sheet)=shift;
1040: %{$sheet->{'safe'}->varglob('f')}=%{$sheet->{'f'}};
1041: }
1042:
1043: # ------------------------------------------------ Add or change formula values
1044: sub setconstants {
1045: my ($sheet)=shift;
1046: return %{$sheet->{'safe'}->varglob('c')}=%{$sheet->{'constants'}};
1047: }
1048:
1049: # --------------------------------------------- Set names of other spreadsheets
1050: sub setothersheets {
1051: my $sheet = shift;
1052: my @othersheets = @_;
1053: $sheet->{'othersheets'} = \@othersheets;
1054: @{$sheet->{'safe'}->varglob('os')}=@othersheets;
1055: return;
1056: }
1057:
1058: # ------------------------------------------------ Add or change formula values
1059: sub setrowlabels {
1060: my $sheet=shift;
1061: %{$sheet->{'safe'}->varglob('rowlabel')}=%{$sheet->{'rowlabel'}};
1062: }
1063:
1064: # ------------------------------------------------------- Calculate spreadsheet
1065: sub calcsheet {
1066: my $sheet=shift;
1067: return $sheet->{'safe'}->reval('&calc();');
1068: }
1069:
1070: # ---------------------------------------------------------------- Get formulas
1071: sub getformulas {
1072: my $sheet = shift;
1073: return %{$sheet->{'safe'}->varglob('f')};
1074: }
1075:
1076: # ----------------------------------------------------- Get value of $f{'A'.$n}
1077: sub getfa {
1078: my $sheet = shift;
1079: my ($n)=@_;
1080: return $sheet->{'safe'}->reval('$f{"A'.$n.'"}');
1081: }
1082:
1083: # ------------------------------------------------------------- Export of A-row
1084: sub exportdata {
1085: my $sheet=shift;
1086: return $sheet->{'safe'}->reval('&exportrowa()');
1087: }
1088:
1089:
1090: # ========================================================== End of Spreadsheet
1091: # =============================================================================
1092:
1093: #
1094: # Procedures for screen output
1095: #
1096: # --------------------------------------------- Produce output row n from sheet
1097:
1098: sub rown {
1099: my ($sheet,$n)=@_;
1100: my $defaultbg;
1101: my $rowdata='';
1102: my $dataflag=0;
1103: unless ($n eq '-') {
1104: $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1105: } else {
1106: $defaultbg='#E0FF';
1107: }
1108: unless ($ENV{'form.showcsv'}) {
1109: $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
1110: } else {
1111: $rowdata.="\n".'"'.$n.'"';
1112: }
1113: my $showf=0;
1114: my $proc;
1115: my $maxred=1;
1116: my $sheettype=$sheet->{'sheettype'};
1117: if ($sheettype eq 'studentcalc') {
1118: $proc='&outrowassess';
1119: $maxred=26;
1120: } else {
1121: $proc='&outrow';
1122: }
1123: if ($sheettype eq 'assesscalc') {
1124: $maxred=1;
1125: } else {
1126: $maxred=26;
1127: }
1128: if (&getfa($sheet,$n)=~/^[\~\-]/) { $maxred=1; }
1129: if ($n eq '-') {
1130: $proc='&templaterow';
1131: $n=-1;
1132: $dataflag=1;
1133: }
1134: foreach ($sheet->{'safe'}->reval($proc.'('.$n.')')) {
1135: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1136: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
1137: if ((($vl ne '') || ($vl eq '0')) &&
1138: (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
1139: if ($showf==0) { $vl=$_; }
1140: unless ($ENV{'form.showcsv'}) {
1141: if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
1142: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1143: if (($showf>$maxred) || ((!$n) && ($showf>0))) {
1144: if ($vl eq '') {
1145: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1146: }
1147: $rowdata.='<td bgcolor='.$bgcolor.'>';
1148: if ($ENV{'request.role'} =~ /^st\./) {
1149: $rowdata.=$vl;
1150: } else {
1151: $rowdata.='<a href="javascript:celledit('.$fm.');">'.
1152: $vl.'</a>';
1153: }
1154: $rowdata.='</td>';
1155: } else {
1156: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1157: }
1158: } else {
1159: $rowdata.=',"'.$vl.'"';
1160: }
1161: $showf++;
1162: } # End of foreach($safeval...)
1163: if ($ENV{'form.showall'} || ($dataflag)) {
1164: return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
1165: } else {
1166: return '';
1167: }
1168: }
1169:
1170: # ------------------------------------------------------------- Print out sheet
1171:
1172: sub outsheet {
1173: my ($r,$sheet)=@_;
1174: my $maxred = 26; # The maximum number of cells to show as
1175: # red (uneditable)
1176: # To make student sheets uneditable could we
1177: # set $maxred = 52?
1178: #
1179: my $realm='Course'; # 'assessment', 'user', or 'course' sheet
1180: if ($sheet->{'sheettype'} eq 'assesscalc') {
1181: $maxred=1;
1182: $realm='Assessment';
1183: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1184: $maxred=26;
1185: $realm='User';
1186: }
1187: #
1188: # Column label
1189: my $tabledata;
1190: if ($ENV{'form.showcsv'}) {
1191: $tabledata='<pre>';
1192: } else {
1193: $tabledata='<table border=2><tr><th colspan=2 rowspan=2>'.
1194: '<font size=+2>'.$realm.'</font></th>'.
1195: '<td bgcolor=#FFDDDD colspan='.$maxred.
1196: '><b><font size=+1>Import</font></b></td>'.
1197: '<td colspan='.(52-$maxred).
1198: '><b><font size=+1>Calculations</font></b></td></tr><tr>';
1199: my $showf=0;
1200: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1201: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
1202: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
1203: 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
1204: $showf++;
1205: if ($showf<=$maxred) {
1206: $tabledata.='<td bgcolor="#FFDDDD">';
1207: } else {
1208: $tabledata.='<td>';
1209: }
1210: $tabledata.="<b><font size=+1>$_</font></b></td>";
1211: }
1212: $tabledata.='</tr>'.&rown($sheet,'-').
1213: &rown($sheet,0);
1214: }
1215: $r->print($tabledata);
1216: #
1217: # Prepare to output rows
1218: my $row;
1219: #
1220: my @sortby=();
1221: my @sortidx=();
1222: for ($row=1;$row<=$sheet->{'maxrow'};$row++) {
1223: push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}'));
1224: push (@sortidx, $row-1);
1225: }
1226: @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx;
1227: #
1228: # Determine the type of child spreadsheets
1229: my $what='Student';
1230: if ($sheet->{'sheettype'} eq 'assesscalc') {
1231: $what='Item';
1232: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1233: $what='Assessment';
1234: }
1235: #
1236: # Loop through the rows and output them one at a time
1237: my $n=0;
1238: for ($row=0;$row<$sheet->{'maxrow'};$row++) {
1239: my $thisrow=&rown($sheet,$sortidx[$row]+1);
1240: if ($thisrow) {
1241: if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
1242: $r->print("</table>\n<br>\n");
1243: $r->rflush();
1244: $r->print('<table border=2><tr><td> <td>'.$what.'</td>');
1245: $r->print('<td>'.
1246: join('</td><td>',
1247: (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
1248: 'abcdefghijklmnopqrstuvwxyz'))).
1249: "</td></tr>\n");
1250: }
1251: $n++;
1252: $r->print($thisrow);
1253: }
1254: }
1255: $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
1256: }
1257:
1258: #
1259: # ----------------------------------------------- Read list of available sheets
1260: #
1261: sub othersheets {
1262: my ($sheet,$stype)=@_;
1263: $stype = $sheet->{'sheettype'} if (! defined($stype));
1264: #
1265: my $cnum = $sheet->{'cnum'};
1266: my $cdom = $sheet->{'cdom'};
1267: my $chome = $sheet->{'chome'};
1268: #
1269: my @alternatives=();
1270: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
1271: my ($tmp) = keys(%results);
1272: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1273: @alternatives = sort (keys(%results));
1274: }
1275: return @alternatives;
1276: }
1277:
1278:
1279: #
1280: # -------------------------------------- Parse a spreadsheet
1281: #
1282: sub parse_sheet {
1283: # $sheetxml is a scalar reference or a scalar
1284: my ($sheetxml) = @_;
1285: if (! ref($sheetxml)) {
1286: my $tmp = $sheetxml;
1287: $sheetxml = \$tmp;
1288: }
1289: my %f;
1290: my $parser=HTML::TokeParser->new($sheetxml);
1291: my $token;
1292: while ($token=$parser->get_token) {
1293: if ($token->[0] eq 'S') {
1294: if ($token->[1] eq 'field') {
1295: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
1296: $parser->get_text('/field');
1297: }
1298: if ($token->[1] eq 'template') {
1299: $f{'template_'.$token->[2]->{'col'}}=
1300: $parser->get_text('/template');
1301: }
1302: }
1303: }
1304: return \%f;
1305: }
1306:
1307: #
1308: # -------------------------------------- Read spreadsheet formulas for a course
1309: #
1310: sub readsheet {
1311: my ($sheet,$fn)=@_;
1312: #
1313: my $stype = $sheet->{'sheettype'};
1314: my $cnum = $sheet->{'cnum'};
1315: my $cdom = $sheet->{'cdom'};
1316: my $chome = $sheet->{'chome'};
1317: #
1318: if (! defined($fn)) {
1319: # There is no filename. Look for defaults in course and global, cache
1320: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
1321: my %tmphash = &Apache::lonnet::get('environment',
1322: ['spreadsheet_default_'.$stype],
1323: $cdom,$cnum);
1324: my ($tmp) = keys(%tmphash);
1325: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1326: $fn = 'default_'.$stype;
1327: } else {
1328: $fn = $tmphash{'spreadsheet_default_'.$stype};
1329: }
1330: unless (($fn) && ($fn!~/^error\:/)) {
1331: $fn='default_'.$stype;
1332: }
1333: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
1334: }
1335: }
1336: # $fn now has a value
1337: $sheet->{'filename'} = $fn;
1338: # see if sheet is cached
1339: my $fstring='';
1340: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
1341: my %tmp = split(/___;___/,$fstring);
1342: $sheet->{'f'} = \%tmp;
1343: &setformulas($sheet);
1344: } else {
1345: # Not cached, need to read
1346: my %f=();
1347: if ($fn=~/^default\_/) {
1348: my $sheetxml='';
1349: my $fh;
1350: my $dfn=$fn;
1351: $dfn=~s/\_/\./g;
1352: if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
1353: $sheetxml=join('',<$fh>);
1354: } else {
1355: $sheetxml='<field row="0" col="A">"Error"</field>';
1356: }
1357: %f=%{&parse_sheet(\$sheetxml)};
1358: } elsif($fn=~/\/*\.spreadsheet$/) {
1359: my $sheetxml=&Apache::lonnet::getfile
1360: (&Apache::lonnet::filelocation('',$fn));
1361: if ($sheetxml == -1) {
1362: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1363: .$fn.'"</field>';
1364: }
1365: %f=%{&parse_sheet(\$sheetxml)};
1366: } else {
1367: my $sheet='';
1368: my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
1369: my ($tmp) = keys(%tmphash);
1370: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1371: foreach (keys(%tmphash)) {
1372: $f{$_}=$tmphash{$_};
1373: }
1374: }
1375: }
1376: # Cache and set
1377: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1378: $sheet->{'f'}=\%f;
1379: &setformulas($sheet);
1380: }
1381: }
1382:
1383: # -------------------------------------------------------- Make new spreadsheet
1384: sub makenewsheet {
1385: my ($uname,$udom,$stype,$usymb)=@_;
1386: my $sheet={};
1387: $sheet->{'uname'} = $uname;
1388: $sheet->{'udom'} = $udom;
1389: $sheet->{'sheettype'} = $stype;
1390: $sheet->{'usymb'} = $usymb;
1391: $sheet->{'cid'} = $ENV{'request.course.id'};
1392: $sheet->{'csec'} = $Section{$uname.':'.$udom};
1393: $sheet->{'coursefilename'} = $ENV{'request.course.fn'};
1394: $sheet->{'cnum'} = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1395: $sheet->{'cdom'} = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
1396: $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
1397: $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
1398: #
1399: #
1400: $sheet->{'f'} = {};
1401: $sheet->{'constants'} = {};
1402: $sheet->{'othersheets'} = [];
1403: $sheet->{'rowlabel'} = {};
1404: #
1405: #
1406: $sheet->{'safe'}=&initsheet($sheet->{'sheettype'});
1407: #
1408: # Place all the %$sheet items into the safe space except the safe space
1409: # itself
1410: my $initstring = '';
1411: foreach (qw/uname udom sheettype usymb cid csec coursefilename
1412: cnum cdom chome uhome/) {
1413: $initstring.= qq{\$$_="$sheet->{$_}";};
1414: }
1415: $sheet->{'safe'}->reval($initstring);
1416: return $sheet;
1417: }
1418:
1419: # ------------------------------------------------------------ Save spreadsheet
1420: sub writesheet {
1421: my ($sheet,$makedef)=@_;
1422: my $cid=$sheet->{'cid'};
1423: if (&Apache::lonnet::allowed('opa',$cid)) {
1424: my %f=&getformulas($sheet);
1425: my $stype= $sheet->{'sheettype'};
1426: my $cnum = $sheet->{'cnum'};
1427: my $cdom = $sheet->{'cdom'};
1428: my $chome= $sheet->{'chome'};
1429: my $fn = $sheet->{'filename'};
1430: # Cache new sheet
1431: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1432: # Write sheet
1433: my $sheetdata='';
1434: foreach (keys(%f)) {
1435: unless ($f{$_} eq 'import') {
1436: $sheetdata.=&Apache::lonnet::escape($_).'='.
1437: &Apache::lonnet::escape($f{$_}).'&';
1438: }
1439: }
1440: $sheetdata=~s/\&$//;
1441: my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
1442: $sheetdata,$chome);
1443: if ($reply eq 'ok') {
1444: $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
1445: $stype.'_spreadsheets:'.
1446: &Apache::lonnet::escape($fn).
1447: '='.$ENV{'user.name'}.'@'.
1448: $ENV{'user.domain'},
1449: $chome);
1450: if ($reply eq 'ok') {
1451: if ($makedef) {
1452: return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
1453: ':environment:'.
1454: 'spreadsheet_default_'.
1455: $stype.'='.
1456: &Apache::lonnet::escape($fn),
1457: $chome);
1458: }
1459: return $reply;
1460: }
1461: return $reply;
1462: }
1463: return $reply;
1464: }
1465: return 'unauthorized';
1466: }
1467:
1468: # ----------------------------------------------- Make a temp copy of the sheet
1469: # "Modified workcopy" - interactive only
1470: #
1471: sub tmpwrite {
1472: my ($sheet) = @_;
1473: my $fn=$ENV{'user.name'}.'_'.
1474: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
1475: $sheet->{'filename'};
1476: $fn=~s/\W/\_/g;
1477: $fn=$tmpdir.$fn.'.tmp';
1478: my $fh;
1479: if ($fh=Apache::File->new('>'.$fn)) {
1480: print $fh join("\n",&getformulas($sheet));
1481: }
1482: }
1483:
1484: # ---------------------------------------------------------- Read the temp copy
1485: sub tmpread {
1486: my ($sheet,$nfield,$nform)=@_;
1487: my $fn=$ENV{'user.name'}.'_'.
1488: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
1489: $sheet->{'filename'};
1490: $fn=~s/\W/\_/g;
1491: $fn=$tmpdir.$fn.'.tmp';
1492: my $fh;
1493: my %fo=();
1494: my $countrows=0;
1495: if ($fh=Apache::File->new($fn)) {
1496: my $name;
1497: while ($name=<$fh>) {
1498: chomp($name);
1499: my $value=<$fh>;
1500: chomp($value);
1501: $fo{$name}=$value;
1502: if ($name=~/^A(\d+)$/) {
1503: if ($1>$countrows) {
1504: $countrows=$1;
1505: }
1506: }
1507: }
1508: }
1509: if ($nform eq 'changesheet') {
1510: $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
1511: unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
1512: $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
1513: }
1514: } elsif ($nfield eq 'insertrow') {
1515: $countrows++;
1516: my $newrow=substr('000000'.$countrows,-7);
1517: if ($nform eq 'top') {
1518: $fo{'A'.$countrows}='--- '.$newrow;
1519: } else {
1520: $fo{'A'.$countrows}='~~~ '.$newrow;
1521: }
1522: } else {
1523: if ($nfield) { $fo{$nfield}=$nform; }
1524: }
1525: $sheet->{'f'}=\%fo;
1526: &setformulas($sheet);
1527: }
1528:
1529: ##################################################
1530: ##################################################
1531:
1532: =pod
1533:
1534: =item &parmval()
1535:
1536: Determine the value of a parameter.
1537:
1538: Inputs: $what, the parameter needed, $sheet, the safe space
1539:
1540: Returns: The value of a parameter, or '' if none.
1541:
1542: This function cascades through the possible levels searching for a value for
1543: a parameter. The levels are checked in the following order:
1544: user, course (at section level and course level), map, and lonnet::metadata.
1545: This function uses %parmhash, which must be tied prior to calling it.
1546: This function also requires %courseopt and %useropt to be initialized for
1547: this user and course.
1548:
1549: =cut
1550:
1551: ##################################################
1552: ##################################################
1553: sub parmval {
1554: my ($what,$sheet)=@_;
1555: my $symb = $sheet->{'usymb'};
1556: unless ($symb) { return ''; }
1557: #
1558: my $cid = $sheet->{'cid'};
1559: my $csec = $sheet->{'csec'};
1560: my $uname = $sheet->{'uname'};
1561: my $udom = $sheet->{'udom'};
1562: my $result='';
1563: #
1564: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
1565: # Cascading lookup scheme
1566: my $rwhat=$what;
1567: $what =~ s/^parameter\_//;
1568: $what =~ s/\_([^\_]+)$/\.$1/;
1569: #
1570: my $symbparm = $symb.'.'.$what;
1571: my $mapparm = $mapname.'___(all).'.$what;
1572: my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
1573: #
1574: my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what;
1575: my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
1576: my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
1577: #
1578: my $courselevel = $usercourseprefix.'.'.$what;
1579: my $courselevelr = $usercourseprefix.'.'.$symbparm;
1580: my $courselevelm = $usercourseprefix.'.'.$mapparm;
1581: # fourth, check user
1582: if (defined($uname)) {
1583: return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
1584: return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
1585: return $useropt{$courselevel} if (defined($useropt{$courselevel}));
1586: }
1587: # third, check course
1588: if (defined($csec)) {
1589: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
1590: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
1591: return $courseopt{$seclevel} if (defined($courseopt{$seclevel}));
1592: }
1593: #
1594: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
1595: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
1596: return $courseopt{$courselevel} if (defined($courseopt{$courselevel}));
1597: # second, check map parms
1598: my $thisparm = $parmhash{$symbparm};
1599: return $thisparm if (defined($thisparm));
1600: # first, check default
1601: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1602: }
1603:
1604: # ---------------------------------------------- Update rows for course listing
1605: sub updateclasssheet {
1606: my ($sheet) = @_;
1607: my $cnum =$sheet->{'cnum'};
1608: my $cdom =$sheet->{'cdom'};
1609: my $cid =$sheet->{'cid'};
1610: my $chome =$sheet->{'chome'};
1611: #
1612: %Section = ();
1613:
1614: #
1615: # Read class list and row labels
1616: my $classlist = &Apache::loncoursedata::get_classlist();
1617: if (! defined($classlist)) {
1618: return 'Could not access course classlist';
1619: }
1620: #
1621: my %currentlist=();
1622: foreach my $student (keys(%$classlist)) {
1623: my ($studentDomain,$studentName,$end,$start,$id,$studentSection,
1624: $fullname,$status) = @{$classlist->{$student}};
1625: if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') {
1626: my $rowlabel='';
1627: if ($ENV{'form.showcsv'}) {
1628: $rowlabel= '"'.join('","',($studentName,$studentDomain,
1629: $fullname,$studentSection,$id).'"');
1630: } else {
1631: $rowlabel='<a href="/adm/studentcalc?uname='.$studentName.
1632: '&udom='.$studentDomain.'">';
1633: $rowlabel.=$studentSection.' '.$id." ".$fullname;
1634: $rowlabel.='</a>';
1635: }
1636: $currentlist{$student}=$rowlabel;
1637: }
1638: }
1639: #
1640: # Find discrepancies between the course row table and this
1641: #
1642: my %f=&getformulas($sheet);
1643: my $changed=0;
1644: #
1645: $sheet->{'maxrow'}=0;
1646: my %existing=();
1647: #
1648: # Now obsolete rows
1649: foreach (keys(%f)) {
1650: if ($_=~/^A(\d+)/) {
1651: if ($1 > $sheet->{'maxrow'}) {
1652: $sheet->{'maxrow'}= $1;
1653: }
1654: $existing{$f{$_}}=1;
1655: unless ((defined($currentlist{$f{$_}})) || (!$1) ||
1656: ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
1657: $f{$_}='!!! Obsolete';
1658: $changed=1;
1659: }
1660: }
1661: }
1662: #
1663: # New and unknown keys
1664: foreach (sort keys(%currentlist)) {
1665: unless ($existing{$_}) {
1666: $changed=1;
1667: $sheet->{'maxrow'}++;
1668: $f{'A'.$sheet->{'maxrow'}}=$_;
1669: }
1670: }
1671: if ($changed) {
1672: $sheet->{'f'} = \%f;
1673: &setformulas($sheet,%f);
1674: }
1675: #
1676: $sheet->{'rowlabel'} = \%currentlist;
1677: &setrowlabels($sheet);
1678: }
1679:
1680: # ----------------------------------- Update rows for student and assess sheets
1681: sub updatestudentassesssheet {
1682: my ($sheet) = @_;
1683: my %bighash;
1684: my $stype=$sheet->{'sheettype'};
1685: my $uname=$sheet->{'uname'};
1686: my $udom =$sheet->{'udom'};
1687: $sheet->{'rowlabel'} = {};
1688: if ($updatedata
1689: {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {
1690: %{$sheet->{'rowlabel'}}=split(/___;___/,
1691: $updatedata{$ENV{'request.course.fn'}.
1692: '_'.$stype.'_'.$uname.'_'.$udom});
1693: } else {
1694: # Tie hash
1695: tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
1696: &GDBM_READER(),0640);
1697: if (! tied(%bighash)) {
1698: return 'Could not access course data';
1699: }
1700: # Get all assessments
1701: my %allkeys=('timestamp' =>
1702: 'Timestamp of Last Transaction<br>timestamp',
1703: 'subnumber' =>
1704: 'Number of Submissions<br>subnumber',
1705: 'tutornumber' =>
1706: 'Number of Tutor Responses<br>tutornumber',
1707: 'totalpoints' =>
1708: 'Total Points Granted<br>totalpoints');
1709: my $adduserstr='';
1710: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){
1711: $adduserstr='&uname='.$uname.'&udom='.$udom;
1712: }
1713: my %allassess =
1714: ('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'.
1715: $adduserstr.'">Feedback</a>',
1716: '_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'.
1717: $adduserstr.'">Evaluation</a>',
1718: '_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'.
1719: $adduserstr.'">Tutoring</a>',
1720: '_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'.
1721: $adduserstr.'">Discussion</a>'
1722: );
1723: while (($_,undef) = each(%bighash)) {
1724: next if ($_!~/^src\_(\d+)\.(\d+)$/);
1725: my $mapid=$1;
1726: my $resid=$2;
1727: my $id=$mapid.'.'.$resid;
1728: my $srcf=$bighash{$_};
1729: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1730: my $symb=
1731: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1732: '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
1733: $allassess{$symb}=
1734: '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
1735: $bighash{'title_'.$id}.'</a>';
1736: next if ($stype ne 'assesscalc');
1737: foreach my $key (split(/\,/,
1738: &Apache::lonnet::metadata($srcf,'keys')
1739: )) {
1740: next if ($key !~ /^(stores|parameter)_/);
1741: my $display=
1742: &Apache::lonnet::metadata($srcf,$key.'.display');
1743: unless ($display) {
1744: $display.=
1745: &Apache::lonnet::metadata($srcf,$key.'.name');
1746: }
1747: $display.='<br>'.$key;
1748: $allkeys{$key}=$display;
1749: } # end of foreach
1750: }
1751: } # end of foreach (keys(%bighash))
1752: untie(%bighash);
1753: #
1754: # %allkeys has a list of storage and parameter displays by unikey
1755: # %allassess has a list of all resource displays by symb
1756: #
1757: if ($stype eq 'assesscalc') {
1758: $sheet->{'rowlabel'} = \%allkeys;
1759: } elsif ($stype eq 'studentcalc') {
1760: $sheet->{'rowlabel'} = \%allassess;
1761: }
1762: $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
1763: join('___;___',%{$sheet->{'rowlabel'}});
1764: # Get current from cache
1765: }
1766: # Find discrepancies between the course row table and this
1767: #
1768: my %f=&getformulas($sheet);
1769: my $changed=0;
1770:
1771: $sheet->{'maxrow'} = 0;
1772: my %existing=();
1773: # Now obsolete rows
1774: foreach (keys(%f)) {
1775: next if ($_!~/^A(\d+)/);
1776: if ($1 > $sheet->{'maxrow'}) {
1777: $sheet->{'maxrow'} = $1;
1778: }
1779: my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
1780: $existing{$usy}=1;
1781: unless ((exists($sheet->{'rowlabel'}->{$usy}) &&
1782: (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) ||
1783: ($f{$_}=~/^(\~\~\~|\-\-\-)/))){
1784: $f{$_}='!!! Obsolete';
1785: $changed=1;
1786: } elsif ($ufn) {
1787: $sheet->{'rowlabel'}->{$usy}
1788: =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
1789: }
1790: }
1791: # New and unknown keys
1792: foreach (keys(%{$sheet->{'rowlabel'}})) {
1793: unless ($existing{$_}) {
1794: $changed=1;
1795: $sheet->{'maxrow'}++;
1796: $f{'A'.$sheet->{'maxrow'}}=$_;
1797: }
1798: }
1799: if ($changed) {
1800: $sheet->{'f'} = \%f;
1801: &setformulas($sheet);
1802: }
1803: &setrowlabels($sheet);
1804: #
1805: undef %existing;
1806: }
1807:
1808: # ------------------------------------------------ Load data for one assessment
1809:
1810: sub loadstudent {
1811: my ($sheet)=@_;
1812: my %c=();
1813: my %f=&getformulas($sheet);
1814: $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'};
1815: # Get ALL the student preformance data
1816: my @tmp = &Apache::lonnet::dump($sheet->{'cid'},
1817: $sheet->{'udom'},
1818: $sheet->{'uname'},
1819: undef);
1820: if ($tmp[0] !~ /^error:/) {
1821: %cachedstores = @tmp;
1822: }
1823: undef @tmp;
1824: #
1825: my @assessdata=();
1826: foreach (keys(%f)) {
1827: next if ($_!~/^A(\d+)/);
1828: my $row=$1;
1829: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
1830: my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
1831: @assessdata=&exportsheet($sheet->{'uname'},
1832: $sheet->{'udom'},
1833: 'assesscalc',$usy,$ufn);
1834: my $index=0;
1835: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1836: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
1837: if ($assessdata[$index]) {
1838: my $col=$_;
1839: if ($assessdata[$index]=~/\D/) {
1840: $c{$col.$row}="'".$assessdata[$index]."'";
1841: } else {
1842: $c{$col.$row}=$assessdata[$index];
1843: }
1844: unless ($col eq 'A') {
1845: $f{$col.$row}='import';
1846: }
1847: }
1848: $index++;
1849: }
1850: }
1851: $cachedassess='';
1852: undef %cachedstores;
1853: $sheet->{'f'} = \%f;
1854: $sheet->{'constants'} = \%c;
1855: &setformulas($sheet);
1856: &setconstants($sheet);
1857: }
1858:
1859: # --------------------------------------------------- Load data for one student
1860: #
1861: sub loadcourse {
1862: my ($sheet,$r)=@_;
1863: my %c=();
1864: my %f=&getformulas($sheet);
1865: my $total=0;
1866: foreach (keys(%f)) {
1867: if ($_=~/^A(\d+)/) {
1868: unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
1869: }
1870: }
1871: my $now=0;
1872: my $since=time;
1873: $r->print(<<ENDPOP);
1874: <script>
1875: popwin=open('','popwin','width=400,height=100');
1876: popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
1877: '<h3>Spreadsheet Calculation Progress</h3>'+
1878: '<form name=popremain>'+
1879: '<input type=text size=35 name=remaining value=Starting></form>'+
1880: '</body></html>');
1881: popwin.document.close();
1882: </script>
1883: ENDPOP
1884: $r->rflush();
1885: foreach (keys(%f)) {
1886: next if ($_!~/^A(\d+)/);
1887: my $row=$1;
1888: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
1889: my @studentdata=&exportsheet(split(/\:/,$f{$_}),
1890: 'studentcalc');
1891: undef %userrdatas;
1892: $now++;
1893: $r->print('<script>popwin.document.popremain.remaining.value="'.
1894: $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
1895: ' secs remaining";</script>');
1896: $r->rflush();
1897: #
1898: my $index=0;
1899: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1900: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
1901: if ($studentdata[$index]) {
1902: my $col=$_;
1903: if ($studentdata[$index]=~/\D/) {
1904: $c{$col.$row}="'".$studentdata[$index]."'";
1905: } else {
1906: $c{$col.$row}=$studentdata[$index];
1907: }
1908: unless ($col eq 'A') {
1909: $f{$col.$row}='import';
1910: }
1911: $index++;
1912: }
1913: }
1914: }
1915: $sheet->{'f'}=\%f;
1916: $sheet->{'constants'}=\%c;
1917: &setformulas($sheet);
1918: &setconstants($sheet);
1919: $r->print('<script>popwin.close()</script>');
1920: $r->rflush();
1921: }
1922:
1923: # ------------------------------------------------ Load data for one assessment
1924: #
1925: sub loadassessment {
1926: my ($sheet)=@_;
1927:
1928: my $uhome = $sheet->{'uhome'};
1929: my $uname = $sheet->{'uname'};
1930: my $udom = $sheet->{'udom'};
1931: my $symb = $sheet->{'usymb'};
1932: my $cid = $sheet->{'cid'};
1933: my $cnum = $sheet->{'cnum'};
1934: my $cdom = $sheet->{'cdom'};
1935: my $chome = $sheet->{'chome'};
1936:
1937: my $namespace;
1938: unless ($namespace=$cid) { return ''; }
1939: # Get stored values
1940: my %returnhash=();
1941: if ($cachedassess eq $uname.':'.$udom) {
1942: #
1943: # get data out of the dumped stores
1944: #
1945: my $version=$cachedstores{'version:'.$symb};
1946: my $scope;
1947: for ($scope=1;$scope<=$version;$scope++) {
1948: foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
1949: $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
1950: }
1951: }
1952: } else {
1953: #
1954: # restore individual
1955: #
1956: %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
1957: for (my $version=1;$version<=$returnhash{'version'};$version++) {
1958: foreach (split(/\:/,$returnhash{$version.':keys'})) {
1959: $returnhash{$_}=$returnhash{$version.':'.$_};
1960: }
1961: }
1962: }
1963: #
1964: # returnhash now has all stores for this resource
1965: # convert all "_" to "." to be able to use libraries, multiparts, etc
1966: #
1967: # This is dumb. It is also necessary :(
1968: my @oldkeys=keys %returnhash;
1969: #
1970: foreach my $name (@oldkeys) {
1971: my $value=$returnhash{$name};
1972: delete $returnhash{$name};
1973: $name=~s/\_/\./g;
1974: $returnhash{$name}=$value;
1975: }
1976: # initialize coursedata and userdata for this user
1977: undef %courseopt;
1978: undef %useropt;
1979:
1980: my $userprefix=$uname.'_'.$udom.'_';
1981:
1982: unless ($uhome eq 'no_host') {
1983: # Get coursedata
1984: unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
1985: my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum);
1986: $courserdatas{$cid}=\%Tmp;
1987: $courserdatas{$cid.'.last_cache'}=time;
1988: }
1989: while (my ($name,$value) = each(%{$courserdatas{$cid}})) {
1990: $courseopt{$userprefix.$name}=$value;
1991: }
1992: # Get userdata (if present)
1993: unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) {
1994: my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname);
1995: $userrdatas{$cid} = \%Tmp;
1996: # Most of the time the user does not have a 'resourcedata.db'
1997: # file. We need to cache that we got nothing instead of bothering
1998: # with requesting it every time.
1999: $userrdatas{$uname.'@'.$udom.'.last_cache'}=time;
2000: }
2001: while (my ($name,$value) = each(%{$userrdatas{$cid}})) {
2002: $useropt{$userprefix.$name}=$value;
2003: }
2004: }
2005: # now courseopt, useropt initialized for this user and course
2006: # (used by parmval)
2007: #
2008: # Load keys for this assessment only
2009: #
2010: my %thisassess=();
2011: my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
2012: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
2013: $thisassess{$_}=1;
2014: }
2015: #
2016: # Load parameters
2017: #
2018: my %c=();
2019: if (tie(%parmhash,'GDBM_File',
2020: $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
2021: my %f=&getformulas($sheet);
2022: foreach (keys(%f)) {
2023: next if ($_!~/^A/);
2024: next if ($f{$_}=~/^[\!\~\-]/);
2025: if ($f{$_}=~/^parameter/) {
2026: if ($thisassess{$f{$_}}) {
2027: my $val=&parmval($f{$_},$sheet);
2028: $c{$_}=$val;
2029: $c{$f{$_}}=$val;
2030: }
2031: } else {
2032: my $key=$f{$_};
2033: my $ckey=$key;
2034: $key=~s/^stores\_/resource\./;
2035: $key=~s/\_/\./g;
2036: $c{$_}=$returnhash{$key};
2037: $c{$ckey}=$returnhash{$key};
2038: }
2039: }
2040: untie(%parmhash);
2041: }
2042: $sheet->{'constants'}=\%c;
2043: &setconstants($sheet);
2044: }
2045:
2046: # --------------------------------------------------------- Various form fields
2047:
2048: sub textfield {
2049: my ($title,$name,$value)=@_;
2050: return "\n<p><b>$title:</b><br>".
2051: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
2052: }
2053:
2054: sub hiddenfield {
2055: my ($name,$value)=@_;
2056: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
2057: }
2058:
2059: sub selectbox {
2060: my ($title,$name,$value,%options)=@_;
2061: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
2062: foreach (sort keys(%options)) {
2063: $selout.='<option value="'.$_.'"';
2064: if ($_ eq $value) { $selout.=' selected'; }
2065: $selout.='>'.$options{$_}.'</option>';
2066: }
2067: return $selout.'</select>';
2068: }
2069:
2070: # =============================================== Update information in a sheet
2071: #
2072: # Add new users or assessments, etc.
2073: #
2074:
2075: sub updatesheet {
2076: my ($sheet)=@_;
2077: my $stype=$sheet->{'sheettype'};
2078: if ($stype eq 'classcalc') {
2079: return &updateclasssheet($sheet);
2080: } else {
2081: return &updatestudentassesssheet($sheet);
2082: }
2083: }
2084:
2085: # =================================================== Load the rows for a sheet
2086: #
2087: # Import the data for rows
2088: #
2089:
2090: sub loadrows {
2091: my ($sheet,$r)=@_;
2092: my $stype=$sheet->{'sheettype'};
2093: if ($stype eq 'classcalc') {
2094: &loadcourse($sheet,$r);
2095: } elsif ($stype eq 'studentcalc') {
2096: &loadstudent($sheet);
2097: } else {
2098: &loadassessment($sheet);
2099: }
2100: }
2101:
2102: # ======================================================= Forced recalculation?
2103:
2104: sub checkthis {
2105: my ($keyname,$time)=@_;
2106: return ($time<$expiredates{$keyname});
2107: }
2108:
2109: sub forcedrecalc {
2110: my ($uname,$udom,$stype,$usymb)=@_;
2111: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
2112: my $time=$oldsheets{$key.'.time'};
2113: if ($ENV{'form.forcerecalc'}) { return 1; }
2114: unless ($time) { return 1; }
2115: if ($stype eq 'assesscalc') {
2116: my $map=(split(/\_\_\_/,$usymb))[0];
2117: if (&checkthis('::assesscalc:',$time) ||
2118: &checkthis('::assesscalc:'.$map,$time) ||
2119: &checkthis('::assesscalc:'.$usymb,$time) ||
2120: &checkthis($uname.':'.$udom.':assesscalc:',$time) ||
2121: &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
2122: &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
2123: return 1;
2124: }
2125: } else {
2126: if (&checkthis('::studentcalc:',$time) ||
2127: &checkthis($uname.':'.$udom.':studentcalc:',$time)) {
2128: return 1;
2129: }
2130: }
2131: return 0;
2132: }
2133:
2134: # ============================================================== Export handler
2135: #
2136: # Non-interactive call from with program
2137: #
2138:
2139: sub exportsheet {
2140: my ($uname,$udom,$stype,$usymb,$fn)=@_;
2141: my @exportarr=();
2142: if (($usymb=~/^\_(\w+)/) && (!$fn)) {
2143: $fn='default_'.$1;
2144: }
2145: #
2146: # Check if cached
2147: #
2148: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
2149: my $found='';
2150: if ($oldsheets{$key}) {
2151: foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
2152: my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
2153: if ($name eq $fn) {
2154: $found=$value;
2155: }
2156: }
2157: }
2158: unless ($found) {
2159: &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
2160: if ($oldsheets{$key}) {
2161: foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
2162: my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
2163: if ($name eq $fn) {
2164: $found=$value;
2165: }
2166: }
2167: }
2168: }
2169: #
2170: # Check if still valid
2171: #
2172: if ($found) {
2173: if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
2174: $found='';
2175: }
2176: }
2177: if ($found) {
2178: #
2179: # Return what was cached
2180: #
2181: @exportarr=split(/\_\_\_\;\_\_\_/,$found);
2182: } else {
2183: #
2184: # Not cached
2185: #
2186: my ($sheet)=&makenewsheet($uname,$udom,$stype,$usymb);
2187: &readsheet($sheet,$fn);
2188: &updatesheet($sheet);
2189: &loadrows($sheet);
2190: &calcsheet($sheet);
2191: @exportarr=&exportdata($sheet);
2192: #
2193: # Store now
2194: #
2195: my $cid=$ENV{'request.course.id'};
2196: my $current='';
2197: if ($stype eq 'studentcalc') {
2198: $current=&Apache::lonnet::reply('get:'.
2199: $ENV{'course.'.$cid.'.domain'}.':'.
2200: $ENV{'course.'.$cid.'.num'}.
2201: ':nohist_calculatedsheets:'.
2202: &Apache::lonnet::escape($key),
2203: $ENV{'course.'.$cid.'.home'});
2204: } else {
2205: $current=&Apache::lonnet::reply('get:'.$sheet->{'udom'}.':'.
2206: $sheet->{'uname'}.
2207: ':nohist_calculatedsheets_'.
2208: $ENV{'request.course.id'}.':'.
2209: &Apache::lonnet::escape($key),
2210: $sheet->{'uhome'});
2211: }
2212: my %currentlystored=();
2213: unless ($current=~/^error\:/) {
2214: foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) {
2215: my ($name,$value)=split(/___=___/,$_);
2216: $currentlystored{$name}=$value;
2217: }
2218: }
2219: $currentlystored{$fn}=join('___;___',@exportarr);
2220: #
2221: my $newstore='';
2222: foreach (keys(%currentlystored)) {
2223: if ($newstore) { $newstore.='___&___'; }
2224: $newstore.=$_.'___=___'.$currentlystored{$_};
2225: }
2226: my $now=time;
2227: if ($stype eq 'studentcalc') {
2228: &Apache::lonnet::reply('put:'.
2229: $ENV{'course.'.$cid.'.domain'}.':'.
2230: $ENV{'course.'.$cid.'.num'}.
2231: ':nohist_calculatedsheets:'.
2232: &Apache::lonnet::escape($key).'='.
2233: &Apache::lonnet::escape($newstore).'&'.
2234: &Apache::lonnet::escape($key).'.time='.$now,
2235: $ENV{'course.'.$cid.'.home'});
2236: } else {
2237: &Apache::lonnet::reply('put:'.
2238: $sheet->{'udom'}.':'.
2239: $sheet->{'uname'}.
2240: ':nohist_calculatedsheets_'.
2241: $ENV{'request.course.id'}.':'.
2242: &Apache::lonnet::escape($key).'='.
2243: &Apache::lonnet::escape($newstore).'&'.
2244: &Apache::lonnet::escape($key).'.time='.$now,
2245: $sheet->{'uhome'});
2246: }
2247: }
2248: return @exportarr;
2249: }
2250:
2251: # ============================================================ Expiration Dates
2252: #
2253: # Load previously cached student spreadsheets for this course
2254: #
2255: sub expirationdates {
2256: undef %expiredates;
2257: my $cid=$ENV{'request.course.id'};
2258: my $reply=&Apache::lonnet::reply('dump:'.
2259: $ENV{'course.'.$cid.'.domain'}.':'.
2260: $ENV{'course.'.$cid.'.num'}.
2261: ':nohist_expirationdates',
2262: $ENV{'course.'.$cid.'.home'});
2263: unless ($reply=~/^error\:/) {
2264: foreach (split(/\&/,$reply)) {
2265: my ($name,$value)=split(/\=/,$_);
2266: $expiredates{&Apache::lonnet::unescape($name)}
2267: =&Apache::lonnet::unescape($value);
2268: }
2269: }
2270: }
2271:
2272: # ===================================================== Calculated sheets cache
2273: #
2274: # Load previously cached student spreadsheets for this course
2275: #
2276:
2277: sub cachedcsheets {
2278: my $cid=$ENV{'request.course.id'};
2279: my $reply=&Apache::lonnet::reply('dump:'.
2280: $ENV{'course.'.$cid.'.domain'}.':'.
2281: $ENV{'course.'.$cid.'.num'}.
2282: ':nohist_calculatedsheets',
2283: $ENV{'course.'.$cid.'.home'});
2284: unless ($reply=~/^error\:/) {
2285: foreach ( split(/\&/,$reply)) {
2286: my ($name,$value)=split(/\=/,$_);
2287: $oldsheets{&Apache::lonnet::unescape($name)}
2288: =&Apache::lonnet::unescape($value);
2289: }
2290: }
2291: }
2292:
2293: # ===================================================== Calculated sheets cache
2294: #
2295: # Load previously cached assessment spreadsheets for this student
2296: #
2297:
2298: sub cachedssheets {
2299: my ($sname,$sdom,$shome)=@_;
2300: unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) {
2301: my $cid=$ENV{'request.course.id'};
2302: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.
2303: ':nohist_calculatedsheets_'.
2304: $ENV{'request.course.id'},
2305: $shome);
2306: unless ($reply=~/^error\:/) {
2307: foreach ( split(/\&/,$reply)) {
2308: my ($name,$value)=split(/\=/,$_);
2309: $oldsheets{&Apache::lonnet::unescape($name)}
2310: =&Apache::lonnet::unescape($value);
2311: }
2312: }
2313: $loadedcaches{$sname.'_'.$sdom}=1;
2314: }
2315: }
2316:
2317: # ===================================================== Calculated sheets cache
2318: #
2319: # Load previously cached assessment spreadsheets for this student
2320: #
2321:
2322: # ================================================================ Main handler
2323: #
2324: # Interactive call to screen
2325: #
2326: #
2327: sub handler {
2328: my $r=shift;
2329:
2330: if (! exists($ENV{'form.Status'})) {
2331: $ENV{'form.Status'} = 'Active';
2332: }
2333: # Check this server
2334: my $loaderror=&Apache::lonnet::overloaderror($r);
2335: if ($loaderror) { return $loaderror; }
2336: # Check the course homeserver
2337: $loaderror= &Apache::lonnet::overloaderror($r,
2338: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
2339: if ($loaderror) { return $loaderror; }
2340:
2341: if ($r->header_only) {
2342: $r->content_type('text/html');
2343: $r->send_http_header;
2344: return OK;
2345: }
2346: # Global directory configs
2347: $includedir = $r->dir_config('lonIncludes');
2348: $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
2349: # Needs to be in a course
2350: if (! $ENV{'request.course.fn'}) {
2351: # Not in a course, or not allowed to modify parms
2352: $ENV{'user.error.msg'}=
2353: $r->uri.":opa:0:0:Cannot modify spreadsheet";
2354: return HTTP_NOT_ACCEPTABLE;
2355: }
2356: # Get query string for limited number of parameters
2357: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
2358: ['uname','udom','usymb','ufn']);
2359: if ($ENV{'request.role'} =~ /^st\./) {
2360: delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'}));
2361: delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
2362: }
2363: if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
2364: $ENV{'form.ufn'}='default_'.$1;
2365: }
2366: # Interactive loading of specific sheet?
2367: if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
2368: $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
2369: }
2370: #
2371: # Determine the user name and domain for the sheet.
2372: my $aname;
2373: my $adom;
2374: unless ($ENV{'form.uname'}) {
2375: $aname=$ENV{'user.name'};
2376: $adom=$ENV{'user.domain'};
2377: } else {
2378: $aname=$ENV{'form.uname'};
2379: $adom=$ENV{'form.udom'};
2380: }
2381: #
2382: # Open page
2383: $r->content_type('text/html');
2384: $r->header_out('Cache-control','no-cache');
2385: $r->header_out('Pragma','no-cache');
2386: $r->send_http_header;
2387: # Screen output
2388: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
2389: if ($ENV{'request.role'} !~ /^st\./) {
2390: $r->print(<<ENDSCRIPT);
2391: <script language="JavaScript">
2392:
2393: function celledit(cn,cf) {
2394: var cnf=prompt(cn,cf);
2395: if (cnf!=null) {
2396: document.sheet.unewfield.value=cn;
2397: document.sheet.unewformula.value=cnf;
2398: document.sheet.submit();
2399: }
2400: }
2401:
2402: function changesheet(cn) {
2403: document.sheet.unewfield.value=cn;
2404: document.sheet.unewformula.value='changesheet';
2405: document.sheet.submit();
2406: }
2407:
2408: function insertrow(cn) {
2409: document.sheet.unewfield.value='insertrow';
2410: document.sheet.unewformula.value=cn;
2411: document.sheet.submit();
2412: }
2413:
2414: </script>
2415: ENDSCRIPT
2416: }
2417: $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
2418: '<form action="'.$r->uri.'" name=sheet method=post>');
2419: $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
2420: &hiddenfield('udom',$ENV{'form.udom'}).
2421: &hiddenfield('usymb',$ENV{'form.usymb'}).
2422: &hiddenfield('unewfield','').
2423: &hiddenfield('unewformula',''));
2424: $r->rflush();
2425: #
2426: # Full recalc?
2427: if ($ENV{'form.forcerecalc'}) {
2428: $r->print('<h4>Completely Recalculating Sheet ...</h4>');
2429: undef %spreadsheets;
2430: undef %courserdatas;
2431: undef %userrdatas;
2432: undef %defaultsheets;
2433: undef %updatedata;
2434: }
2435: # Read new sheet or modified worksheet
2436: $r->uri=~/\/(\w+)$/;
2437: my ($sheet)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
2438: #
2439: # If a new formula had been entered, go from work copy
2440: if ($ENV{'form.unewfield'}) {
2441: $r->print('<h2>Modified Workcopy</h2>');
2442: $ENV{'form.unewformula'}=~s/\'/\"/g;
2443: $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
2444: $ENV{'form.unewformula'}.'<p>');
2445: $sheet->{'filename'} = $ENV{'form.ufn'};
2446: &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'});
2447: } elsif ($ENV{'form.saveas'}) {
2448: $sheet->{'filename'} = $ENV{'form.ufn'};
2449: &tmpread($sheet);
2450: } else {
2451: &readsheet($sheet,$ENV{'form.ufn'});
2452: }
2453: # Print out user information
2454: unless ($sheet->{'sheettype'} eq 'classcalc') {
2455: $r->print('<p><b>User:</b> '.$sheet->{'uname'}.
2456: '<br><b>Domain:</b> '.$sheet->{'udom'});
2457: $r->print('<br><b>Section/Group:</b> '.$sheet->{'csec'});
2458: if ($ENV{'form.usymb'}) {
2459: $r->print('<br><b>Assessment:</b> <tt>'.
2460: $ENV{'form.usymb'}.'</tt>');
2461: }
2462: }
2463: #
2464: # Check user permissions
2465: if (($sheet->{'sheettype'} eq 'classcalc' ) ||
2466: ($sheet->{'uname'} ne $ENV{'user.name'} ) ||
2467: ($sheet->{'udom'} ne $ENV{'user.domain'})) {
2468: unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) {
2469: $r->print('<h1>Access Permission Denied</h1>'.
2470: '</form></body></html>');
2471: return OK;
2472: }
2473: }
2474: # Additional options
2475: $r->print('<br />'.
2476: '<input type="submit" name="forcerecalc" '.
2477: 'value="Completely Recalculate Sheet"><p>');
2478: if ($sheet->{'sheettype'} eq 'assesscalc') {
2479: $r->print('<p><font size=+2>'.
2480: '<a href="/adm/studentcalc?'.
2481: 'uname='.$sheet->{'uname'}.
2482: '&udom='.$sheet->{'udom'}.'">'.
2483: 'Level up: Student Sheet</a></font><p>');
2484: }
2485: if (($sheet->{'sheettype'} eq 'studentcalc') &&
2486: (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) {
2487: $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
2488: 'Level up: Course Sheet</a></font><p>');
2489: }
2490: # Save dialog
2491: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2492: my $fname=$ENV{'form.ufn'};
2493: $fname=~s/\_[^\_]+$//;
2494: if ($fname eq 'default') { $fname='course_default'; }
2495: $r->print('<input type=submit name=saveas value="Save as ...">'.
2496: '<input type=text size=20 name=newfn value="'.$fname.'">'.
2497: 'make default: <input type=checkbox name="makedefufn"><p>');
2498: }
2499: $r->print(&hiddenfield('ufn',$sheet->{'filename'}));
2500: # Load dialog
2501: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2502: $r->print('<p><input type=submit name=load value="Load ...">'.
2503: '<select name="loadthissheet">'.
2504: '<option name="default">Default</option>');
2505: foreach (&othersheets($sheet)) {
2506: $r->print('<option name="'.$_.'"');
2507: if ($ENV{'form.ufn'} eq $_) {
2508: $r->print(' selected');
2509: }
2510: $r->print('>'.$_.'</option>');
2511: }
2512: $r->print('</select><p>');
2513: if ($sheet->{'sheettype'} eq 'studentcalc') {
2514: &setothersheets($sheet,
2515: &othersheets($sheet,'assesscalc'));
2516: }
2517: }
2518: # Cached sheets
2519: &expirationdates();
2520: undef %oldsheets;
2521: undef %loadedcaches;
2522: if ($sheet->{'sheettype'} eq 'classcalc') {
2523: $r->print("Loading previously calculated student sheets ...\n");
2524: $r->rflush();
2525: &cachedcsheets();
2526: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
2527: $r->print("Loading previously calculated assessment sheets ...\n");
2528: $r->rflush();
2529: &cachedssheets($sheet->{'uname'},$sheet->{'udom'},$sheet->{'uhome'});
2530: }
2531: # Update sheet, load rows
2532: $r->print("Loaded sheet(s), updating rows ...<br>\n");
2533: $r->rflush();
2534: #
2535: &updatesheet($sheet);
2536: $r->print("Updated rows, loading row data ...\n");
2537: $r->rflush();
2538: #
2539: &loadrows($sheet,$r);
2540: $r->print("Loaded row data, calculating sheet ...<br>\n");
2541: $r->rflush();
2542: #
2543: my $calcoutput=&calcsheet($sheet);
2544: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
2545: # See if something to save
2546: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2547: my $fname='';
2548: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
2549: $fname=~s/\W/\_/g;
2550: if ($fname eq 'default') { $fname='course_default'; }
2551: $fname.='_'.$sheet->{'sheettype'};
2552: $sheet->{'filename'} = $fname;
2553: $ENV{'form.ufn'}=$fname;
2554: $r->print('<p>Saving spreadsheet: '.
2555: &writesheet($sheet,$ENV{'form.makedefufn'}).
2556: '<p>');
2557: }
2558: }
2559: #
2560: # Write the modified worksheet
2561: $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'<p>');
2562: &tmpwrite($sheet);
2563: if ($sheet->{'sheettype'} eq 'studentcalc') {
2564: $r->print('<br>Show rows with empty A column: ');
2565: } else {
2566: $r->print('<br>Show empty rows: ');
2567: }
2568: #
2569: $r->print(&hiddenfield('userselhidden','true').
2570: '<input type="checkbox" name="showall" onClick="submit()"');
2571: #
2572: if ($ENV{'form.showall'}) {
2573: $r->print(' checked');
2574: } else {
2575: unless ($ENV{'form.userselhidden'}) {
2576: unless
2577: ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {
2578: $r->print(' checked');
2579: $ENV{'form.showall'}=1;
2580: }
2581: }
2582: }
2583: $r->print('>');
2584: if ($sheet->{'sheettype'} eq 'classcalc') {
2585: #
2586: # CSV format checkbox (classcalc sheets only)
2587: $r->print(' Output CSV format: <input type="checkbox" '.
2588: 'name="showcsv" onClick="submit()"');
2589: if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
2590: $r->print('>');
2591: #
2592: # Buttons to insert rows
2593: $r->print(' Student Status: '.
2594: &Apache::lonhtmlcommon::StatusOptions
2595: ($ENV{'form.Status'},'sheet'));
2596: }
2597: $r->print(<<ENDINSERTBUTTONS);
2598: <br>
2599: <input type='button' onClick='insertrow("top");'
2600: value='Insert Row Top'>
2601: <input type='button' onClick='insertrow("bottom");'
2602: value='Insert Row Bottom'><br>
2603: ENDINSERTBUTTONS
2604: # Print out sheet
2605: &outsheet($r,$sheet);
2606: $r->print('</form></body></html>');
2607: # Done
2608: return OK;
2609: }
2610:
2611: 1;
2612: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonspreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface