File:
[LON-CAPA] /
loncom /
interface /
spreadsheet /
Spreadsheet.pm
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Fri May 16 20:55:11 2003 UTC (21 years, 3 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
Nearly complete reworking of spreadsheet.
lonspreadsheet.pm holds a few utility functions and the handler, which
creates a spreadsheet and tells it to display itself.
Spreadsheet.pm is the base definition of the spreadsheet object.
classcalc.pm, studentcalc.pm, and assesscalc.pm are implementations of the
spreadsheets.
There are missing pieces - excel and csv output, limiting by section
permissions, the ability to add extra 'header' rows to the student and
course level sheets, and students are still allowed to view the assessment
level sheets (will disable this soon).
Computing and editing of the spreadsheet have been tested and have been
given a preliminary seal of approval.
1: #
2: # $Id: Spreadsheet.pm,v 1.1 2003/05/16 20:55:11 matthew Exp $
3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
26: # The LearningOnline Network with CAPA
27: # Spreadsheet/Grades Display Handler
28: #
29: # POD required stuff:
30:
31: =head1 NAME
32:
33: Spreadsheet
34:
35: =head1 SYNOPSIS
36:
37: =head1 DESCRIPTION
38:
39: =over 4
40:
41: =cut
42:
43: ###################################################
44: ###################################################
45: ### Spreadsheet ###
46: ###################################################
47: ###################################################
48: package Apache::Spreadsheet;
49:
50: use strict;
51: use Apache::Constants qw(:common :http);
52: use Apache::lonnet;
53: use Safe;
54: use Safe::Hole;
55: use Opcode;
56: use HTML::Entities();
57: use HTML::TokeParser;
58: use Spreadsheet::WriteExcel;
59: use Time::HiRes;
60:
61: ##
62: ## Package Variables
63: ##
64: my %expiredates;
65:
66: my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
67: my @LC_Columns = split(//,'abcdefghijklmnopqrstuvwxyz');
68:
69: ######################################################
70:
71: =pod
72:
73: =item &new
74:
75: Returns a new spreadsheet object.
76:
77: =cut
78:
79: ######################################################
80: sub new {
81: my $this = shift;
82: my $class = ref($this) || $this;
83: my ($stype) = ($class =~ /Apache::(.*)$/);
84: #
85: my ($name,$domain,$filename,$usymb)=@_;
86: #
87: my $self = {
88: name => $name,
89: domain => $domain,
90: type => $stype,
91: symb => $usymb,
92: errorlog => '',
93: maxrow => '',
94: cid => $ENV{'request.course.id'},
95: cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
96: cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
97: chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},
98: coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},
99: coursefilename => $ENV{'request.course.fn'},
100: #
101: # Data storage
102: formulas => {},
103: constants => {},
104: rows => [],
105: row_source => {},
106: othersheets => [],
107: };
108: #
109: $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain);
110: #
111: bless($self,$class);
112: #
113: # Load in the spreadsheet definition
114: $self->filename($filename);
115: if (exists($ENV{'form.workcopy'}) &&
116: $self->{'type'} eq $ENV{'form.workcopy'}) {
117: $self->load_tmp();
118: } else {
119: $self->load();
120: }
121: return $self;
122: }
123:
124: ######################################################
125:
126: =pod
127:
128: =item &filename
129:
130: get or set the filename for a spreadsheet.
131:
132: =cut
133:
134: ######################################################
135: sub filename {
136: my $self = shift();
137: if (@_) {
138: my ($newfilename) = @_;
139: if (! defined($newfilename) || $newfilename eq 'Default' ||
140: $newfilename !~ /\w/ || $newfilename =~ /\W/) {
141: my %tmphash = &Apache::lonnet::get('environment',
142: ['spreadsheet_default_'.
143: $self->{'type'}],
144: $self->{'cdom'},
145: $self->{'cnum'});
146: my ($tmp) = keys(%tmphash);
147: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
148: $newfilename=$tmphash{'spreadsheet_default_'.$self->{'type'}};
149: }
150: }
151: if (! defined($newfilename) ||
152: $newfilename !~ /\w/ ||
153: $newfilename =~ /^\W*$/) {
154: $newfilename = 'default.'.$self->{'type'};
155: } else {
156: my $regexp = '_'.$self->{'type'}.'$';
157: if ($newfilename !~ /$regexp/) {
158: $newfilename .= '_'.$self->{'type'};
159: }
160: }
161: $self->{'filename'} = $newfilename;
162: return;
163: }
164: return $self->{'filename'};
165: }
166:
167: ######################################################
168:
169: =pod
170:
171: =item &make_default()
172:
173: Make the current spreadsheet file the default for the course. Expires all the
174: default spreadsheets.......!
175:
176: =cut
177:
178: ######################################################
179: sub make_default {
180: my $self = shift();
181: my $result = &Apache::lonnet::put('environment',
182: {'spreadsheet_default_'.$self->{'type'} => $self->filename()},
183: $self->{'cdom'},$self->{'cnum'});
184: return $result if ($result ne 'ok');
185: my $symb = $self->{'symb'};
186: $symb = '' if (! defined($symb));
187: &Apache::lonnet::expirespread('','',$self->{'type'},$symb);
188: }
189:
190: ######################################################
191:
192: =pod
193:
194: =item &is_default()
195:
196: Returns 1 if the current spreadsheet is the default as specified in the
197: course environment. Returns 0 otherwise.
198:
199: =cut
200:
201: ######################################################
202: sub is_default {
203: my $self = shift;
204: # Check to find out if we are the default spreadsheet (filenames match)
205: my $default_filename = '';
206: my %tmphash = &Apache::lonnet::get('environment',
207: ['spreadsheet_default_'.
208: $self->{'type'}],
209: $self->{'cdom'},
210: $self->{'cnum'});
211: my ($tmp) = keys(%tmphash);
212: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
213: $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}};
214: }
215: return 1 if ($self->filename() eq $default_filename);
216: return 0;
217: }
218:
219: sub initialize_spreadsheet_package {
220: &load_spreadsheet_expirationdates();
221: &clear_spreadsheet_definition_cache();
222: }
223:
224: sub load_spreadsheet_expirationdates {
225: undef %expiredates;
226: my $cid=$ENV{'request.course.id'};
227: my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
228: $ENV{'course.'.$cid.'.domain'},
229: $ENV{'course.'.$cid.'.num'});
230: if (lc($tmp[0]) !~ /^error/){
231: %expiredates = @tmp;
232: }
233: }
234:
235: sub check_expiration_time {
236: my $self = shift;
237: my ($time)=@_;
238: my ($key1,$key2,$key3,$key4);
239: $key1 = '::'.$self->{'type'}.':';
240: $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
241: $key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
242: $key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'}));
243: foreach my $key ($key1,$key2,$key3,$key4) {
244: next if (! defined($key));
245: if (exists($expiredates{$key}) &&$expiredates{$key} > $time) {
246: return 0;
247: }
248: }
249: return 1;
250: }
251:
252: ######################################################
253:
254: =pod
255:
256: =item &initialize_safe_space
257:
258: Returns the safe space required by a Spreadsheet object.
259:
260: =head 2 Safe Space Functions
261:
262: =over 4
263:
264: =cut
265:
266: ######################################################
267: sub initialize_safe_space {
268: my $self = shift;
269: my $safeeval = new Safe(shift);
270: my $safehole = new Safe::Hole;
271: $safeeval->permit("entereval");
272: $safeeval->permit(":base_math");
273: $safeeval->permit("sort");
274: $safeeval->deny(":base_io");
275: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
276: $safehole->wrap(\&mask,$safeeval,'&mask');
277: $safeeval->share('$@');
278: my $code=<<'ENDDEFS';
279: # ---------------------------------------------------- Inside of the safe space
280: #
281: # f: formulas
282: # t: intermediate format (variable references expanded)
283: # v: output values
284: # c: preloaded constants (A-column)
285: # rl: row label
286: # os: other spreadsheets (for student spreadsheet only)
287: undef %sheet_values; # Holds the (computed, final) values for the sheet
288: # This is only written to by &calc, the spreadsheet computation routine.
289: # It is read by many functions
290: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,
291: # which does the translation of strings like C5 into the value in C5.
292: # Used in &calc - %t holds the values that are actually eval'd.
293: undef %f; # Holds the formulas for each cell. This is the users
294: # (spreadsheet authors) data for each cell.
295: undef %c; # Holds the constants for a sheet. In the assessment
296: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed,
297: # &sett, and &constants. There is no &getconstants.
298: # &constants is called by &loadstudent, &loadcourse, &load assessment,
299: undef @os; # Holds the names of other spreadsheets - this is used to specify
300: # the spreadsheets that are available for the assessment sheet.
301: # Set by &setothersheets. &setothersheets is called by &handler. A
302: # related subroutine is &othersheets.
303: $errorlog = '';
304: #
305: $maxrow = 0;
306: $type = '';
307: #
308: # filename/reference of the sheet
309: $filename = '';
310: #
311: # user data
312: $name = '';
313: $uhome = '';
314: $domain = '';
315: #
316: # course data
317: $csec = '';
318: $chome= '';
319: $cnum = '';
320: $cdom = '';
321: $cid = '';
322: $coursefilename = '';
323: #
324: # symb
325: $usymb = '';
326: #
327: # error messages
328: $errormsg = '';
329: #
330: #-------------------------------------------------------
331:
332: =pod
333:
334: =item NUM(range)
335:
336: returns the number of items in the range.
337:
338: =cut
339:
340: #-------------------------------------------------------
341: sub NUM {
342: my $mask=&mask(@_);
343: my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
344: return $num;
345: }
346:
347: #-------------------------------------------------------
348:
349: =pod
350:
351: =item BIN(low,high,lower,upper)
352:
353: =cut
354:
355: #-------------------------------------------------------
356: sub BIN {
357: my ($low,$high,$lower,$upper)=@_;
358: my $mask=&mask($lower,$upper);
359: my $num=0;
360: foreach (grep /$mask/,keys(%sheet_values)) {
361: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
362: $num++;
363: }
364: }
365: return $num;
366: }
367:
368: #-------------------------------------------------------
369:
370: =pod
371:
372: =item SUM(range)
373:
374: returns the sum of items in the range.
375:
376: =cut
377:
378: #-------------------------------------------------------
379: sub SUM {
380: my $mask=&mask(@_);
381: my $sum=0;
382: foreach (grep /$mask/,keys(%sheet_values)) {
383: $sum+=$sheet_values{$_};
384: }
385: return $sum;
386: }
387:
388: #-------------------------------------------------------
389:
390: =pod
391:
392: =item MEAN(range)
393:
394: compute the average of the items in the range.
395:
396: =cut
397:
398: #-------------------------------------------------------
399: sub MEAN {
400: my $mask=&mask(@_);
401: my $sum=0;
402: my $num=0;
403: foreach (grep /$mask/,keys(%sheet_values)) {
404: $sum+=$sheet_values{$_};
405: $num++;
406: }
407: if ($num) {
408: return $sum/$num;
409: } else {
410: return undef;
411: }
412: }
413:
414: #-------------------------------------------------------
415:
416: =pod
417:
418: =item STDDEV(range)
419:
420: compute the standard deviation of the items in the range.
421:
422: =cut
423:
424: #-------------------------------------------------------
425: sub STDDEV {
426: my $mask=&mask(@_);
427: my $sum=0; my $num=0;
428: foreach (grep /$mask/,keys(%sheet_values)) {
429: $sum+=$sheet_values{$_};
430: $num++;
431: }
432: unless ($num>1) { return undef; }
433: my $mean=$sum/$num;
434: $sum=0;
435: foreach (grep /$mask/,keys(%sheet_values)) {
436: $sum+=($sheet_values{$_}-$mean)**2;
437: }
438: return sqrt($sum/($num-1));
439: }
440:
441: #-------------------------------------------------------
442:
443: =pod
444:
445: =item PROD(range)
446:
447: compute the product of the items in the range.
448:
449: =cut
450:
451: #-------------------------------------------------------
452: sub PROD {
453: my $mask=&mask(@_);
454: my $prod=1;
455: foreach (grep /$mask/,keys(%sheet_values)) {
456: $prod*=$sheet_values{$_};
457: }
458: return $prod;
459: }
460:
461: #-------------------------------------------------------
462:
463: =pod
464:
465: =item MAX(range)
466:
467: compute the maximum of the items in the range.
468:
469: =cut
470:
471: #-------------------------------------------------------
472: sub MAX {
473: my $mask=&mask(@_);
474: my $max='-';
475: foreach (grep /$mask/,keys(%sheet_values)) {
476: unless ($max) { $max=$sheet_values{$_}; }
477: if (($sheet_values{$_}>$max) || ($max eq '-')) {
478: $max=$sheet_values{$_};
479: }
480: }
481: return $max;
482: }
483:
484: #-------------------------------------------------------
485:
486: =pod
487:
488: =item MIN(range)
489:
490: compute the minimum of the items in the range.
491:
492: =cut
493:
494: #-------------------------------------------------------
495: sub MIN {
496: my $mask=&mask(@_);
497: my $min='-';
498: foreach (grep /$mask/,keys(%sheet_values)) {
499: unless ($max) { $max=$sheet_values{$_}; }
500: if (($sheet_values{$_}<$min) || ($min eq '-')) {
501: $min=$sheet_values{$_};
502: }
503: }
504: return $min;
505: }
506:
507: #-------------------------------------------------------
508:
509: =pod
510:
511: =item SUMMAX(num,lower,upper)
512:
513: compute the sum of the largest 'num' items in the range from
514: 'lower' to 'upper'
515:
516: =cut
517:
518: #-------------------------------------------------------
519: sub SUMMAX {
520: my ($num,$lower,$upper)=@_;
521: my $mask=&mask($lower,$upper);
522: my @inside=();
523: foreach (grep /$mask/,keys(%sheet_values)) {
524: push (@inside,$sheet_values{$_});
525: }
526: @inside=sort(@inside);
527: my $sum=0; my $i;
528: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
529: $sum+=$inside[$i];
530: }
531: return $sum;
532: }
533:
534: #-------------------------------------------------------
535:
536: =pod
537:
538: =item SUMMIN(num,lower,upper)
539:
540: compute the sum of the smallest 'num' items in the range from
541: 'lower' to 'upper'
542:
543: =cut
544:
545: #-------------------------------------------------------
546: sub SUMMIN {
547: my ($num,$lower,$upper)=@_;
548: my $mask=&mask($lower,$upper);
549: my @inside=();
550: foreach (grep /$mask/,keys(%sheet_values)) {
551: $inside[$#inside+1]=$sheet_values{$_};
552: }
553: @inside=sort(@inside);
554: my $sum=0; my $i;
555: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
556: $sum+=$inside[$i];
557: }
558: return $sum;
559: }
560:
561: #-------------------------------------------------------
562:
563: =pod
564:
565: =item MINPARM(parametername)
566:
567: Returns the minimum value of the parameters matching the parametername.
568: parametername should be a string such as 'duedate'.
569:
570: =cut
571:
572: #-------------------------------------------------------
573: sub MINPARM {
574: my ($expression) = @_;
575: my $min = undef;
576: study($expression);
577: foreach $parameter (keys(%c)) {
578: next if ($parameter !~ /$expression/);
579: if ((! defined($min)) || ($min > $c{$parameter})) {
580: $min = $c{$parameter}
581: }
582: }
583: return $min;
584: }
585:
586: #-------------------------------------------------------
587:
588: =pod
589:
590: =item MAXPARM(parametername)
591:
592: Returns the maximum value of the parameters matching the input parameter name.
593: parametername should be a string such as 'duedate'.
594:
595: =cut
596:
597: #-------------------------------------------------------
598: sub MAXPARM {
599: my ($expression) = @_;
600: my $max = undef;
601: study($expression);
602: foreach $parameter (keys(%c)) {
603: next if ($parameter !~ /$expression/);
604: if ((! defined($min)) || ($max < $c{$parameter})) {
605: $max = $c{$parameter}
606: }
607: }
608: return $max;
609: }
610:
611:
612: sub calc {
613: %sheet_values = %t;
614: my $notfinished = 1;
615: my $lastcalc = '';
616: my $depth = 0;
617: while ($notfinished) {
618: $notfinished=0;
619: while (my ($cell,$value) = each(%t)) {
620: my $old=$sheet_values{$cell};
621: $sheet_values{$cell}=eval $value;
622: # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n";
623: if ($@) {
624: undef %sheet_values;
625: return $cell.': '.$@;
626: }
627: if ($sheet_values{$cell} ne $old) {
628: $notfinished=1;
629: $lastcalc=$cell;
630: }
631: }
632: # $errorlog.="------------------------------------------------";
633:
634: $depth++;
635: if ($depth>100) {
636: undef %sheet_values;
637: return $lastcalc.': Maximum calculation depth exceeded';
638: }
639: }
640: return '';
641: }
642:
643: # ------------------------------------------- End of "Inside of the safe space"
644: ENDDEFS
645: $safeeval->reval($code);
646: $self->{'safe'} = $safeeval;
647: $self->{'root'} = $self->{'safe'}->root();
648: #
649: # Place some of the %$self items into the safe space except the safe space
650: # itself
651: my $initstring = '';
652: foreach (qw/name domain type usymb cid csec coursefilename
653: cnum cdom chome uhome/) {
654: $initstring.= qq{\$$_="$self->{$_}";};
655: }
656: $self->{'safe'}->reval($initstring);
657: return $self;
658: }
659: ######################################################
660:
661: =pod
662:
663: =back
664:
665: =cut
666:
667: ######################################################
668:
669:
670: ######################################################
671:
672:
673: ######################################################
674: {
675:
676: my %memoizer;
677:
678: sub mask {
679: my ($lower,$upper)=@_;
680: my $key = $lower.'_'.$upper;
681: if (exists($memoizer{$key})) {
682: return $memoizer{$key};
683: }
684: $upper = $lower if (! defined($upper));
685: #
686: my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/);
687: my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/);
688: #
689: my $alpha='';
690: my $num='';
691: #
692: if (($la eq '*') || ($ua eq '*')) {
693: $alpha='[A-Za-z]';
694: } else {
695: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
696: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
697: $alpha='['.$la.'-'.$ua.']';
698: } else {
699: $alpha='['.$la.'-Za-'.$ua.']';
700: }
701: }
702: if (($ld eq '*') || ($ud eq '*')) {
703: $num='\d+';
704: } else {
705: if (length($ld)!=length($ud)) {
706: $num.='(';
707: foreach ($ld=~m/\d/g) {
708: $num.='['.$_.'-9]';
709: }
710: if (length($ud)-length($ld)>1) {
711: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
712: }
713: $num.='|';
714: foreach ($ud=~m/\d/g) {
715: $num.='[0-'.$_.']';
716: }
717: $num.=')';
718: } else {
719: my @lda=($ld=~m/\d/g);
720: my @uda=($ud=~m/\d/g);
721: my $i;
722: my $j=0;
723: my $notdone=1;
724: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
725: if ($lda[$i]==$uda[$i]) {
726: $num.=$lda[$i];
727: $j=$i;
728: } else {
729: $notdone=0;
730: }
731: }
732: if ($j<$#lda-1) {
733: $num.='('.$lda[$j+1];
734: for ($i=$j+2;$i<=$#lda;$i++) {
735: $num.='['.$lda[$i].'-9]';
736: }
737: if ($uda[$j+1]-$lda[$j+1]>1) {
738: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
739: ($#lda-$j-1).'}';
740: }
741: $num.='|'.$uda[$j+1];
742: for ($i=$j+2;$i<=$#uda;$i++) {
743: $num.='[0-'.$uda[$i].']';
744: }
745: $num.=')';
746: } else {
747: if ($lda[-1]!=$uda[-1]) {
748: $num.='['.$lda[-1].'-'.$uda[-1].']';
749: }
750: }
751: }
752: }
753: my $expression ='^'.$alpha.$num."\$";
754: $memoizer{$key} = $expression;
755: return $expression;
756: }
757:
758: }
759:
760: ##
761: ## sub add_hash_to_safe {} # spreadsheet, would like to destroy
762: ##
763:
764: #
765: # expandnamed used to reside in the safe space
766: #
767: sub expandnamed {
768: my $self = shift;
769: my $expression=shift;
770: if ($expression=~/^\&/) {
771: my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
772: my @vars=split(/\W+/,$formula);
773: my %values=();
774: foreach my $varname ( @vars ) {
775: if ($varname=~/\D/) {
776: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
777: $varname=~s/$var/\([\\w:\\- ]\+\)/g;
778: foreach (keys(%{$self->{'constants'}})) {
779: if ($_=~/$varname/) {
780: $values{$1}=1;
781: }
782: }
783: }
784: }
785: if ($func eq 'EXPANDSUM') {
786: my $result='';
787: foreach (keys(%values)) {
788: my $thissum=$formula;
789: $thissum=~s/$var/$_/g;
790: $result.=$thissum.'+';
791: }
792: $result=~s/\+$//;
793: return $result;
794: } else {
795: return 0;
796: }
797: } else {
798: # it is not a function, so it is a parameter name
799: # We should do the following:
800: # 1. Take the list of parameter names
801: # 2. look through the list for ones that match the parameter we want
802: # 3. If there are no collisions, return the one that matches
803: # 4. If there is a collision, return 'bad parameter name error'
804: my $returnvalue = '';
805: my @matches = ();
806: $#matches = -1;
807: study $expression;
808: my $parameter;
809: foreach $parameter (keys(%{$self->{'constants'}})) {
810: push @matches,$parameter if ($parameter =~ /$expression/);
811: }
812: if (scalar(@matches) == 0) {
813: $returnvalue = 'unmatched parameter: '.$parameter;
814: } elsif (scalar(@matches) == 1) {
815: # why do we not do this lookup here, instead of delaying it?
816: $returnvalue = '$c{\''.$matches[0].'\'}';
817: } elsif (scalar(@matches) > 0) {
818: # more than one match. Look for a concise one
819: $returnvalue = "'non-unique parameter name : $expression'";
820: foreach (@matches) {
821: if (/^$expression$/) {
822: # why do we not do this lookup here?
823: $returnvalue = '$c{\''.$_.'\'}';
824: }
825: }
826: } else {
827: # There was a negative number of matches, which indicates
828: # something is wrong with reality. Better warn the user.
829: $returnvalue = 'bizzare parameter: '.$parameter;
830: }
831: return $returnvalue;
832: }
833: }
834:
835: sub sett {
836: my $self = shift;
837: my %t=();
838: #
839: # Deal with the template row
840: foreach my $col ($self->template_cells()) {
841: next if ($col=~/^[A-Z]/);
842: foreach my $row ($self->rows()) {
843: # Get the name of this cell
844: my $cell=$col.$row;
845: # Grab the template declaration
846: $t{$cell}=$self->formula('template_'.$col);
847: # Replace '#' with the row number
848: $t{$cell}=~s/\#/$row/g;
849: # Replace '....' with ','
850: $t{$cell}=~s/\.\.+/\,/g;
851: # Replace 'A0' with the value from 'A0'
852: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
853: # Replace parameters
854: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
855: }
856: }
857: #
858: # Deal with the normal cells
859: while (my($cell,$formula) = each(%{$self->{'formulas'}})) {
860: next if ($_=~/^template\_/);
861: my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/);
862: if ($row eq '0') {
863: $t{$cell}=$formula;
864: $t{$cell}=~s/\.\.+/\,/g;
865: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
866: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
867: } elsif ( $col =~ /^[A-Z]$/ ) {
868: if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) {
869: my $data = $self->{'constants'}->{$cell};
870: $t{$cell} = $data;
871: }
872: } else { # $row > 1 and $col =~ /[a-z]
873: $t{$cell}=$formula;
874: $t{$cell}=~s/\.\.+/\,/g;
875: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
876: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
877: }
878: }
879: %{$self->{'safe'}->varglob('t')}=%t;
880: }
881:
882: ##
883: ## sync_safe_space: Called by calcsheet to make sure all the data we
884: # need to calculate is placed into the safe space
885: ##
886: sub sync_safe_space {
887: my $self = shift;
888: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
889: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
890: # 'constants' leads a peaceful hidden life of 'c'.
891: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
892: # 'othersheets' hides as 'os', a disguise few can penetrate.
893: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
894: }
895:
896: ##
897: ## Retrieve the error log from the safe space (used for debugging)
898: ##
899: sub get_errorlog {
900: my $self = shift;
901: $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') };
902: return $self->{'errorlog'};
903: }
904:
905: ##
906: ## Clear the error log inside the safe space
907: ##
908: sub clear_errorlog {
909: my $self = shift;
910: $ {$self->{'safe'}->varglob('errorlog')} = '';
911: $self->{'errorlog'} = '';
912: }
913:
914: ##
915: ## constants: either set or get the constants
916: ##
917: sub constants {
918: my $self=shift;
919: my ($constants) = @_;
920: if (defined($constants)) {
921: if (! ref($constants)) {
922: my %tmp = @_;
923: $constants = \%tmp;
924: }
925: $self->{'constants'} = $constants;
926: return;
927: } else {
928: return %{$self->{'constants'}};
929: }
930: }
931:
932: ##
933: ## formulas: either set or get the formulas
934: ##
935: sub formulas {
936: my $self=shift;
937: my ($formulas) = @_;
938: if (defined($formulas)) {
939: if (! ref($formulas)) {
940: my %tmp = @_;
941: $formulas = \%tmp;
942: }
943: $self->{'formulas'} = $formulas;
944: $self->{'rows'} = [];
945: $self->{'template_cells'} = [];
946: return;
947: } else {
948: return %{$self->{'formulas'}};
949: }
950: }
951:
952: sub set_formula {
953: my $self = shift;
954: my ($cell,$formula) = @_;
955: $self->{'formulas'}->{$cell}=$formula;
956: return;
957: }
958:
959: ##
960: ## formulas_keys: Return the keys to the formulas hash.
961: ##
962: sub formulas_keys {
963: my $self = shift;
964: my @keys = keys(%{$self->{'formulas'}});
965: return keys(%{$self->{'formulas'}});
966: }
967:
968: ##
969: ## formula: Return the formula for a given cell in the spreadsheet
970: ## returns '' if the cell does not have a formula or does not exist
971: ##
972: sub formula {
973: my $self = shift;
974: my $cell = shift;
975: if (defined($cell) && exists($self->{'formulas'}->{$cell})) {
976: return $self->{'formulas'}->{$cell};
977: }
978: return '';
979: }
980:
981: ##
982: ## logthis: write the input to lonnet.log
983: ##
984: sub logthis {
985: my $self = shift;
986: my $message = shift;
987: &Apache::lonnet::logthis($self->{'type'}.':'.
988: $self->{'name'}.':'.$self->{'domain'}.':'.
989: $message);
990: return;
991: }
992:
993: ##
994: ## dump_formulas_to_log: makes lonnet.log huge...
995: ##
996: sub dump_formulas_to_log {
997: my $self =shift;
998: $self->logthis("Spreadsheet formulas");
999: $self->logthis("--------------------------------------------------------");
1000: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) {
1001: $self->logthis(' '.$cell.' = '.$formula);
1002: }
1003: $self->logthis("--------------------------------------------------------");}
1004:
1005: ##
1006: ## value: returns the computed value of a particular cell
1007: ##
1008: sub value {
1009: my $self = shift;
1010: my $cell = shift;
1011: if (defined($cell) && exists($self->{'values'}->{$cell})) {
1012: return $self->{'values'}->{$cell};
1013: }
1014: return '';
1015: }
1016:
1017: ##
1018: ## dump_values_to_log: makes lonnet.log huge...
1019: ##
1020: sub dump_values_to_log {
1021: my $self =shift;
1022: $self->logthis("Spreadsheet Values");
1023: $self->logthis("------------------------------------------------------");
1024: while (my ($cell, $value) = each(%{$self->{'values'}})) {
1025: $self->logthis(' '.$cell.' = '.$value);
1026: }
1027: $self->logthis("------------------------------------------------------");
1028: }
1029:
1030: ##
1031: ## Yet another debugging function
1032: ##
1033: sub dump_hash_to_log {
1034: my $self= shift();
1035: my %tmp = @_;
1036: if (@_<2) {
1037: %tmp = %{$_[0]};
1038: }
1039: $self->logthis('---------------------------- (begin hash dump)');
1040: while (my ($key,$val) = each (%tmp)) {
1041: $self->logthis(' '.$key.' = '.$val.':');
1042: }
1043: $self->logthis('---------------------------- (finished hash dump)');
1044: }
1045:
1046: ##
1047: ## rebuild_stats: rebuilds the rows and template_cells arrays
1048: ##
1049: sub rebuild_stats {
1050: my $self = shift;
1051: $self->{'rows'}=[];
1052: $self->{'template_cells'}=[];
1053: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1054: push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);
1055: push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);
1056: }
1057: return;
1058: }
1059:
1060: ##
1061: ## template_cells returns a list of the cells defined in the template row
1062: ##
1063: sub template_cells {
1064: my $self = shift;
1065: $self->rebuild_stats() if (! defined($self->{'template_cells'}) ||
1066: ! @{$self->{'template_cells'}});
1067: return @{$self->{'template_cells'}};
1068: }
1069:
1070: ##
1071: ## Sigh....
1072: ##
1073: sub setothersheets {
1074: my $self = shift;
1075: my @othersheets = @_;
1076: $self->{'othersheets'} = \@othersheets;
1077: }
1078:
1079: ##
1080: ## rows returns a list of the names of cells defined in the A column
1081: ##
1082: sub rows {
1083: my $self = shift;
1084: $self->rebuild_stats() if (!@{$self->{'rows'}});
1085: return @{$self->{'rows'}};
1086: }
1087:
1088: #
1089: # calcsheet: makes all the calls to compute the spreadsheet.
1090: #
1091: sub calcsheet {
1092: my $self = shift;
1093: $self->sync_safe_space();
1094: $self->clear_errorlog();
1095: $self->sett();
1096: my $result = $self->{'safe'}->reval('&calc();');
1097: # $self->logthis($self->get_errorlog());
1098: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
1099: # $self->logthis($self->get_errorlog());
1100: return $result;
1101: }
1102:
1103: ###########################################################
1104: ##
1105: ## Output Helpers
1106: ##
1107: ###########################################################
1108: ############################################
1109: ## HTML output routines ##
1110: ############################################
1111: sub html_export_row {
1112: my $self = shift();
1113: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1114: my $row_html;
1115: my @rowdata = $self->get_row(0);
1116: foreach my $cell (@rowdata) {
1117: if ($cell->{'name'} =~ /^[A-Z]/) {
1118: $row_html .= '<td bgcolor="#CCCCFF">'.
1119: &html_editable_cell($cell,'#CCCCFF',$allowed).'</td>';
1120: } else {
1121: $row_html .= '<td bgcolor="#DDCCFF">'.
1122: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';
1123: }
1124: }
1125: return $row_html;
1126: }
1127:
1128: sub html_template_row {
1129: my $self = shift();
1130: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1131: my ($num_uneditable) = @_;
1132: my $row_html;
1133: my @rowdata = $self->get_template_row();
1134: my $count = 0;
1135: for (my $i = 0; $i<=$#rowdata; $i++) {
1136: my $cell = $rowdata[$i];
1137: if ($i < $num_uneditable) {
1138: $row_html .= '<td bgcolor="#DDCCFF">'.
1139: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';
1140: } else {
1141: $row_html .= '<td bgcolor="#EOFFDD">'.
1142: &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>';
1143: }
1144: }
1145: return $row_html;
1146: }
1147:
1148: sub html_editable_cell {
1149: my ($cell,$bgcolor,$allowed) = @_;
1150: my $result;
1151: my ($name,$formula,$value);
1152: if (defined($cell)) {
1153: $name = $cell->{'name'};
1154: $formula = $cell->{'formula'};
1155: $value = $cell->{'value'};
1156: }
1157: $name = '' if (! defined($name));
1158: $formula = '' if (! defined($formula));
1159: if (! defined($value)) {
1160: $value = '<font color="'.$bgcolor.'">#</font>';
1161: if ($formula ne '') {
1162: $value = '<i>undefined value</i>';
1163: }
1164: } elsif ($value =~ /^\s*$/ ) {
1165: $value = '<font color="'.$bgcolor.'">#</font>';
1166: } else {
1167: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1168: }
1169: return $value if (! $allowed);
1170: # Make the formula safe for outputting
1171: $formula =~ s/\'/\"/g;
1172: # The formula will be parsed by the browser twice before being
1173: # displayed to the user for editing.
1174: $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula));
1175: # Escape newlines so they make it into the edit window
1176: $formula =~ s/\n/\\n/gs;
1177: # Glue everything together
1178: $result .= "<a href=\"javascript:celledit(\'".
1179: $name."','".$formula."');\">".$value."</a>";
1180: return $result;
1181: }
1182:
1183: sub html_uneditable_cell {
1184: my ($cell,$bgcolor) = @_;
1185: my $value = (defined($cell) ? $cell->{'value'} : '');
1186: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1187: return ' '.$value.' ';
1188: }
1189:
1190: sub html_row {
1191: my $self = shift();
1192: my ($num_uneditable,$row) = @_;
1193: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1194: my @rowdata = $self->get_row($row);
1195: my $num_cols_output = 0;
1196: my $row_html;
1197: foreach my $cell (@rowdata) {
1198: if ($num_cols_output++ < $num_uneditable) {
1199: $row_html .= '<td bgcolor="#FFDDDD">';
1200: $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
1201: } else {
1202: $row_html .= '<td bgcolor="#EOFFDD">';
1203: $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed);
1204: }
1205: $row_html .= '</td>';
1206: }
1207: return $row_html;
1208: }
1209:
1210: sub create_excel_spreadsheet {
1211: my $self = shift;
1212: my ($r) = @_;
1213: my $filename = '/prtspool/'.
1214: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1215: time.'_'.rand(1000000000).'.xls';
1216: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1217: if (! defined($workbook)) {
1218: $r->log_error("Error creating excel spreadsheet $filename: $!");
1219: $r->print("Problems creating new Excel file. ".
1220: "This error has been logged. ".
1221: "Please alert your LON-CAPA administrator");
1222: return undef;
1223: }
1224: #
1225: # The excel spreadsheet stores temporary data in files, then put them
1226: # together. If needed we should be able to disable this (memory only).
1227: # The temporary directory must be specified before calling 'addworksheet'.
1228: # File::Temp is used to determine the temporary directory.
1229: $workbook->set_tempdir('/home/httpd/perl/tmp');
1230: #
1231: # Determine the name to give the worksheet
1232: return ($workbook,$filename);
1233: }
1234:
1235: ############################################
1236: ## XML output routines ##
1237: ############################################
1238: sub outsheet_xml {
1239: my $self = shift;
1240: my ($r) = @_;
1241: ## Someday XML
1242: ## Will be rendered for the user
1243: ## But not on this day
1244: my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
1245: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1246: if ($cell =~ /^template_(\d+)/) {
1247: my $col = $1;
1248: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
1249: } else {
1250: my ($row,$col) = ($cell =~ /^([A-z])(\d+)/);
1251: next if (! defined($row) || ! defined($col));
1252: $Str .= '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</cell>'
1253: ."\n";
1254: }
1255: }
1256: $Str.="</spreadsheet>";
1257: return $Str;
1258: }
1259:
1260: ############################################
1261: ### Filesystem routines ###
1262: ############################################
1263: sub parse_sheet {
1264: # $sheetxml is a scalar reference or a scalar
1265: my ($sheetxml) = @_;
1266: if (! ref($sheetxml)) {
1267: my $tmp = $sheetxml;
1268: $sheetxml = \$tmp;
1269: }
1270: my %formulas;
1271: my %sources;
1272: my $parser=HTML::TokeParser->new($sheetxml);
1273: my $token;
1274: while ($token=$parser->get_token) {
1275: if ($token->[0] eq 'S') {
1276: if ($token->[1] eq 'field') {
1277: my $cell = $token->[2]->{'col'}.$token->[2]->{'row'};
1278: my $source = $token->[2]->{'source'};
1279: my $formula = $parser->get_text('/field');
1280: $formulas{$cell} = $formula;
1281: $sources{$cell} = $source if (defined($source));
1282: $parser->get_text('/field');
1283: }
1284: if ($token->[1] eq 'template') {
1285: $formulas{'template_'.$token->[2]->{'col'}}=
1286: $parser->get_text('/template');
1287: }
1288: }
1289: }
1290: return (\%formulas,\%sources);
1291: }
1292:
1293: {
1294:
1295: my %spreadsheets;
1296:
1297: sub clear_spreadsheet_definition_cache {
1298: undef(%spreadsheets);
1299: }
1300:
1301: sub load {
1302: my $self = shift;
1303: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
1304: #
1305: my $stype = $self->{'type'};
1306: my $cnum = $self->{'cnum'};
1307: my $cdom = $self->{'cdom'};
1308: my $chome = $self->{'chome'};
1309: my $filename = $self->{'filename'};
1310: #
1311: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1312: #
1313: # see if sheet is cached
1314: my ($formulas);
1315: if (exists($spreadsheets{$cachekey})) {
1316: $formulas = $spreadsheets{$cachekey}->{'formulas'};
1317: } else {
1318: # Not cached, need to read
1319: if (! defined($self->filename())) {
1320: # load in the default defined spreadsheet
1321: my $sheetxml='';
1322: my $fh;
1323: if ($fh=Apache::File->new($includedir.'/default.'.$filename)) {
1324: $sheetxml=join('',<$fh>);
1325: $fh->close();
1326: } else {
1327: # $sheetxml='<field row="0" col="A">"Error"</field>';
1328: $sheetxml='<field row="0" col="A"></field>';
1329: }
1330: ($formulas,undef) = &parse_sheet(\$sheetxml);
1331: } elsif($self->filename() =~ /^\/*\.spreadsheet$/) {
1332: # Load a spreadsheet definition file
1333: my $sheetxml=&Apache::lonnet::getfile
1334: (&Apache::lonnet::filelocation('',$filename));
1335: if ($sheetxml == -1) {
1336: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1337: .$self->filename().'"</field>';
1338: }
1339: ($formulas,undef) = &parse_sheet(\$sheetxml);
1340: } else {
1341: # Load the spreadsheet definition file from the save file
1342: my %tmphash = &Apache::lonnet::dump($self->filename(),$cdom,$cnum);
1343: my ($tmp) = keys(%tmphash);
1344: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
1345: while (my ($cell,$formula) = each(%tmphash)) {
1346: $formulas->{$cell}=$formula;
1347: }
1348: } else {
1349: # Unable to grab the specified spreadsheet,
1350: # so we get the default ones instead.
1351: $filename = 'default.'.$stype;
1352: $self->filename($filename);
1353: my $sheetxml;
1354: if (my $fh=Apache::File->new($includedir.'/'.$filename)) {
1355: $sheetxml = join('',<$fh>);
1356: $fh->close();
1357: } else {
1358: $sheetxml='<field row="0" col="A">'.
1359: '"Unable to load spreadsheet"</field>';
1360: }
1361: ($formulas,undef) = &parse_sheet(\$sheetxml);
1362: $self->formulas($formulas);
1363: }
1364: }
1365: $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1366: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
1367: }
1368: $self->formulas($formulas);
1369: $self->set_row_sources();
1370: $self->set_row_numbers();
1371: }
1372:
1373: sub set_row_sources {
1374: my $self = shift;
1375: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1376: next if ($cell !~ /^A(\d+)/ && $1 > 0);
1377: my $row = $1;
1378: $self->{'row_source'}->{$row} = $value;
1379: }
1380: return;
1381: }
1382:
1383: ##
1384: ## exportrow is *not* used to get the export row from a computed sub-sheet.
1385: ##
1386: sub exportrow {
1387: my $self = shift;
1388: my @exportarray;
1389: foreach my $column (@UC_Columns) {
1390: push(@exportarray,$self->value($column.'0'));
1391: }
1392: return @exportarray;
1393: }
1394:
1395: sub save {
1396: my $self = shift;
1397: my ($makedef)=@_;
1398: my $cid=$self->{'cid'};
1399: if (&Apache::lonnet::allowed('opa',$cid)) {
1400: my %f=$self->formulas();
1401: my $stype = $self->{'type'};
1402: my $cnum = $self->{'cnum'};
1403: my $cdom = $self->{'cdom'};
1404: my $chome = $self->{'chome'};
1405: my $fn = $self->{'filename'};
1406: # Cache new sheet
1407: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1408: # Write sheet
1409: foreach (keys(%f)) {
1410: delete($f{$_}) if ($f{$_} eq 'import');
1411: }
1412: my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum);
1413: return $reply if ($reply ne 'ok');
1414: $reply = &Apache::lonnet::put($stype.'_spreadsheets',
1415: {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
1416: $cdom,$cnum);
1417: return $reply if ($reply ne 'ok');
1418: if ($makedef) {
1419: $reply = &Apache::lonnet::put('environment',
1420: {'spreadsheet_default_'.$stype => $fn },
1421: $cdom,$cnum);
1422: return $reply if ($reply ne 'ok');
1423: }
1424: if ($self->is_default()) {
1425: &Apache::lonnet::expirespread('','',$self->{'type'},'');
1426: }
1427: return $reply;
1428: }
1429: return 'unauthorized';
1430: }
1431:
1432: } # end of scope for %spreadsheets
1433:
1434: sub save_tmp {
1435: my $self = shift;
1436: my $fn=$ENV{'user.name'}.'_'.
1437: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'.
1438: $self->{'filename'};
1439: $fn=~s/\W/\_/g;
1440: $fn=$Apache::lonnet::tmpdir.$fn.'.tmp';
1441: my $fh;
1442: if ($fh=Apache::File->new('>'.$fn)) {
1443: my %f = $self->formulas();
1444: while( my ($cell,$formula) = each(%f)) {
1445: next if ($formula eq 'import');
1446: print $fh &Apache::lonnet::escape($cell)."=".
1447: &Apache::lonnet::escape($formula)."\n";
1448: }
1449: $fh->close();
1450: }
1451: }
1452:
1453: sub load_tmp {
1454: my $self = shift;
1455: my $filename=$ENV{'user.name'}.'_'.
1456: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'.
1457: $self->{'filename'};
1458: $filename=~s/\W/\_/g;
1459: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1460: my %formulas = ();
1461: if (my $spreadsheet_file = Apache::File->new($filename)) {
1462: while (<$spreadsheet_file>) {
1463: chomp;
1464: my ($cell,$formula) = split(/=/);
1465: $cell = &Apache::lonnet::unescape($cell);
1466: $formula = &Apache::lonnet::unescape($formula);
1467: $formulas{$cell} = $formula;
1468: }
1469: $spreadsheet_file->close();
1470: }
1471: $self->formulas(\%formulas);
1472: $self->set_row_sources();
1473: $self->set_row_numbers();
1474: return;
1475: }
1476:
1477: sub modify_cell {
1478: # studentcalc overrides this
1479: my $self = shift;
1480: my ($cell,$formula) = @_;
1481: if ($cell =~ /([A-z])\-/) {
1482: $cell = 'template_'.$1;
1483: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) {
1484: return;
1485: }
1486: $self->set_formula($cell,$formula);
1487: $self->rebuild_stats();
1488: return;
1489: }
1490:
1491: ###########################################
1492: # othersheets: Returns the list of other spreadsheets available
1493: ###########################################
1494: sub othersheets {
1495: my $self = shift();
1496: my ($stype) = @_;
1497: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/);
1498: #
1499: my @alternatives=();
1500: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',
1501: $self->{'cdom'}, $self->{'cnum'});
1502: my ($tmp) = keys(%results);
1503: unless ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
1504: @alternatives = sort (keys(%results));
1505: }
1506: return @alternatives;
1507: }
1508:
1509: sub get_row {
1510: my $self = shift;
1511: my ($n)=@_;
1512: my @cols=();
1513: foreach my $col (@UC_Columns,@LC_Columns) {
1514: my $cell = $col.$n;
1515: push(@cols,{ name => $cell,
1516: formula => $self->formula($cell),
1517: value => $self->value($cell)});
1518: }
1519: return @cols;
1520: }
1521:
1522: sub get_template_row {
1523: my $self = shift;
1524: my @cols=();
1525: foreach my $col (@UC_Columns,@LC_Columns) {
1526: my $cell = 'template_'.$col;
1527: push(@cols,{ name => $cell,
1528: formula => $self->formula($cell),
1529: value => $self->formula($cell) });
1530: }
1531: return @cols;
1532: }
1533:
1534: sub set_row_numbers {
1535: my $self = shift;
1536: my %f=$self->formulas();
1537: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1538: next if ($cell !~ /^A(\d+)$/);
1539: next if (! defined($value));
1540: $self->{'row_numbers'}->{$value} = $1;
1541: }
1542: }
1543:
1544: sub get_row_number_from_key {
1545: my $self = shift;
1546: my ($key) = @_;
1547: if (! exists($self->{'row_numbers'}->{$key}) ||
1548: ! defined($self->{'row_numbers'}->{$key})) {
1549: # I used to set $f here to the new value, but the key passed for lookup
1550: # may not be the key we need to save
1551: $self->{'maxrow'}++;
1552: $self->{'row_numbers'}->{$key} = $self->{'maxrow'};
1553: }
1554: return $self->{'row_numbers'}->{$key};
1555: }
1556:
1557: 1;
1558:
1559: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>