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