Annotation of loncom/interface/spreadsheet/Spreadsheet.pm, revision 1.2
1.1 matthew 1: #
1.2 ! matthew 2: # $Id: Spreadsheet.pm,v 1.1 2003/05/16 20:55:11 matthew Exp $
1.1 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: #
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);
1.2 ! matthew 1503: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
! 1504: @alternatives = ('Default');
! 1505: } else {
1.1 matthew 1506: @alternatives = sort (keys(%results));
1507: }
1508: return @alternatives;
1509: }
1510:
1511: sub get_row {
1512: my $self = shift;
1513: my ($n)=@_;
1514: my @cols=();
1515: foreach my $col (@UC_Columns,@LC_Columns) {
1516: my $cell = $col.$n;
1517: push(@cols,{ name => $cell,
1518: formula => $self->formula($cell),
1519: value => $self->value($cell)});
1520: }
1521: return @cols;
1522: }
1523:
1524: sub get_template_row {
1525: my $self = shift;
1526: my @cols=();
1527: foreach my $col (@UC_Columns,@LC_Columns) {
1528: my $cell = 'template_'.$col;
1529: push(@cols,{ name => $cell,
1530: formula => $self->formula($cell),
1531: value => $self->formula($cell) });
1532: }
1533: return @cols;
1534: }
1535:
1536: sub set_row_numbers {
1537: my $self = shift;
1538: my %f=$self->formulas();
1539: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1540: next if ($cell !~ /^A(\d+)$/);
1541: next if (! defined($value));
1542: $self->{'row_numbers'}->{$value} = $1;
1543: }
1544: }
1545:
1546: sub get_row_number_from_key {
1547: my $self = shift;
1548: my ($key) = @_;
1549: if (! exists($self->{'row_numbers'}->{$key}) ||
1550: ! defined($self->{'row_numbers'}->{$key})) {
1551: # I used to set $f here to the new value, but the key passed for lookup
1552: # may not be the key we need to save
1553: $self->{'maxrow'}++;
1554: $self->{'row_numbers'}->{$key} = $self->{'maxrow'};
1555: }
1556: return $self->{'row_numbers'}->{$key};
1557: }
1558:
1559: 1;
1560:
1561: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Spreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface / spreadsheet