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