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