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