Annotation of loncom/interface/lonspreadsheet.pm, revision 1.134
1.79 matthew 1: #
1.134 ! matthew 2: # $Id: lonspreadsheet.pm,v 1.133 2002/11/05 15:00:27 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: # =============================================================================
1112:
1.27 www 1113: #
1114: # Procedures for screen output
1115: #
1.6 www 1116: # --------------------------------------------- Produce output row n from sheet
1117:
1.132 matthew 1118: sub get_row {
1119: my ($sheet,$n) = @_;
1120: my ($rowlabel,@rowdata);
1.104 matthew 1121: if ($n eq '-') {
1.132 matthew 1122: ($rowlabel,@rowdata) = &templaterow($sheet);
1123: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1124: ($rowlabel,@rowdata) = &outrowassess($sheet,$n);
1.61 www 1125: } else {
1.132 matthew 1126: ($rowlabel,@rowdata) = &outrow($sheet,$n);
1.61 www 1127: }
1.132 matthew 1128: return ($rowlabel,@rowdata);
1.6 www 1129: }
1130:
1.132 matthew 1131: ########################################################################
1132: ########################################################################
1133: sub sort_indicies {
1134: my $sheet = shift;
1.106 matthew 1135: #
1.128 matthew 1136: # Sort the rows in some manner
1137: #
1.65 www 1138: my @sortby=();
1139: my @sortidx=();
1.132 matthew 1140: for (my $row=1;$row<=$sheet->{'maxrow'};$row++) {
1.119 matthew 1141: push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}'));
1.132 matthew 1142: push (@sortidx, $row);
1.65 www 1143: }
1.111 matthew 1144: @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx;
1.132 matthew 1145: return @sortidx;
1146: }
1147:
1148: ########################################################################
1149: ########################################################################
1150:
1151: sub html_editable_cell {
1152: my ($cell,$bgcolor) = @_;
1153: my $result;
1154: my ($name,$formula,$value);
1155: if (defined($cell)) {
1156: $name = $cell->{'name'};
1157: $formula = $cell->{'formula'};
1158: $value = $cell->{'value'};
1159: }
1160: $name = '' if (! defined($name));
1161: $formula = '' if (! defined($formula));
1162: if (! defined($value)) {
1163: $value = '<font color="'.$bgcolor.'">#</font>';
1164: if ($formula ne '') {
1165: $value = '<i>undefined value</i>';
1166: }
1167: }
1.133 matthew 1168: if ($value =~ /^\s*$/ ) {
1169: $value = '<font color="'.$bgcolor.'">#</font>';
1170: }
1.132 matthew 1171: $result .= '<a href="javascript:celledit(\''.
1172: $name.'\',\''.$formula.'\');">'.$value.'</a>';
1173: return $result;
1174: }
1175:
1176: sub html_uneditable_cell {
1177: my ($cell,$bgcolor) = @_;
1178: my $value = (defined($cell) ? $cell->{'value'} : '');
1179: return ' '.$value.' ';
1180: }
1181:
1182: ########################################################################
1183: ########################################################################
1184:
1185: sub outsheet_html {
1186: my ($sheet,$r) = @_;
1187: my ($num_uneditable,$realm,$row_type);
1.119 matthew 1188: if ($sheet->{'sheettype'} eq 'assesscalc') {
1.132 matthew 1189: $num_uneditable = 1;
1190: $realm = 'Assessment';
1191: $row_type = 'Item';
1.119 matthew 1192: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1.132 matthew 1193: $num_uneditable = 26;
1194: $realm = 'User';
1195: $row_type = 'Assessment';
1196: } elsif ($sheet->{'sheettype'} eq 'classcalc') {
1197: $num_uneditable = 26;
1198: $realm = 'Course';
1199: $row_type = 'Student';
1200: } else {
1201: return; # error
1202: }
1203: ####################################
1204: # Print out header table
1205: ####################################
1206: my $num_left = 52-$num_uneditable;
1207: my $tabledata =<<"END";
1208: <table border="2">
1209: <tr>
1210: <th colspan="1" rowspan="2"><font size="+2">$realm</font></th>
1211: <td bgcolor="#FFDDDD" colspan="$num_uneditable">
1212: <b><font size="+1">Import</font></b></td>
1213: <td colspan="$num_left">
1214: <b><font size="+1">Calculations</font></b></td>
1215: </tr><tr>
1216: END
1217: my $label_num = 0;
1218: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
1219: if ($label_num<$num_uneditable) {
1220: $tabledata.='<td bgcolor="#FFDDDD">';
1221: } else {
1222: $tabledata.='<td>';
1223: }
1224: $tabledata.="<b><font size=+1>$_</font></b></td>";
1225: $label_num++;
1.106 matthew 1226: }
1.132 matthew 1227: $tabledata.="</tr>\n";
1228: $r->print($tabledata);
1229: ####################################
1230: # Print out template row
1231: ####################################
1232: my ($rowlabel,@rowdata) = &get_row($sheet,'-');
1.133 matthew 1233: my $row_html = '<tr><td>'.&format_html_rowlabel($rowlabel).'</td>';
1.132 matthew 1234: my $num_cols_output = 0;
1235: foreach my $cell (@rowdata) {
1236: if ($num_cols_output++ < $num_uneditable) {
1237: $row_html .= '<td bgcolor="#FFDDDD">';
1238: $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
1239: } else {
1240: $row_html .= '<td bgcolor="#EOFFDD">';
1241: $row_html .= &html_editable_cell($cell,'#E0FFDD');
1242: }
1243: $row_html .= '</td>';
1244: }
1245: $row_html.= "</tr>\n";
1246: $r->print($row_html);
1247: ####################################
1248: # Print out summary/export row
1249: ####################################
1250: my ($rowlabel,@rowdata) = &get_row($sheet,'0');
1251: my $rowcount = 0;
1.133 matthew 1252: $row_html = '<tr><td>'.&format_html_rowlabel($rowlabel).'</td>';
1.132 matthew 1253: $num_cols_output = 0;
1254: foreach my $cell (@rowdata) {
1255: if ($num_cols_output++ < 26) {
1256: $row_html .= '<td bgcolor="#CCCCFF">';
1257: $row_html .= &html_editable_cell($cell,'#CCCCFF');
1258: } else {
1259: $row_html .= '<td bgcolor="#DDCCFF">';
1260: $row_html .= &html_uneditable_cell(undef,'#CCCCFF');
1261: }
1262: $row_html .= '</td>';
1263: }
1264: $row_html.= "</tr>\n";
1265: $r->print($row_html);
1266: $r->print('</table>');
1267: ####################################
1268: # Prepare to output rows
1269: ####################################
1270: my @Rows = &sort_indicies($sheet);
1.106 matthew 1271: #
1272: # Loop through the rows and output them one at a time
1.132 matthew 1273: my $rows_output=0;
1274: foreach my $rownum (@Rows) {
1275: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
1276: #
1277: my $defaultbg='#E0FF';
1278: #
1279: my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum.
1280: '</font></b></td>';
1281: #
1282: if ($sheet->{'sheettype'} eq 'classcalc') {
1.133 matthew 1283: $row_html.='<td>'.&format_html_rowlabel($rowlabel).'</td>';
1.132 matthew 1284: # Output links for each student?
1.133 matthew 1285: # Nope, that is already done for us in format_html_rowlabel (for now)
1.132 matthew 1286: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1.133 matthew 1287: $row_html.='<td>'.&format_html_rowlabel($rowlabel);
1.132 matthew 1288: $row_html.= '<br>'.
1289: '<select name="sel_'.$rownum.'" '.
1290: 'onChange="changesheet('.$rownum.')">'.
1291: '<option name="default">Default</option>';
1292: foreach (@{$sheet->{'othersheets'}}) {
1293: $row_html.='<option name="'.$_.'"';
1294: #if ($ufn eq $_) {
1295: # $row_html.=' selected';
1296: #}
1297: $row_html.='>'.$_.'</option>';
1298: }
1299: $row_html.='</select></td>';
1300: } elsif ($sheet->{'sheettype'} eq 'assesscalc') {
1.133 matthew 1301: $row_html.='<td>'.&format_html_rowlabel($rowlabel).'</td>';
1.132 matthew 1302: }
1303: #
1304: my $shown_cells = 0;
1305: foreach my $cell (@rowdata) {
1306: my $value = $cell->{'value'};
1307: my $formula = $cell->{'formula'};
1308: my $cellname = $cell->{'name'};
1309: #
1310: my $bgcolor;
1311: if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) {
1312: $bgcolor = $defaultbg.'99';
1313: } else {
1314: $bgcolor = $defaultbg.'DD';
1315: }
1316: $bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable);
1317: #
1318: $row_html.='<td bgcolor='.$bgcolor.'>';
1319: if ($shown_cells < $num_uneditable) {
1320: $row_html .= &html_uneditable_cell($cell,$bgcolor);
1321: } else {
1322: $row_html .= &html_editable_cell($cell,$bgcolor);
1323: }
1324: $row_html.='</td>';
1325: $shown_cells++;
1326: }
1327: if ($row_html) {
1328: if ($rows_output % 25 == 0) {
1.102 matthew 1329: $r->print("</table>\n<br>\n");
1330: $r->rflush();
1.132 matthew 1331: $r->print('<table border=2>'.
1332: '<tr><td> <td>'.$row_type.'</td>'.
1333: '<td>'.
1.106 matthew 1334: join('</td><td>',
1335: (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
1336: 'abcdefghijklmnopqrstuvwxyz'))).
1.102 matthew 1337: "</td></tr>\n");
1338: }
1.132 matthew 1339: $rows_output++;
1340: $r->print($row_html);
1.78 matthew 1341: }
1.6 www 1342: }
1.132 matthew 1343: #
1344: $r->print('</table>');
1345: #
1346: # Debugging code (be sure to uncomment errorlog code in safe space):
1347: #
1348: # $r->print("\n<pre>");
1349: # $r->print(&geterrorlog($sheet));
1350: # $r->print("\n</pre>");
1351: return 1;
1352: }
1353:
1354: sub outsheet_csv {
1355: my ($sheet,$r) = @_;
1.133 matthew 1356: my $csvdata = '';
1357: my @Values;
1358: ####################################
1359: # Prepare to output rows
1360: ####################################
1361: my @Rows = &sort_indicies($sheet);
1362: #
1363: # Loop through the rows and output them one at a time
1364: my $rows_output=0;
1365: foreach my $rownum (@Rows) {
1366: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
1367: push (@Values,&format_csv_rowlabel($rowlabel));
1368: foreach my $cell (@rowdata) {
1369: push (@Values,'"'.$cell->{'value'}.'"');
1370: }
1371: $csvdata.= join(',',@Values)."\n";
1372: @Values = ();
1373: }
1374: #
1.134 ! matthew 1375: # Write the CSV data to a file and serve up a link
! 1376: #
! 1377: my $filename = '/prtspool/'.
! 1378: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
! 1379: time.'_'.rand(1000000000).'.csv';
! 1380: my $file;
! 1381: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
! 1382: $r->log_error("Couldn't open $filename for output $!");
! 1383: $r->print("Problems occured in writing the csv file. ".
! 1384: "This error has been logged. ".
! 1385: "Please alert your LON-CAPA administrator.");
! 1386: $r->print("<pre>\n".$csvdata."</pre>\n");
! 1387: return 0;
! 1388: }
! 1389: print $file $csvdata;
! 1390: close($file);
! 1391: $r->print('<br /><br />'.
! 1392: '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");
1.133 matthew 1393: #
1394: return 1;
1.132 matthew 1395: }
1396:
1397: sub outsheet_excel {
1398: my ($sheet,$r) = @_;
1.134 ! matthew 1399: my $filename = '/prtspool/'.
! 1400: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
! 1401: time.'_'.rand(1000000000).'.xls';
! 1402: &Apache::lonnet::logthis("spreadsheet:filename = ".$filename);
! 1403: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
! 1404: if (! defined($workbook)) {
! 1405: $r->log_error("Error creating excel spreadsheet $filename: $!");
! 1406: $r->print("Problems creating new Excel file. ".
! 1407: "This error has been logged. ".
! 1408: "Please alert your LON-CAPA administrator");
! 1409: return 0;
! 1410: }
! 1411: #
! 1412: # The spreadsheet stores temporary data in files, then put them
! 1413: # together. If needed we should be able to disable this (memory only).
! 1414: # The temporary directory must be specified before calling 'addworksheet'.
! 1415: # File::Temp is used to determine the temporary directory.
! 1416: $workbook->set_tempdir('/home/httpd/perl/tmp');
! 1417: #
! 1418: # Determine the name to give the worksheet
! 1419: my $sheetname;
! 1420: if ($sheet->{'sheettype'} eq 'classcalc') {
! 1421: $sheetname = 'Main';
! 1422: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
! 1423: $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'};
! 1424: } elsif ($sheet->{'sheettype'} eq 'assesscalc') {
! 1425: $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'}.' assessment';
! 1426: }
! 1427: my $worksheet = $workbook->addworksheet($sheetname);
! 1428: ####################################
! 1429: # Prepare to output rows
! 1430: ####################################
! 1431: my @Rows = &sort_indicies($sheet);
! 1432: #
! 1433: # Loop through the rows and output them one at a time
! 1434: my $rows_output=0;
! 1435: foreach my $rownum (@Rows) {
! 1436: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
! 1437: my $cols_output = 0;
! 1438: my $label = &format_excel_rowlabel($rowlabel);
! 1439: $worksheet->write($rows_output,$cols_output++,$label);
! 1440: if (ref($label)) {
! 1441: $cols_output = (scalar(@$label));
! 1442: }
! 1443: foreach my $cell (@rowdata) {
! 1444: $worksheet->write($rows_output,$cols_output++,
! 1445: $cell->{'value'});
! 1446: }
! 1447: $rows_output++;
! 1448: }
! 1449: #
! 1450: $workbook->close();
! 1451: # Okay, the spreadsheet is taken care of, so give the user a link.
! 1452: $r->print('<br /><br />'.
! 1453: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
! 1454: return 1;
1.132 matthew 1455: }
1456:
1457: sub outsheet_xml {
1458: my ($sheet,$r) = @_;
1.6 www 1459: }
1460:
1.132 matthew 1461: sub outsheet {
1462: my ($r,$sheet)=@_;
1.134 ! matthew 1463: if (! exists($ENV{'form.output'})) {
! 1464: $ENV{'form.output'} = 'HTML';
! 1465: }
! 1466: if (lc($ENV{'form.output'}) eq 'csv') {
1.133 matthew 1467: &outsheet_csv($sheet,$r);
1.134 ! matthew 1468: } elsif (lc($ENV{'form.output'}) eq 'excel') {
! 1469: &outsheet_excel($sheet,$r);
! 1470: # } elsif (lc($ENV{'form.output'}) eq 'xml' ) {
1.132 matthew 1471: # &outsheet_xml($sheet,$r);
1.133 matthew 1472: } else {
1473: &outsheet_html($sheet,$r);
1474: }
1.132 matthew 1475: }
1476:
1477: ########################################################################
1478: ########################################################################
1.55 www 1479: sub othersheets {
1.119 matthew 1480: my ($sheet,$stype)=@_;
1481: $stype = $sheet->{'sheettype'} if (! defined($stype));
1.81 matthew 1482: #
1.119 matthew 1483: my $cnum = $sheet->{'cnum'};
1484: my $cdom = $sheet->{'cdom'};
1485: my $chome = $sheet->{'chome'};
1.81 matthew 1486: #
1.55 www 1487: my @alternatives=();
1.81 matthew 1488: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
1489: my ($tmp) = keys(%results);
1490: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1491: @alternatives = sort (keys(%results));
1492: }
1.55 www 1493: return @alternatives;
1494: }
1495:
1.82 matthew 1496: #
1497: # -------------------------------------- Parse a spreadsheet
1498: #
1499: sub parse_sheet {
1500: # $sheetxml is a scalar reference or a scalar
1501: my ($sheetxml) = @_;
1502: if (! ref($sheetxml)) {
1503: my $tmp = $sheetxml;
1504: $sheetxml = \$tmp;
1505: }
1506: my %f;
1507: my $parser=HTML::TokeParser->new($sheetxml);
1508: my $token;
1509: while ($token=$parser->get_token) {
1510: if ($token->[0] eq 'S') {
1511: if ($token->[1] eq 'field') {
1512: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
1513: $parser->get_text('/field');
1514: }
1515: if ($token->[1] eq 'template') {
1516: $f{'template_'.$token->[2]->{'col'}}=
1517: $parser->get_text('/template');
1518: }
1519: }
1520: }
1521: return \%f;
1522: }
1523:
1.55 www 1524: #
1.27 www 1525: # -------------------------------------- Read spreadsheet formulas for a course
1526: #
1527: sub readsheet {
1.119 matthew 1528: my ($sheet,$fn)=@_;
1.107 matthew 1529: #
1.119 matthew 1530: my $stype = $sheet->{'sheettype'};
1531: my $cnum = $sheet->{'cnum'};
1532: my $cdom = $sheet->{'cdom'};
1533: my $chome = $sheet->{'chome'};
1.107 matthew 1534: #
1.104 matthew 1535: if (! defined($fn)) {
1536: # There is no filename. Look for defaults in course and global, cache
1537: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
1538: my %tmphash = &Apache::lonnet::get('environment',
1539: ['spreadsheet_default_'.$stype],
1540: $cdom,$cnum);
1541: my ($tmp) = keys(%tmphash);
1542: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1543: $fn = 'default_'.$stype;
1544: } else {
1545: $fn = $tmphash{'spreadsheet_default_'.$stype};
1546: }
1547: unless (($fn) && ($fn!~/^error\:/)) {
1548: $fn='default_'.$stype;
1549: }
1550: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
1551: }
1552: }
1553: # $fn now has a value
1.119 matthew 1554: $sheet->{'filename'} = $fn;
1.104 matthew 1555: # see if sheet is cached
1556: my $fstring='';
1557: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
1.119 matthew 1558: my %tmp = split(/___;___/,$fstring);
1.124 matthew 1559: $sheet->{'f'} = \%tmp;
1560: &setformulas($sheet);
1.104 matthew 1561: } else {
1562: # Not cached, need to read
1563: my %f=();
1564: if ($fn=~/^default\_/) {
1565: my $sheetxml='';
1566: my $fh;
1567: my $dfn=$fn;
1568: $dfn=~s/\_/\./g;
1569: if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
1570: $sheetxml=join('',<$fh>);
1571: } else {
1572: $sheetxml='<field row="0" col="A">"Error"</field>';
1573: }
1574: %f=%{&parse_sheet(\$sheetxml)};
1575: } elsif($fn=~/\/*\.spreadsheet$/) {
1576: my $sheetxml=&Apache::lonnet::getfile
1577: (&Apache::lonnet::filelocation('',$fn));
1578: if ($sheetxml == -1) {
1579: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1580: .$fn.'"</field>';
1581: }
1582: %f=%{&parse_sheet(\$sheetxml)};
1583: } else {
1584: my $sheet='';
1585: my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
1586: my ($tmp) = keys(%tmphash);
1587: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1588: foreach (keys(%tmphash)) {
1589: $f{$_}=$tmphash{$_};
1590: }
1591: }
1592: }
1593: # Cache and set
1594: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1.124 matthew 1595: $sheet->{'f'}=\%f;
1596: &setformulas($sheet);
1.3 www 1597: }
1598: }
1599:
1.28 www 1600: # -------------------------------------------------------- Make new spreadsheet
1601: sub makenewsheet {
1602: my ($uname,$udom,$stype,$usymb)=@_;
1.119 matthew 1603: my $sheet={};
1604: $sheet->{'uname'} = $uname;
1605: $sheet->{'udom'} = $udom;
1606: $sheet->{'sheettype'} = $stype;
1607: $sheet->{'usymb'} = $usymb;
1608: $sheet->{'cid'} = $ENV{'request.course.id'};
1609: $sheet->{'csec'} = $Section{$uname.':'.$udom};
1610: $sheet->{'coursefilename'} = $ENV{'request.course.fn'};
1611: $sheet->{'cnum'} = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1612: $sheet->{'cdom'} = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
1613: $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
1.134 ! matthew 1614: $sheet->{'coursedesc'} = $ENV{'course.'.$ENV{'request.course.id'}.
! 1615: 'description'};
1.119 matthew 1616: $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
1617: #
1618: #
1619: $sheet->{'f'} = {};
1620: $sheet->{'constants'} = {};
1621: $sheet->{'othersheets'} = [];
1622: $sheet->{'rowlabel'} = {};
1623: #
1624: #
1625: $sheet->{'safe'}=&initsheet($sheet->{'sheettype'});
1.116 matthew 1626: #
1.119 matthew 1627: # Place all the %$sheet items into the safe space except the safe space
1628: # itself
1.105 matthew 1629: my $initstring = '';
1.119 matthew 1630: foreach (qw/uname udom sheettype usymb cid csec coursefilename
1631: cnum cdom chome uhome/) {
1632: $initstring.= qq{\$$_="$sheet->{$_}";};
1.105 matthew 1633: }
1.119 matthew 1634: $sheet->{'safe'}->reval($initstring);
1635: return $sheet;
1.28 www 1636: }
1637:
1.19 www 1638: # ------------------------------------------------------------ Save spreadsheet
1639: sub writesheet {
1.119 matthew 1640: my ($sheet,$makedef)=@_;
1641: my $cid=$sheet->{'cid'};
1.104 matthew 1642: if (&Apache::lonnet::allowed('opa',$cid)) {
1.119 matthew 1643: my %f=&getformulas($sheet);
1644: my $stype= $sheet->{'sheettype'};
1645: my $cnum = $sheet->{'cnum'};
1646: my $cdom = $sheet->{'cdom'};
1647: my $chome= $sheet->{'chome'};
1648: my $fn = $sheet->{'filename'};
1.104 matthew 1649: # Cache new sheet
1650: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1651: # Write sheet
1652: foreach (keys(%f)) {
1.131 matthew 1653: delete($f{$_}) if ($f{$_} eq 'import');
1.104 matthew 1654: }
1.131 matthew 1655: my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum);
1.104 matthew 1656: if ($reply eq 'ok') {
1.131 matthew 1657: $reply = &Apache::lonnet::put($stype.'_spreadsheets',
1658: {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
1659: $cdom,$cnum);
1.104 matthew 1660: if ($reply eq 'ok') {
1661: if ($makedef) {
1.131 matthew 1662: return &Apache::lonnet::put('environment',
1663: {'spreadsheet_default_'.$stype => $fn },
1664: $cdom,$cnum);
1.104 matthew 1665: }
1666: return $reply;
1667: }
1668: return $reply;
1669: }
1670: return $reply;
1671: }
1672: return 'unauthorized';
1.19 www 1673: }
1674:
1.10 www 1675: # ----------------------------------------------- Make a temp copy of the sheet
1.28 www 1676: # "Modified workcopy" - interactive only
1677: #
1.10 www 1678: sub tmpwrite {
1.119 matthew 1679: my ($sheet) = @_;
1.28 www 1680: my $fn=$ENV{'user.name'}.'_'.
1.119 matthew 1681: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
1682: $sheet->{'filename'};
1.10 www 1683: $fn=~s/\W/\_/g;
1684: $fn=$tmpdir.$fn.'.tmp';
1685: my $fh;
1686: if ($fh=Apache::File->new('>'.$fn)) {
1.119 matthew 1687: print $fh join("\n",&getformulas($sheet));
1.10 www 1688: }
1689: }
1690:
1691: # ---------------------------------------------------------- Read the temp copy
1692: sub tmpread {
1.119 matthew 1693: my ($sheet,$nfield,$nform)=@_;
1.28 www 1694: my $fn=$ENV{'user.name'}.'_'.
1.119 matthew 1695: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
1696: $sheet->{'filename'};
1.10 www 1697: $fn=~s/\W/\_/g;
1698: $fn=$tmpdir.$fn.'.tmp';
1699: my $fh;
1700: my %fo=();
1.92 www 1701: my $countrows=0;
1.10 www 1702: if ($fh=Apache::File->new($fn)) {
1703: my $name;
1704: while ($name=<$fh>) {
1705: chomp($name);
1706: my $value=<$fh>;
1707: chomp($value);
1708: $fo{$name}=$value;
1.93 www 1709: if ($name=~/^A(\d+)$/) {
1710: if ($1>$countrows) {
1711: $countrows=$1;
1712: }
1713: }
1.10 www 1714: }
1715: }
1.55 www 1716: if ($nform eq 'changesheet') {
1.128 matthew 1717: $fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0];
1.55 www 1718: unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
1.57 www 1719: $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
1.55 www 1720: }
1.92 www 1721: } elsif ($nfield eq 'insertrow') {
1.93 www 1722: $countrows++;
1.95 www 1723: my $newrow=substr('000000'.$countrows,-7);
1.92 www 1724: if ($nform eq 'top') {
1.94 www 1725: $fo{'A'.$countrows}='--- '.$newrow;
1.92 www 1726: } else {
1.94 www 1727: $fo{'A'.$countrows}='~~~ '.$newrow;
1.92 www 1728: }
1.55 www 1729: } else {
1730: if ($nfield) { $fo{$nfield}=$nform; }
1731: }
1.124 matthew 1732: $sheet->{'f'}=\%fo;
1733: &setformulas($sheet);
1.10 www 1734: }
1735:
1.104 matthew 1736: ##################################################
1737: ##################################################
1.11 www 1738:
1.104 matthew 1739: =pod
1.11 www 1740:
1.104 matthew 1741: =item &parmval()
1.11 www 1742:
1.104 matthew 1743: Determine the value of a parameter.
1.11 www 1744:
1.119 matthew 1745: Inputs: $what, the parameter needed, $sheet, the safe space
1.11 www 1746:
1.104 matthew 1747: Returns: The value of a parameter, or '' if none.
1.11 www 1748:
1.104 matthew 1749: This function cascades through the possible levels searching for a value for
1750: a parameter. The levels are checked in the following order:
1751: user, course (at section level and course level), map, and lonnet::metadata.
1752: This function uses %parmhash, which must be tied prior to calling it.
1753: This function also requires %courseopt and %useropt to be initialized for
1754: this user and course.
1.11 www 1755:
1.104 matthew 1756: =cut
1.11 www 1757:
1.104 matthew 1758: ##################################################
1759: ##################################################
1760: sub parmval {
1.119 matthew 1761: my ($what,$sheet)=@_;
1762: my $symb = $sheet->{'usymb'};
1.104 matthew 1763: unless ($symb) { return ''; }
1764: #
1.119 matthew 1765: my $cid = $sheet->{'cid'};
1766: my $csec = $sheet->{'csec'};
1767: my $uname = $sheet->{'uname'};
1768: my $udom = $sheet->{'udom'};
1.104 matthew 1769: my $result='';
1770: #
1771: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
1772: # Cascading lookup scheme
1773: my $rwhat=$what;
1774: $what =~ s/^parameter\_//;
1775: $what =~ s/\_([^\_]+)$/\.$1/;
1776: #
1777: my $symbparm = $symb.'.'.$what;
1778: my $mapparm = $mapname.'___(all).'.$what;
1779: my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
1780: #
1781: my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what;
1782: my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
1783: my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
1784: #
1785: my $courselevel = $usercourseprefix.'.'.$what;
1786: my $courselevelr = $usercourseprefix.'.'.$symbparm;
1787: my $courselevelm = $usercourseprefix.'.'.$mapparm;
1788: # fourth, check user
1.115 albertel 1789: if (defined($uname)) {
1790: return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
1791: return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
1792: return $useropt{$courselevel} if (defined($useropt{$courselevel}));
1.104 matthew 1793: }
1794: # third, check course
1.115 albertel 1795: if (defined($csec)) {
1796: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
1797: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
1798: return $courseopt{$seclevel} if (defined($courseopt{$seclevel}));
1.104 matthew 1799: }
1800: #
1.115 albertel 1801: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
1802: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
1803: return $courseopt{$courselevel} if (defined($courseopt{$courselevel}));
1.104 matthew 1804: # second, check map parms
1805: my $thisparm = $parmhash{$symbparm};
1.115 albertel 1806: return $thisparm if (defined($thisparm));
1.104 matthew 1807: # first, check default
1808: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 1809: }
1810:
1.133 matthew 1811:
1812: ##################################################################
1813: ## Row label formatting routines ##
1814: ##################################################################
1815: sub format_html_rowlabel {
1816: my $rowlabel = shift;
1817: return '' if ($rowlabel eq '');
1818: my ($type,$labeldata) = split(':',$rowlabel,2);
1819: my $result = '';
1820: if ($type eq 'symb') {
1821: my ($symb,$uname,$udom,$title) = split(':',$labeldata);
1822: $symb = &Apache::lonnet::unescape($symb);
1823: $result = '<a href="/adm/assesscalc?usymb='.$symb.
1824: '&uname='.$uname.'&udom='.$udom.'">'.$title.'</a>';
1825: } elsif ($type eq 'student') {
1826: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
1827: $result ='<a href="/adm/studentcalc?uname='.$sname.
1828: '&udom='.$sdom.'">';
1829: $result.=$section.' '.$id." ".$fullname.'</a>';
1830: } elsif ($type eq 'parameter') {
1831: $result = $labeldata;
1832: } else {
1833: $result = '<b><font size=+1>'.$rowlabel.'</font></b>';
1834: }
1835: return $result;
1836: }
1837:
1838: sub format_csv_rowlabel {
1839: my $rowlabel = shift;
1840: return '' if ($rowlabel eq '');
1841: my ($type,$labeldata) = split(':',$rowlabel,2);
1842: my $result = '';
1843: if ($type eq 'symb') {
1844: my ($symb,$uname,$udom,$title) = split(':',$labeldata);
1845: $symb = &Apache::lonnet::unescape($symb);
1846: $result = $title;
1847: } elsif ($type eq 'student') {
1848: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
1849: $result = join('","',($sname,$sdom,$fullname,$section,$id));
1850: } elsif ($type eq 'parameter') {
1851: $labeldata =~ s/<br>/ /g;
1852: $result = $labeldata;
1853: } else {
1854: $result = $rowlabel;
1855: }
1856: return '"'.$result.'"';
1857: }
1858:
1.134 ! matthew 1859: sub format_excel_rowlabel {
1.125 matthew 1860: my $rowlabel = shift;
1.132 matthew 1861: return '' if ($rowlabel eq '');
1.125 matthew 1862: my ($type,$labeldata) = split(':',$rowlabel,2);
1863: my $result = '';
1864: if ($type eq 'symb') {
1865: my ($symb,$uname,$udom,$title) = split(':',$labeldata);
1866: $symb = &Apache::lonnet::unescape($symb);
1.133 matthew 1867: $result = $title;
1.125 matthew 1868: } elsif ($type eq 'student') {
1869: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
1.134 ! matthew 1870: $section = '' if (! defined($section));
! 1871: $id = '' if (! defined($id));
! 1872: my @Data = ($sname,$sdom,$fullname,$section,$id);
! 1873: $result = \@Data;
1.125 matthew 1874: } elsif ($type eq 'parameter') {
1.133 matthew 1875: $labeldata =~ s/<br>/ /g;
1.127 matthew 1876: $result = $labeldata;
1.125 matthew 1877: } else {
1.133 matthew 1878: $result = $rowlabel;
1.125 matthew 1879: }
1880: return $result;
1881: }
1882:
1.23 www 1883: # ---------------------------------------------- Update rows for course listing
1.28 www 1884: sub updateclasssheet {
1.119 matthew 1885: my ($sheet) = @_;
1886: my $cnum =$sheet->{'cnum'};
1887: my $cdom =$sheet->{'cdom'};
1888: my $cid =$sheet->{'cid'};
1889: my $chome =$sheet->{'chome'};
1.102 matthew 1890: #
1.113 matthew 1891: %Section = ();
1892:
1893: #
1.102 matthew 1894: # Read class list and row labels
1.118 matthew 1895: my $classlist = &Apache::loncoursedata::get_classlist();
1896: if (! defined($classlist)) {
1897: return 'Could not access course classlist';
1898: }
1.102 matthew 1899: #
1.23 www 1900: my %currentlist=();
1.118 matthew 1901: foreach my $student (keys(%$classlist)) {
1902: my ($studentDomain,$studentName,$end,$start,$id,$studentSection,
1903: $fullname,$status) = @{$classlist->{$student}};
1904: if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') {
1.125 matthew 1905: $currentlist{$student}=join(':',('student',$studentName,
1906: $studentDomain,$fullname,
1907: $studentSection,$id));
1.118 matthew 1908: }
1909: }
1.102 matthew 1910: #
1911: # Find discrepancies between the course row table and this
1912: #
1.119 matthew 1913: my %f=&getformulas($sheet);
1.102 matthew 1914: my $changed=0;
1915: #
1.119 matthew 1916: $sheet->{'maxrow'}=0;
1.102 matthew 1917: my %existing=();
1918: #
1919: # Now obsolete rows
1920: foreach (keys(%f)) {
1921: if ($_=~/^A(\d+)/) {
1.119 matthew 1922: if ($1 > $sheet->{'maxrow'}) {
1923: $sheet->{'maxrow'}= $1;
1924: }
1.102 matthew 1925: $existing{$f{$_}}=1;
1926: unless ((defined($currentlist{$f{$_}})) || (!$1) ||
1.120 matthew 1927: ($f{$_}=~/^(~~~|---)/)) {
1.102 matthew 1928: $f{$_}='!!! Obsolete';
1929: $changed=1;
1.23 www 1930: }
1.78 matthew 1931: }
1.102 matthew 1932: }
1933: #
1934: # New and unknown keys
1.128 matthew 1935: foreach my $student (sort keys(%currentlist)) {
1936: unless ($existing{$student}) {
1.102 matthew 1937: $changed=1;
1.119 matthew 1938: $sheet->{'maxrow'}++;
1.128 matthew 1939: $f{'A'.$sheet->{'maxrow'}}=$student;
1.78 matthew 1940: }
1.23 www 1941: }
1.119 matthew 1942: if ($changed) {
1.124 matthew 1943: $sheet->{'f'} = \%f;
1944: &setformulas($sheet,%f);
1.119 matthew 1945: }
1.102 matthew 1946: #
1.125 matthew 1947: &setrowlabels($sheet,\%currentlist);
1.23 www 1948: }
1.5 www 1949:
1.28 www 1950: # ----------------------------------- Update rows for student and assess sheets
1951: sub updatestudentassesssheet {
1.119 matthew 1952: my ($sheet) = @_;
1.128 matthew 1953: #
1.5 www 1954: my %bighash;
1.128 matthew 1955: #
1956: my $stype = $sheet->{'sheettype'};
1957: my $uname = $sheet->{'uname'};
1958: my $udom = $sheet->{'udom'};
1.119 matthew 1959: $sheet->{'rowlabel'} = {};
1.128 matthew 1960: my $identifier =$sheet->{'coursefilename'}.'_'.$stype.'_'.$uname.'_'.$udom;
1961: if ($updatedata{$identifier}) {
1962: %{$sheet->{'rowlabel'}}=split(/___;___/,$updatedata{$identifier});
1.104 matthew 1963: } else {
1964: # Tie hash
1.128 matthew 1965: tie(%bighash,'GDBM_File',$sheet->{'coursefilename'}.'.db',
1.104 matthew 1966: &GDBM_READER(),0640);
1967: if (! tied(%bighash)) {
1968: return 'Could not access course data';
1969: }
1970: # Get all assessments
1.125 matthew 1971: #
1.128 matthew 1972: # parameter_labels is used in the assessment sheets to provide labels
1.125 matthew 1973: # for the parameters.
1.128 matthew 1974: my %parameter_labels=
1975: ('timestamp' =>
1976: 'parameter:Timestamp of Last Transaction<br>timestamp',
1977: 'subnumber' =>
1978: 'parameter:Number of Submissions<br>subnumber',
1979: 'tutornumber' =>
1980: 'parameter:Number of Tutor Responses<br>tutornumber',
1981: 'totalpoints' =>
1982: 'parameter:Total Points Granted<br>totalpoints');
1.125 matthew 1983: #
1.128 matthew 1984: # assesslist holds the descriptions of all assessments
1985: my %assesslist;
1.125 matthew 1986: foreach ('Feedback','Evaluation','Tutoring','Discussion') {
1987: my $symb = '_'.lc($_);
1.128 matthew 1988: $assesslist{$symb} = join(':',('symb',$symb,$uname,$udom,$_));
1.120 matthew 1989: }
1.107 matthew 1990: while (($_,undef) = each(%bighash)) {
1.104 matthew 1991: next if ($_!~/^src\_(\d+)\.(\d+)$/);
1992: my $mapid=$1;
1993: my $resid=$2;
1994: my $id=$mapid.'.'.$resid;
1995: my $srcf=$bighash{$_};
1996: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1997: my $symb=
1998: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1999: '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
1.128 matthew 2000: $assesslist{$symb}='symb:'.&Apache::lonnet::escape($symb).':'
1.125 matthew 2001: .$uname.':'.$udom.':'.$bighash{'title_'.$id};
1.104 matthew 2002: next if ($stype ne 'assesscalc');
2003: foreach my $key (split(/\,/,
2004: &Apache::lonnet::metadata($srcf,'keys')
2005: )) {
2006: next if ($key !~ /^(stores|parameter)_/);
2007: my $display=
2008: &Apache::lonnet::metadata($srcf,$key.'.display');
2009: unless ($display) {
2010: $display.=
2011: &Apache::lonnet::metadata($srcf,$key.'.name');
2012: }
2013: $display.='<br>'.$key;
1.128 matthew 2014: $parameter_labels{$key}='parameter:'.$display;
1.104 matthew 2015: } # end of foreach
2016: }
1.78 matthew 2017: } # end of foreach (keys(%bighash))
1.5 www 2018: untie(%bighash);
1.104 matthew 2019: #
1.128 matthew 2020: # %parameter_labels has a list of storage and parameter displays by
2021: # unikey
2022: # %assesslist has a list of all resource, by symb
1.104 matthew 2023: #
1.6 www 2024: if ($stype eq 'assesscalc') {
1.128 matthew 2025: $sheet->{'rowlabel'} = \%parameter_labels;
1.6 www 2026: } elsif ($stype eq 'studentcalc') {
1.128 matthew 2027: $sheet->{'rowlabel'} = \%assesslist;
1.6 www 2028: }
1.128 matthew 2029: $updatedata{$sheet->{'coursefilename'}.'_'.$stype.'_'
2030: .$uname.'_'.$udom}=
2031: join('___;___',%{$sheet->{'rowlabel'}});
1.104 matthew 2032: # Get current from cache
1.35 www 2033: }
1.104 matthew 2034: # Find discrepancies between the course row table and this
2035: #
1.119 matthew 2036: my %f=&getformulas($sheet);
1.104 matthew 2037: my $changed=0;
2038:
1.119 matthew 2039: $sheet->{'maxrow'} = 0;
1.104 matthew 2040: my %existing=();
2041: # Now obsolete rows
2042: foreach (keys(%f)) {
2043: next if ($_!~/^A(\d+)/);
1.119 matthew 2044: if ($1 > $sheet->{'maxrow'}) {
2045: $sheet->{'maxrow'} = $1;
2046: }
2047: my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
1.104 matthew 2048: $existing{$usy}=1;
1.119 matthew 2049: unless ((exists($sheet->{'rowlabel'}->{$usy}) &&
2050: (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) ||
1.120 matthew 2051: ($f{$_}=~/^(~~~|---)/))){
1.104 matthew 2052: $f{$_}='!!! Obsolete';
2053: $changed=1;
2054: } elsif ($ufn) {
1.119 matthew 2055: $sheet->{'rowlabel'}->{$usy}
2056: =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
1.104 matthew 2057: }
1.35 www 2058: }
1.104 matthew 2059: # New and unknown keys
1.119 matthew 2060: foreach (keys(%{$sheet->{'rowlabel'}})) {
1.104 matthew 2061: unless ($existing{$_}) {
2062: $changed=1;
1.119 matthew 2063: $sheet->{'maxrow'}++;
2064: $f{'A'.$sheet->{'maxrow'}}=$_;
1.78 matthew 2065: }
1.104 matthew 2066: }
1.119 matthew 2067: if ($changed) {
1.124 matthew 2068: $sheet->{'f'} = \%f;
2069: &setformulas($sheet);
1.119 matthew 2070: }
1.104 matthew 2071: #
2072: undef %existing;
1.5 www 2073: }
1.3 www 2074:
1.24 www 2075: # ------------------------------------------------ Load data for one assessment
1.16 www 2076:
1.29 www 2077: sub loadstudent {
1.119 matthew 2078: my ($sheet)=@_;
1.16 www 2079: my %c=();
1.119 matthew 2080: my %f=&getformulas($sheet);
2081: $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'};
1.102 matthew 2082: # Get ALL the student preformance data
1.119 matthew 2083: my @tmp = &Apache::lonnet::dump($sheet->{'cid'},
2084: $sheet->{'udom'},
2085: $sheet->{'uname'},
1.102 matthew 2086: undef);
2087: if ($tmp[0] !~ /^error:/) {
2088: %cachedstores = @tmp;
1.39 www 2089: }
1.102 matthew 2090: undef @tmp;
2091: #
1.36 www 2092: my @assessdata=();
1.78 matthew 2093: foreach (keys(%f)) {
1.104 matthew 2094: next if ($_!~/^A(\d+)/);
2095: my $row=$1;
2096: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
2097: my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
1.128 matthew 2098: @assessdata=&exportsheet($sheet,$sheet->{'uname'},
1.119 matthew 2099: $sheet->{'udom'},
1.104 matthew 2100: 'assesscalc',$usy,$ufn);
2101: my $index=0;
2102: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
2103: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
2104: if ($assessdata[$index]) {
2105: my $col=$_;
2106: if ($assessdata[$index]=~/\D/) {
2107: $c{$col.$row}="'".$assessdata[$index]."'";
2108: } else {
2109: $c{$col.$row}=$assessdata[$index];
2110: }
2111: unless ($col eq 'A') {
2112: $f{$col.$row}='import';
2113: }
2114: }
2115: $index++;
1.16 www 2116: }
1.78 matthew 2117: }
1.39 www 2118: $cachedassess='';
2119: undef %cachedstores;
1.124 matthew 2120: $sheet->{'f'} = \%f;
2121: &setformulas($sheet);
1.122 matthew 2122: &setconstants($sheet,\%c);
1.16 www 2123: }
2124:
1.24 www 2125: # --------------------------------------------------- Load data for one student
1.109 matthew 2126: #
1.30 www 2127: sub loadcourse {
1.119 matthew 2128: my ($sheet,$r)=@_;
1.24 www 2129: my %c=();
1.119 matthew 2130: my %f=&getformulas($sheet);
1.37 www 2131: my $total=0;
1.78 matthew 2132: foreach (keys(%f)) {
1.37 www 2133: if ($_=~/^A(\d+)/) {
1.97 www 2134: unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
1.37 www 2135: }
1.78 matthew 2136: }
1.37 www 2137: my $now=0;
2138: my $since=time;
1.39 www 2139: $r->print(<<ENDPOP);
2140: <script>
2141: popwin=open('','popwin','width=400,height=100');
2142: popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
1.50 www 2143: '<h3>Spreadsheet Calculation Progress</h3>'+
1.39 www 2144: '<form name=popremain>'+
2145: '<input type=text size=35 name=remaining value=Starting></form>'+
2146: '</body></html>');
1.42 www 2147: popwin.document.close();
1.39 www 2148: </script>
2149: ENDPOP
1.37 www 2150: $r->rflush();
1.78 matthew 2151: foreach (keys(%f)) {
1.104 matthew 2152: next if ($_!~/^A(\d+)/);
2153: my $row=$1;
2154: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
1.130 matthew 2155: my ($sname,$sdom) = split(':',$f{$_});
2156: my @studentdata=&exportsheet($sheet,$sname,$sdom,'studentcalc');
1.104 matthew 2157: undef %userrdatas;
2158: $now++;
2159: $r->print('<script>popwin.document.popremain.remaining.value="'.
1.37 www 2160: $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
1.104 matthew 2161: ' secs remaining";</script>');
2162: $r->rflush();
2163: #
2164: my $index=0;
2165: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
2166: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
1.132 matthew 2167: if (defined($studentdata[$index])) {
1.104 matthew 2168: my $col=$_;
2169: if ($studentdata[$index]=~/\D/) {
2170: $c{$col.$row}="'".$studentdata[$index]."'";
2171: } else {
2172: $c{$col.$row}=$studentdata[$index];
2173: }
2174: unless ($col eq 'A') {
2175: $f{$col.$row}='import';
2176: }
1.132 matthew 2177: }
2178: $index++;
1.24 www 2179: }
1.78 matthew 2180: }
1.124 matthew 2181: $sheet->{'f'}=\%f;
2182: &setformulas($sheet);
1.122 matthew 2183: &setconstants($sheet,\%c);
1.43 www 2184: $r->print('<script>popwin.close()</script>');
1.37 www 2185: $r->rflush();
1.24 www 2186: }
2187:
1.6 www 2188: # ------------------------------------------------ Load data for one assessment
1.109 matthew 2189: #
1.29 www 2190: sub loadassessment {
1.119 matthew 2191: my ($sheet)=@_;
1.29 www 2192:
1.119 matthew 2193: my $uhome = $sheet->{'uhome'};
2194: my $uname = $sheet->{'uname'};
2195: my $udom = $sheet->{'udom'};
2196: my $symb = $sheet->{'usymb'};
2197: my $cid = $sheet->{'cid'};
2198: my $cnum = $sheet->{'cnum'};
2199: my $cdom = $sheet->{'cdom'};
2200: my $chome = $sheet->{'chome'};
1.29 www 2201:
1.6 www 2202: my $namespace;
1.29 www 2203: unless ($namespace=$cid) { return ''; }
1.104 matthew 2204: # Get stored values
2205: my %returnhash=();
2206: if ($cachedassess eq $uname.':'.$udom) {
2207: #
2208: # get data out of the dumped stores
2209: #
2210: my $version=$cachedstores{'version:'.$symb};
2211: my $scope;
2212: for ($scope=1;$scope<=$version;$scope++) {
2213: foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
2214: $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
2215: }
2216: }
2217: } else {
2218: #
2219: # restore individual
2220: #
1.109 matthew 2221: %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
2222: for (my $version=1;$version<=$returnhash{'version'};$version++) {
1.104 matthew 2223: foreach (split(/\:/,$returnhash{$version.':keys'})) {
2224: $returnhash{$_}=$returnhash{$version.':'.$_};
2225: }
2226: }
1.6 www 2227: }
1.109 matthew 2228: #
1.104 matthew 2229: # returnhash now has all stores for this resource
2230: # convert all "_" to "." to be able to use libraries, multiparts, etc
1.109 matthew 2231: #
2232: # This is dumb. It is also necessary :(
1.76 www 2233: my @oldkeys=keys %returnhash;
1.109 matthew 2234: #
1.116 matthew 2235: foreach my $name (@oldkeys) {
2236: my $value=$returnhash{$name};
2237: delete $returnhash{$name};
1.76 www 2238: $name=~s/\_/\./g;
2239: $returnhash{$name}=$value;
1.78 matthew 2240: }
1.104 matthew 2241: # initialize coursedata and userdata for this user
1.31 www 2242: undef %courseopt;
2243: undef %useropt;
1.29 www 2244:
2245: my $userprefix=$uname.'_'.$udom.'_';
1.116 matthew 2246:
1.11 www 2247: unless ($uhome eq 'no_host') {
1.104 matthew 2248: # Get coursedata
1.105 matthew 2249: unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
1.116 matthew 2250: my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum);
2251: $courserdatas{$cid}=\%Tmp;
2252: $courserdatas{$cid.'.last_cache'}=time;
1.105 matthew 2253: }
1.116 matthew 2254: while (my ($name,$value) = each(%{$courserdatas{$cid}})) {
2255: $courseopt{$userprefix.$name}=$value;
1.104 matthew 2256: }
2257: # Get userdata (if present)
1.116 matthew 2258: unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) {
2259: my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname);
2260: $userrdatas{$cid} = \%Tmp;
1.114 matthew 2261: # Most of the time the user does not have a 'resourcedata.db'
2262: # file. We need to cache that we got nothing instead of bothering
2263: # with requesting it every time.
1.116 matthew 2264: $userrdatas{$uname.'@'.$udom.'.last_cache'}=time;
1.109 matthew 2265: }
1.116 matthew 2266: while (my ($name,$value) = each(%{$userrdatas{$cid}})) {
2267: $useropt{$userprefix.$name}=$value;
1.104 matthew 2268: }
1.29 www 2269: }
1.104 matthew 2270: # now courseopt, useropt initialized for this user and course
2271: # (used by parmval)
2272: #
2273: # Load keys for this assessment only
2274: #
1.60 www 2275: my %thisassess=();
2276: my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
1.78 matthew 2277: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
1.60 www 2278: $thisassess{$_}=1;
1.78 matthew 2279: }
1.104 matthew 2280: #
2281: # Load parameters
2282: #
2283: my %c=();
2284: if (tie(%parmhash,'GDBM_File',
1.119 matthew 2285: $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
2286: my %f=&getformulas($sheet);
1.125 matthew 2287: foreach my $cell (keys(%f)) {
2288: next if ($cell !~ /^A/);
2289: next if ($f{$cell} =~/^[\!\~\-]/);
2290: if ($f{$cell}=~/^parameter/) {
2291: if (defined($thisassess{$f{$cell}})) {
2292: my $val = &parmval($f{$cell},$sheet);
2293: $c{$cell} = $val;
2294: $c{$f{$cell}} = $val;
1.104 matthew 2295: }
2296: } else {
1.125 matthew 2297: my $key=$f{$cell};
1.104 matthew 2298: my $ckey=$key;
2299: $key=~s/^stores\_/resource\./;
2300: $key=~s/\_/\./g;
1.125 matthew 2301: $c{$cell}=$returnhash{$key};
1.104 matthew 2302: $c{$ckey}=$returnhash{$key};
2303: }
1.6 www 2304: }
1.104 matthew 2305: untie(%parmhash);
1.78 matthew 2306: }
1.122 matthew 2307: &setconstants($sheet,\%c);
1.6 www 2308: }
2309:
1.10 www 2310: # --------------------------------------------------------- Various form fields
2311:
2312: sub textfield {
2313: my ($title,$name,$value)=@_;
2314: return "\n<p><b>$title:</b><br>".
1.104 matthew 2315: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
1.10 www 2316: }
2317:
2318: sub hiddenfield {
2319: my ($name,$value)=@_;
2320: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
2321: }
2322:
2323: sub selectbox {
2324: my ($title,$name,$value,%options)=@_;
2325: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
1.78 matthew 2326: foreach (sort keys(%options)) {
1.10 www 2327: $selout.='<option value="'.$_.'"';
2328: if ($_ eq $value) { $selout.=' selected'; }
2329: $selout.='>'.$options{$_}.'</option>';
1.78 matthew 2330: }
1.10 www 2331: return $selout.'</select>';
2332: }
2333:
1.28 www 2334: # =============================================== Update information in a sheet
2335: #
2336: # Add new users or assessments, etc.
2337: #
2338:
2339: sub updatesheet {
1.119 matthew 2340: my ($sheet)=@_;
2341: my $stype=$sheet->{'sheettype'};
1.28 www 2342: if ($stype eq 'classcalc') {
1.119 matthew 2343: return &updateclasssheet($sheet);
1.28 www 2344: } else {
1.119 matthew 2345: return &updatestudentassesssheet($sheet);
1.28 www 2346: }
2347: }
2348:
2349: # =================================================== Load the rows for a sheet
2350: #
2351: # Import the data for rows
2352: #
2353:
1.37 www 2354: sub loadrows {
1.119 matthew 2355: my ($sheet,$r)=@_;
2356: my $stype=$sheet->{'sheettype'};
1.28 www 2357: if ($stype eq 'classcalc') {
1.119 matthew 2358: &loadcourse($sheet,$r);
1.28 www 2359: } elsif ($stype eq 'studentcalc') {
1.119 matthew 2360: &loadstudent($sheet);
1.28 www 2361: } else {
1.119 matthew 2362: &loadassessment($sheet);
1.28 www 2363: }
2364: }
2365:
1.47 www 2366: # ======================================================= Forced recalculation?
2367:
2368: sub checkthis {
2369: my ($keyname,$time)=@_;
2370: return ($time<$expiredates{$keyname});
2371: }
1.104 matthew 2372:
1.47 www 2373: sub forcedrecalc {
2374: my ($uname,$udom,$stype,$usymb)=@_;
2375: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
2376: my $time=$oldsheets{$key.'.time'};
1.53 www 2377: if ($ENV{'form.forcerecalc'}) { return 1; }
1.47 www 2378: unless ($time) { return 1; }
2379: if ($stype eq 'assesscalc') {
1.120 matthew 2380: my $map=(split(/___/,$usymb))[0];
1.47 www 2381: if (&checkthis('::assesscalc:',$time) ||
2382: &checkthis('::assesscalc:'.$map,$time) ||
2383: &checkthis('::assesscalc:'.$usymb,$time) ||
1.49 www 2384: &checkthis($uname.':'.$udom.':assesscalc:',$time) ||
2385: &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
2386: &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
1.47 www 2387: return 1;
2388: }
2389: } else {
2390: if (&checkthis('::studentcalc:',$time) ||
1.51 www 2391: &checkthis($uname.':'.$udom.':studentcalc:',$time)) {
1.47 www 2392: return 1;
2393: }
2394: }
2395: return 0;
2396: }
2397:
1.28 www 2398: # ============================================================== Export handler
1.128 matthew 2399: # exportsheet
2400: # returns the export row for a spreadsheet.
2401: #
1.28 www 2402: sub exportsheet {
1.128 matthew 2403: my ($sheet,$uname,$udom,$stype,$usymb,$fn)=@_;
2404: $uname = $uname || $sheet->{'uname'};
2405: $udom = $udom || $sheet->{'udom'};
2406: $stype = $stype || $sheet->{'sheettype'};
1.104 matthew 2407: my @exportarr=();
1.132 matthew 2408: if (defined($usymb) && ($usymb=~/^\_(\w+)/) &&
2409: (!defined($fn) || $fn eq '')) {
1.104 matthew 2410: $fn='default_'.$1;
2411: }
2412: #
2413: # Check if cached
2414: #
2415: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
2416: my $found='';
2417: if ($oldsheets{$key}) {
1.120 matthew 2418: foreach (split(/___&\___/,$oldsheets{$key})) {
2419: my ($name,$value)=split(/___=___/,$_);
1.46 www 2420: if ($name eq $fn) {
1.104 matthew 2421: $found=$value;
1.46 www 2422: }
1.104 matthew 2423: }
1.46 www 2424: }
1.104 matthew 2425: unless ($found) {
1.128 matthew 2426: &cachedssheets($sheet,$uname,$udom);
1.104 matthew 2427: if ($oldsheets{$key}) {
1.120 matthew 2428: foreach (split(/___&\___/,$oldsheets{$key})) {
2429: my ($name,$value)=split(/___=___/,$_);
1.104 matthew 2430: if ($name eq $fn) {
2431: $found=$value;
2432: }
2433: }
2434: }
1.44 www 2435: }
1.104 matthew 2436: #
2437: # Check if still valid
2438: #
2439: if ($found) {
2440: if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
2441: $found='';
2442: }
2443: }
2444: if ($found) {
2445: #
2446: # Return what was cached
2447: #
1.120 matthew 2448: @exportarr=split(/___;___/,$found);
2449: return @exportarr;
2450: }
2451: #
2452: # Not cached
2453: #
1.128 matthew 2454: my ($newsheet)=&makenewsheet($uname,$udom,$stype,$usymb);
2455: &readsheet($newsheet,$fn);
2456: &updatesheet($newsheet);
2457: &loadrows($newsheet);
2458: &calcsheet($newsheet);
2459: @exportarr=&exportdata($newsheet);
1.131 matthew 2460: ##
2461: ## Store now
2462: ##
1.120 matthew 2463: #
1.131 matthew 2464: # load in the old value
1.120 matthew 2465: #
1.131 matthew 2466: my %currentlystored=();
1.120 matthew 2467: if ($stype eq 'studentcalc') {
1.131 matthew 2468: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets',
2469: [$key],
2470: $sheet->{'cdom'},$sheet->{'cnum'});
2471: if ($tmp[0]!~/^error/) {
2472: %currentlystored = @tmp;
2473: }
2474: } else {
2475: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'.
2476: $sheet->{'cid'},[$key],
2477: $sheet->{'udom'},$sheet->{'uname'});
2478: if ($tmp[0]!~/^error/) {
2479: %currentlystored = @tmp;
1.120 matthew 2480: }
2481: }
1.131 matthew 2482: #
2483: # Add the new line
2484: #
1.120 matthew 2485: $currentlystored{$fn}=join('___;___',@exportarr);
2486: #
1.131 matthew 2487: # Stick everything back together
2488: #
1.120 matthew 2489: my $newstore='';
2490: foreach (keys(%currentlystored)) {
2491: if ($newstore) { $newstore.='___&___'; }
2492: $newstore.=$_.'___=___'.$currentlystored{$_};
2493: }
2494: my $now=time;
1.131 matthew 2495: #
2496: # Store away the new value
2497: #
1.120 matthew 2498: if ($stype eq 'studentcalc') {
2499: &Apache::lonnet::put('nohist_calculatedsheets',
2500: { $key => $newstore,
2501: $key.time => $now },
1.131 matthew 2502: $sheet->{'cdom'},$sheet->{'cnum'});
1.120 matthew 2503: } else {
2504: &Apache::lonnet::put('nohist_calculatedsheets_'.$sheet->{'cid'},
2505: { $key => $newstore,
2506: $key.time => $now },
2507: $sheet->{'udom'},
2508: $sheet->{'uname'})
1.78 matthew 2509: }
1.104 matthew 2510: return @exportarr;
1.44 www 2511: }
1.104 matthew 2512:
1.48 www 2513: # ============================================================ Expiration Dates
2514: #
2515: # Load previously cached student spreadsheets for this course
2516: #
2517: sub expirationdates {
2518: undef %expiredates;
2519: my $cid=$ENV{'request.course.id'};
1.128 matthew 2520: my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
2521: $ENV{'course.'.$cid.'.domain'},
2522: $ENV{'course.'.$cid.'.num'});
2523: if (lc($tmp[0])!~/^error/){
2524: %expiredates = @tmp;
1.48 www 2525: }
2526: }
1.44 www 2527:
2528: # ===================================================== Calculated sheets cache
2529: #
1.46 www 2530: # Load previously cached student spreadsheets for this course
1.44 www 2531: #
2532:
1.46 www 2533: sub cachedcsheets {
1.44 www 2534: my $cid=$ENV{'request.course.id'};
1.128 matthew 2535: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
2536: $ENV{'course.'.$cid.'.domain'},
2537: $ENV{'course.'.$cid.'.num'});
2538: if ($tmp[0] !~ /^error/) {
2539: my %StupidTempHash = @tmp;
2540: while (my ($key,$value) = each %StupidTempHash) {
2541: $oldsheets{$key} = $value;
1.78 matthew 2542: }
1.44 www 2543: }
1.28 www 2544: }
2545:
1.46 www 2546: # ===================================================== Calculated sheets cache
2547: #
2548: # Load previously cached assessment spreadsheets for this student
2549: #
2550:
2551: sub cachedssheets {
1.128 matthew 2552: my ($sheet,$uname,$udom) = @_;
2553: $uname = $uname || $sheet->{'uname'};
2554: $udom = $udom || $sheet->{'udom'};
2555: if (! $loadedcaches{$sheet->{'uname'}.'_'.$sheet->{'udom'}}) {
2556: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
2557: $sheet->{'udom'},
2558: $sheet->{'uname'});
2559: if ($tmp[0] !~ /^error/) {
2560: my %StupidTempHash = @tmp;
2561: while (my ($key,$value) = each %StupidTempHash) {
2562: $oldsheets{$key} = $value;
2563: }
2564: $loadedcaches{$sheet->{'uname'}.'_'.$sheet->{'udom'}}=1;
1.78 matthew 2565: }
1.46 www 2566: }
2567: }
2568:
2569: # ===================================================== Calculated sheets cache
2570: #
2571: # Load previously cached assessment spreadsheets for this student
2572: #
2573:
1.12 www 2574: # ================================================================ Main handler
1.28 www 2575: #
2576: # Interactive call to screen
2577: #
2578: #
1.3 www 2579: sub handler {
1.7 www 2580: my $r=shift;
1.110 www 2581:
1.118 matthew 2582: if (! exists($ENV{'form.Status'})) {
2583: $ENV{'form.Status'} = 'Active';
2584: }
1.134 ! matthew 2585: if (! exists($ENV{'form.output'})) {
! 2586: $ENV{'form.output'} = 'HTML';
! 2587: }
1.116 matthew 2588: # Check this server
1.111 matthew 2589: my $loaderror=&Apache::lonnet::overloaderror($r);
2590: if ($loaderror) { return $loaderror; }
1.116 matthew 2591: # Check the course homeserver
1.111 matthew 2592: $loaderror= &Apache::lonnet::overloaderror($r,
2593: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
2594: if ($loaderror) { return $loaderror; }
1.116 matthew 2595:
1.28 www 2596: if ($r->header_only) {
1.104 matthew 2597: $r->content_type('text/html');
2598: $r->send_http_header;
2599: return OK;
2600: }
2601: # Global directory configs
1.106 matthew 2602: $includedir = $r->dir_config('lonIncludes');
2603: $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
1.104 matthew 2604: # Needs to be in a course
1.106 matthew 2605: if (! $ENV{'request.course.fn'}) {
2606: # Not in a course, or not allowed to modify parms
2607: $ENV{'user.error.msg'}=
2608: $r->uri.":opa:0:0:Cannot modify spreadsheet";
2609: return HTTP_NOT_ACCEPTABLE;
2610: }
2611: # Get query string for limited number of parameters
2612: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
2613: ['uname','udom','usymb','ufn']);
1.111 matthew 2614: if ($ENV{'request.role'} =~ /^st\./) {
2615: delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'}));
2616: delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
2617: }
1.106 matthew 2618: if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
2619: $ENV{'form.ufn'}='default_'.$1;
2620: }
2621: # Interactive loading of specific sheet?
2622: if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
2623: $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
2624: }
2625: #
2626: # Determine the user name and domain for the sheet.
2627: my $aname;
2628: my $adom;
2629: unless ($ENV{'form.uname'}) {
2630: $aname=$ENV{'user.name'};
2631: $adom=$ENV{'user.domain'};
2632: } else {
2633: $aname=$ENV{'form.uname'};
2634: $adom=$ENV{'form.udom'};
2635: }
2636: #
2637: # Open page
2638: $r->content_type('text/html');
2639: $r->header_out('Cache-control','no-cache');
2640: $r->header_out('Pragma','no-cache');
2641: $r->send_http_header;
2642: # Screen output
2643: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
1.111 matthew 2644: if ($ENV{'request.role'} !~ /^st\./) {
2645: $r->print(<<ENDSCRIPT);
1.10 www 2646: <script language="JavaScript">
2647:
2648: function celledit(cn,cf) {
2649: var cnf=prompt(cn,cf);
1.86 matthew 2650: if (cnf!=null) {
2651: document.sheet.unewfield.value=cn;
1.10 www 2652: document.sheet.unewformula.value=cnf;
2653: document.sheet.submit();
2654: }
2655: }
2656:
1.55 www 2657: function changesheet(cn) {
2658: document.sheet.unewfield.value=cn;
2659: document.sheet.unewformula.value='changesheet';
2660: document.sheet.submit();
2661: }
2662:
1.92 www 2663: function insertrow(cn) {
2664: document.sheet.unewfield.value='insertrow';
2665: document.sheet.unewformula.value=cn;
2666: document.sheet.submit();
2667: }
2668:
1.10 www 2669: </script>
2670: ENDSCRIPT
1.111 matthew 2671: }
1.106 matthew 2672: $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
2673: '<form action="'.$r->uri.'" name=sheet method=post>');
2674: $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
2675: &hiddenfield('udom',$ENV{'form.udom'}).
2676: &hiddenfield('usymb',$ENV{'form.usymb'}).
2677: &hiddenfield('unewfield','').
2678: &hiddenfield('unewformula',''));
2679: $r->rflush();
2680: #
2681: # Full recalc?
2682: if ($ENV{'form.forcerecalc'}) {
2683: $r->print('<h4>Completely Recalculating Sheet ...</h4>');
2684: undef %spreadsheets;
2685: undef %courserdatas;
2686: undef %userrdatas;
2687: undef %defaultsheets;
2688: undef %updatedata;
2689: }
2690: # Read new sheet or modified worksheet
2691: $r->uri=~/\/(\w+)$/;
1.119 matthew 2692: my ($sheet)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
1.106 matthew 2693: #
2694: # If a new formula had been entered, go from work copy
2695: if ($ENV{'form.unewfield'}) {
2696: $r->print('<h2>Modified Workcopy</h2>');
2697: $ENV{'form.unewformula'}=~s/\'/\"/g;
2698: $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
2699: $ENV{'form.unewformula'}.'<p>');
1.119 matthew 2700: $sheet->{'filename'} = $ENV{'form.ufn'};
2701: &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'});
1.106 matthew 2702: } elsif ($ENV{'form.saveas'}) {
1.119 matthew 2703: $sheet->{'filename'} = $ENV{'form.ufn'};
2704: &tmpread($sheet);
1.106 matthew 2705: } else {
1.119 matthew 2706: &readsheet($sheet,$ENV{'form.ufn'});
1.106 matthew 2707: }
2708: # Print out user information
1.120 matthew 2709: if ($sheet->{'sheettype'} ne 'classcalc') {
1.119 matthew 2710: $r->print('<p><b>User:</b> '.$sheet->{'uname'}.
2711: '<br><b>Domain:</b> '.$sheet->{'udom'});
2712: $r->print('<br><b>Section/Group:</b> '.$sheet->{'csec'});
1.106 matthew 2713: if ($ENV{'form.usymb'}) {
2714: $r->print('<br><b>Assessment:</b> <tt>'.
2715: $ENV{'form.usymb'}.'</tt>');
1.30 www 2716: }
1.106 matthew 2717: }
2718: #
2719: # Check user permissions
1.119 matthew 2720: if (($sheet->{'sheettype'} eq 'classcalc' ) ||
2721: ($sheet->{'uname'} ne $ENV{'user.name'} ) ||
2722: ($sheet->{'udom'} ne $ENV{'user.domain'})) {
2723: unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) {
1.106 matthew 2724: $r->print('<h1>Access Permission Denied</h1>'.
2725: '</form></body></html>');
2726: return OK;
2727: }
2728: }
2729: # Additional options
2730: $r->print('<br />'.
2731: '<input type="submit" name="forcerecalc" '.
2732: 'value="Completely Recalculate Sheet"><p>');
1.119 matthew 2733: if ($sheet->{'sheettype'} eq 'assesscalc') {
1.106 matthew 2734: $r->print('<p><font size=+2>'.
2735: '<a href="/adm/studentcalc?'.
1.119 matthew 2736: 'uname='.$sheet->{'uname'}.
2737: '&udom='.$sheet->{'udom'}.'">'.
1.106 matthew 2738: 'Level up: Student Sheet</a></font><p>');
2739: }
1.119 matthew 2740: if (($sheet->{'sheettype'} eq 'studentcalc') &&
2741: (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) {
1.106 matthew 2742: $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
2743: 'Level up: Course Sheet</a></font><p>');
2744: }
2745: # Save dialog
2746: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2747: my $fname=$ENV{'form.ufn'};
2748: $fname=~s/\_[^\_]+$//;
2749: if ($fname eq 'default') { $fname='course_default'; }
2750: $r->print('<input type=submit name=saveas value="Save as ...">'.
2751: '<input type=text size=20 name=newfn value="'.$fname.'">'.
2752: 'make default: <input type=checkbox name="makedefufn"><p>');
2753: }
1.119 matthew 2754: $r->print(&hiddenfield('ufn',$sheet->{'filename'}));
1.106 matthew 2755: # Load dialog
2756: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2757: $r->print('<p><input type=submit name=load value="Load ...">'.
2758: '<select name="loadthissheet">'.
2759: '<option name="default">Default</option>');
1.119 matthew 2760: foreach (&othersheets($sheet)) {
1.106 matthew 2761: $r->print('<option name="'.$_.'"');
2762: if ($ENV{'form.ufn'} eq $_) {
2763: $r->print(' selected');
1.104 matthew 2764: }
1.106 matthew 2765: $r->print('>'.$_.'</option>');
2766: }
2767: $r->print('</select><p>');
1.119 matthew 2768: if ($sheet->{'sheettype'} eq 'studentcalc') {
1.116 matthew 2769: &setothersheets($sheet,
1.119 matthew 2770: &othersheets($sheet,'assesscalc'));
1.104 matthew 2771: }
1.106 matthew 2772: }
2773: # Cached sheets
2774: &expirationdates();
2775: undef %oldsheets;
2776: undef %loadedcaches;
1.119 matthew 2777: if ($sheet->{'sheettype'} eq 'classcalc') {
1.106 matthew 2778: $r->print("Loading previously calculated student sheets ...\n");
1.104 matthew 2779: $r->rflush();
1.106 matthew 2780: &cachedcsheets();
1.119 matthew 2781: } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
1.106 matthew 2782: $r->print("Loading previously calculated assessment sheets ...\n");
1.46 www 2783: $r->rflush();
1.128 matthew 2784: &cachedssheets($sheet);
1.106 matthew 2785: }
2786: # Update sheet, load rows
2787: $r->print("Loaded sheet(s), updating rows ...<br>\n");
2788: $r->rflush();
2789: #
1.119 matthew 2790: &updatesheet($sheet);
1.106 matthew 2791: $r->print("Updated rows, loading row data ...\n");
2792: $r->rflush();
2793: #
1.119 matthew 2794: &loadrows($sheet,$r);
1.106 matthew 2795: $r->print("Loaded row data, calculating sheet ...<br>\n");
2796: $r->rflush();
2797: #
1.116 matthew 2798: my $calcoutput=&calcsheet($sheet);
1.106 matthew 2799: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
2800: # See if something to save
2801: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
2802: my $fname='';
2803: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
2804: $fname=~s/\W/\_/g;
2805: if ($fname eq 'default') { $fname='course_default'; }
1.119 matthew 2806: $fname.='_'.$sheet->{'sheettype'};
2807: $sheet->{'filename'} = $fname;
1.106 matthew 2808: $ENV{'form.ufn'}=$fname;
2809: $r->print('<p>Saving spreadsheet: '.
1.119 matthew 2810: &writesheet($sheet,$ENV{'form.makedefufn'}).
1.116 matthew 2811: '<p>');
1.104 matthew 2812: }
1.106 matthew 2813: }
2814: #
1.116 matthew 2815: # Write the modified worksheet
1.119 matthew 2816: $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'<p>');
2817: &tmpwrite($sheet);
2818: if ($sheet->{'sheettype'} eq 'studentcalc') {
1.106 matthew 2819: $r->print('<br>Show rows with empty A column: ');
1.62 www 2820: } else {
2821: $r->print('<br>Show empty rows: ');
1.120 matthew 2822: }
1.106 matthew 2823: #
1.77 www 2824: $r->print(&hiddenfield('userselhidden','true').
1.106 matthew 2825: '<input type="checkbox" name="showall" onClick="submit()"');
2826: #
1.77 www 2827: if ($ENV{'form.showall'}) {
1.106 matthew 2828: $r->print(' checked');
1.77 www 2829: } else {
1.106 matthew 2830: unless ($ENV{'form.userselhidden'}) {
2831: unless
1.128 matthew 2832: ($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') {
1.106 matthew 2833: $r->print(' checked');
2834: $ENV{'form.showall'}=1;
2835: }
2836: }
1.77 www 2837: }
1.61 www 2838: $r->print('>');
1.120 matthew 2839: #
2840: # CSV format checkbox (classcalc sheets only)
1.134 ! matthew 2841: $r->print(' Output as <select name="output" size="1" onClick="submit()">'.
! 2842: "\n");
! 2843: foreach my $mode (qw/HTML CSV EXCEL/) {
! 2844: $r->print('<option value="'.$mode.'"');
! 2845: if ($ENV{'form.output'} eq $mode) {
! 2846: $r->print(' selected ');
! 2847: }
! 2848: $r->print('>'.$mode.'</option>'."\n");
! 2849: }
! 2850: $r->print("</select>\n");
! 2851: #
1.119 matthew 2852: if ($sheet->{'sheettype'} eq 'classcalc') {
2853: $r->print(' Student Status: '.
2854: &Apache::lonhtmlcommon::StatusOptions
2855: ($ENV{'form.Status'},'sheet'));
1.69 www 2856: }
1.120 matthew 2857: #
2858: # Buttons to insert rows
1.134 ! matthew 2859: # $r->print(<<ENDINSERTBUTTONS);
! 2860: #<br>
! 2861: #<input type='button' onClick='insertrow("top");'
! 2862: #value='Insert Row Top'>
! 2863: #<input type='button' onClick='insertrow("bottom");'
! 2864: #value='Insert Row Bottom'><br>
! 2865: #ENDINSERTBUTTONS
1.106 matthew 2866: # Print out sheet
1.119 matthew 2867: &outsheet($r,$sheet);
1.10 www 2868: $r->print('</form></body></html>');
1.106 matthew 2869: # Done
1.3 www 2870: return OK;
1.1 www 2871: }
2872:
2873: 1;
2874: __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