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