1: #
2: # $Id: Spreadsheet.pm,v 1.33 2004/01/14 16:47:39 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 warnings FATAL=>'all';
52: #no warnings 'uninitialized';
53: use Apache::Constants qw(:common :http);
54: use Apache::lonnet;
55: use Safe;
56: use Safe::Hole;
57: use Opcode;
58: use HTML::Entities();
59: use HTML::TokeParser;
60: use Spreadsheet::WriteExcel;
61: use Time::HiRes;
62: use Apache::lonlocal;
63:
64: ##
65: ## Package Variables
66: ##
67: my %expiredates;
68:
69: my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
70: my @LC_Columns = split(//,'abcdefghijklmnopqrstuvwxyz');
71:
72: ######################################################
73:
74: =pod
75:
76: =item &new
77:
78: Returns a new spreadsheet object.
79:
80: =cut
81:
82: ######################################################
83: sub new {
84: my $this = shift;
85: my $class = ref($this) || $this;
86: my ($stype) = ($class =~ /Apache::(.*)$/);
87: #
88: my ($name,$domain,$filename,$usymb)=@_;
89: #
90: my $self = {
91: name => $name,
92: domain => $domain,
93: type => $stype,
94: symb => $usymb,
95: errorlog => '',
96: maxrow => 0,
97: cid => $ENV{'request.course.id'},
98: cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
99: cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
100: chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},
101: coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},
102: coursefilename => $ENV{'request.course.fn'},
103: #
104: # Flags
105: temporary => 0, # true if this sheet has been modified but not saved
106: new_rows => 0, # true if this sheet has new rows
107: #
108: # blackout is used to determine if any data needs to be hidden from the
109: # student.
110: blackout => 0,
111: #
112: # Data storage
113: formulas => {},
114: constants => {},
115: rows => [],
116: row_source => {},
117: othersheets => [],
118: };
119: #
120: $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain);
121: #
122: bless($self,$class);
123: #
124: # Load in the spreadsheet definition
125: $self->filename($filename);
126: if (exists($ENV{'form.workcopy'}) &&
127: $self->{'type'} eq $ENV{'form.workcopy'}) {
128: $self->load_tmp();
129: } else {
130: $self->load();
131: }
132: return $self;
133: }
134:
135: ######################################################
136:
137: =pod
138:
139: =item &filename
140:
141: get or set the filename for a spreadsheet.
142:
143: =cut
144:
145: ######################################################
146: sub filename {
147: my $self = shift();
148: if (@_) {
149: my ($newfilename) = @_;
150: if (! defined($newfilename) || $newfilename eq 'Default' ||
151: $newfilename !~ /\w/ || $newfilename eq '') {
152: my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.
153: $self->{'type'};
154: if (exists($ENV{$key}) && $ENV{$key} ne '') {
155: $newfilename = $ENV{$key};
156: } else {
157: $newfilename = 'default_'.$self->{'type'};
158: }
159: }
160: if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) {
161: $newfilename = 'default_'.$self->{'type'};
162: }
163: if ($newfilename !~ /^default\.$self->{'type'}$/ &&
164: $newfilename !~ /^\/res\/(.*)spreadsheet$/) {
165: if ($newfilename !~ /_$self->{'type'}$/) {
166: $newfilename =~ s/[\s_]*$//;
167: $newfilename .= '_'.$self->{'type'};
168: }
169: }
170: $self->{'filename'} = $newfilename;
171: return;
172: }
173: return $self->{'filename'};
174: }
175:
176: ######################################################
177:
178: =pod
179:
180: =item &make_default()
181:
182: Make the current spreadsheet file the default for the course. Expires all the
183: default spreadsheets.......!
184:
185: =cut
186:
187: ######################################################
188: sub make_default {
189: my $self = shift();
190: my $result = &Apache::lonnet::put('environment',
191: {'spreadsheet_default_'.$self->{'type'} => $self->filename()},
192: $self->{'cdom'},$self->{'cnum'});
193: return $result if ($result ne 'ok');
194: my $symb = $self->{'symb'};
195: $symb = '' if (! defined($symb));
196: &Apache::lonnet::expirespread('','',$self->{'type'},$symb);
197: }
198:
199: ######################################################
200:
201: =pod
202:
203: =item &is_default()
204:
205: Returns 1 if the current spreadsheet is the default as specified in the
206: course environment. Returns 0 otherwise.
207:
208: =cut
209:
210: ######################################################
211: sub is_default {
212: my $self = shift;
213: # Check to find out if we are the default spreadsheet (filenames match)
214: my $default_filename = '';
215: my %tmphash = &Apache::lonnet::get('environment',
216: ['spreadsheet_default_'.
217: $self->{'type'}],
218: $self->{'cdom'},
219: $self->{'cnum'});
220: my ($tmp) = keys(%tmphash);
221: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
222: $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}};
223: }
224: if ($default_filename =~ /^\s*$/) {
225: $default_filename = 'default_'.$self->{'type'};
226: }
227: return 1 if ($self->filename() eq $default_filename);
228: return 0;
229: }
230:
231: sub initialize {
232: # This method is here to remind you that it will be overridden by
233: # the descendents of the spreadsheet class.
234: }
235:
236: sub clear_package {
237: # This method is here to remind you that it will be overridden by
238: # the descendents of the spreadsheet class.
239: }
240:
241: sub cleanup {
242: my $self = shift();
243: $self->clear_package();
244: }
245:
246: sub initialize_spreadsheet_package {
247: &load_spreadsheet_expirationdates();
248: &clear_spreadsheet_definition_cache();
249: }
250:
251: sub load_spreadsheet_expirationdates {
252: undef %expiredates;
253: my $cid=$ENV{'request.course.id'};
254: my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
255: $ENV{'course.'.$cid.'.domain'},
256: $ENV{'course.'.$cid.'.num'});
257: if (lc($tmp[0]) !~ /^error/){
258: %expiredates = @tmp;
259: }
260: }
261:
262: sub check_expiration_time {
263: my $self = shift;
264: my ($time)=@_;
265: return 0 if (! defined($time));
266: my ($key1,$key2,$key3,$key4,$key5);
267: # Description of keys
268: #
269: # key1: all sheets of this type have expired
270: # key2: all sheets of this type for this student
271: # key3: all sheets of this type in this map for this student
272: # key4: this assessment sheet for this student
273: # key5: this assessment sheet for all students
274: $key1 = '::'.$self->{'type'}.':';
275: $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
276: $key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
277: $key4 = $key2.$self->{'symb'} if (defined($self->{'symb'}));
278: $key5 = $key1.$self->{'symb'} if (defined($self->{'symb'}));
279: my $returnvalue = 1; # default to okay
280: foreach my $key ($key1,$key2,$key3,$key4,$key5) {
281: next if (! defined($key));
282: if (exists($expiredates{$key}) && $expiredates{$key} > $time) {
283: $returnvalue = 0; # need to recompute
284: }
285: }
286: return $returnvalue;
287: }
288:
289: ######################################################
290:
291: =pod
292:
293: =item &initialize_safe_space
294:
295: Returns the safe space required by a Spreadsheet object.
296:
297: =head 2 Safe Space Functions
298:
299: =over 4
300:
301: =cut
302:
303: ######################################################
304: {
305:
306: my $safeeval;
307:
308: sub initialize_safe_space {
309: my $self = shift;
310: if (! defined($safeeval)) {
311: $safeeval = new Safe(shift);
312: my $safehole = new Safe::Hole;
313: $safeeval->permit("entereval");
314: $safeeval->permit(":base_math");
315: $safeeval->permit("sort");
316: $safeeval->deny(":base_io");
317: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
318: $safehole->wrap(\&mask,$safeeval,'&mask');
319: $safeeval->share('$@');
320: my $code=<<'ENDDEFS';
321: # ---------------------------------------------------- Inside of the safe space
322: #
323: # f: formulas
324: # t: intermediate format (variable references expanded)
325: # v: output values
326: # c: preloaded constants (A-column)
327: # rl: row label
328: # os: other spreadsheets (for student spreadsheet only)
329: undef %sheet_values; # Holds the (computed, final) values for the sheet
330: # This is only written to by &calc, the spreadsheet computation routine.
331: # It is read by many functions
332: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,
333: # which does the translation of strings like C5 into the value in C5.
334: # Used in &calc - %t holds the values that are actually eval'd.
335: undef %f; # Holds the formulas for each cell. This is the users
336: # (spreadsheet authors) data for each cell.
337: undef %c; # Holds the constants for a sheet. In the assessment
338: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed,
339: # &sett, and &constants. There is no &getconstants.
340: # &constants is called by &loadstudent, &loadcourse, &load assessment,
341: undef @os; # Holds the names of other spreadsheets - this is used to specify
342: # the spreadsheets that are available for the assessment sheet.
343: # Set by &setothersheets. &setothersheets is called by &handler. A
344: # related subroutine is &othersheets.
345: $errorlog = '';
346: #
347: $maxrow = 0;
348: $type = '';
349: #
350: # filename/reference of the sheet
351: $filename = '';
352: #
353: # user data
354: $name = '';
355: $uhome = '';
356: $domain = '';
357: #
358: # course data
359: $csec = '';
360: $chome= '';
361: $cnum = '';
362: $cdom = '';
363: $cid = '';
364: $coursefilename = '';
365: #
366: # symb
367: $usymb = '';
368: #
369: # error messages
370: $errormsg = '';
371: #
372: #-------------------------------------------------------
373:
374: =pod
375:
376: =item NUM(range)
377:
378: returns the number of items in the range.
379:
380: =cut
381:
382: #-------------------------------------------------------
383: sub NUM {
384: my $mask=&mask(@_);
385: my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
386: return $num;
387: }
388:
389: #-------------------------------------------------------
390:
391: =pod
392:
393: =item BIN(low,high,lower,upper)
394:
395: =cut
396:
397: #-------------------------------------------------------
398: sub BIN {
399: my ($low,$high,$lower,$upper)=@_;
400: my $mask=&mask($lower,$upper);
401: my $num=0;
402: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
403: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
404: $num++;
405: }
406: }
407: return $num;
408: }
409:
410: #-------------------------------------------------------
411:
412: =pod
413:
414: =item SUM(range)
415:
416: returns the sum of items in the range.
417:
418: =cut
419:
420: #-------------------------------------------------------
421: sub SUM {
422: my $mask=&mask(@_);
423: my $sum=0;
424: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
425: $sum+=$sheet_values{$_};
426: }
427: return $sum;
428: }
429:
430: #-------------------------------------------------------
431:
432: =pod
433:
434: =item MEAN(range)
435:
436: compute the average of the items in the range.
437:
438: =cut
439:
440: #-------------------------------------------------------
441: sub MEAN {
442: my $mask=&mask(@_);
443: my $sum=0;
444: my $num=0;
445: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
446: $sum+=$sheet_values{$_};
447: $num++;
448: }
449: if ($num) {
450: return $sum/$num;
451: } else {
452: return undef;
453: }
454: }
455:
456: #-------------------------------------------------------
457:
458: =pod
459:
460: =item STDDEV(range)
461:
462: compute the standard deviation of the items in the range.
463:
464: =cut
465:
466: #-------------------------------------------------------
467: sub STDDEV {
468: my $mask=&mask(@_);
469: my $sum=0; my $num=0;
470: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
471: $sum+=$sheet_values{$_};
472: $num++;
473: }
474: unless ($num>1) { return undef; }
475: my $mean=$sum/$num;
476: $sum=0;
477: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
478: $sum+=($sheet_values{$_}-$mean)**2;
479: }
480: return sqrt($sum/($num-1));
481: }
482:
483: #-------------------------------------------------------
484:
485: =pod
486:
487: =item PROD(range)
488:
489: compute the product of the items in the range.
490:
491: =cut
492:
493: #-------------------------------------------------------
494: sub PROD {
495: my $mask=&mask(@_);
496: my $prod=1;
497: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
498: $prod*=$sheet_values{$_};
499: }
500: return $prod;
501: }
502:
503: #-------------------------------------------------------
504:
505: =pod
506:
507: =item MAX(range)
508:
509: compute the maximum of the items in the range.
510:
511: =cut
512:
513: #-------------------------------------------------------
514: sub MAX {
515: my $mask=&mask(@_);
516: my $max='-';
517: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
518: unless ($max) { $max=$sheet_values{$_}; }
519: if (($sheet_values{$_}>$max) || ($max eq '-')) {
520: $max=$sheet_values{$_};
521: }
522: }
523: return $max;
524: }
525:
526: #-------------------------------------------------------
527:
528: =pod
529:
530: =item MIN(range)
531:
532: compute the minimum of the items in the range.
533:
534: =cut
535:
536: #-------------------------------------------------------
537: sub MIN {
538: my $mask=&mask(@_);
539: my $min='-';
540: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
541: unless ($max) { $max=$sheet_values{$_}; }
542: if (($sheet_values{$_}<$min) || ($min eq '-')) {
543: $min=$sheet_values{$_};
544: }
545: }
546: return $min;
547: }
548:
549: #-------------------------------------------------------
550:
551: =pod
552:
553: =item SUMMAX(num,lower,upper)
554:
555: compute the sum of the largest 'num' items in the range from
556: 'lower' to 'upper'
557:
558: =cut
559:
560: #-------------------------------------------------------
561: sub SUMMAX {
562: my ($num,$lower,$upper)=@_;
563: my $mask=&mask($lower,$upper);
564: my @inside=();
565: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
566: push (@inside,$sheet_values{$_});
567: }
568: @inside=sort(@inside);
569: my $sum=0; my $i;
570: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
571: $sum+=$inside[$i];
572: }
573: return $sum;
574: }
575:
576: #-------------------------------------------------------
577:
578: =pod
579:
580: =item SUMMIN(num,lower,upper)
581:
582: compute the sum of the smallest 'num' items in the range from
583: 'lower' to 'upper'
584:
585: =cut
586:
587: #-------------------------------------------------------
588: sub SUMMIN {
589: my ($num,$lower,$upper)=@_;
590: my $mask=&mask($lower,$upper);
591: my @inside=();
592: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
593: $inside[$#inside+1]=$sheet_values{$_};
594: }
595: @inside=sort(@inside);
596: my $sum=0; my $i;
597: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
598: $sum+=$inside[$i];
599: }
600: return $sum;
601: }
602:
603: #-------------------------------------------------------
604:
605: =pod
606:
607: =item MINPARM(parametername)
608:
609: Returns the minimum value of the parameters matching the parametername.
610: parametername should be a string such as 'duedate'.
611:
612: =cut
613:
614: #-------------------------------------------------------
615: sub MINPARM {
616: my ($expression) = @_;
617: my $min = undef;
618: study($expression);
619: foreach $parameter (keys(%c)) {
620: next if ($parameter !~ /$expression/);
621: if ((! defined($min)) || ($min > $c{$parameter})) {
622: $min = $c{$parameter}
623: }
624: }
625: return $min;
626: }
627:
628: #-------------------------------------------------------
629:
630: =pod
631:
632: =item MAXPARM(parametername)
633:
634: Returns the maximum value of the parameters matching the input parameter name.
635: parametername should be a string such as 'duedate'.
636:
637: =cut
638:
639: #-------------------------------------------------------
640: sub MAXPARM {
641: my ($expression) = @_;
642: my $max = undef;
643: study($expression);
644: foreach $parameter (keys(%c)) {
645: next if ($parameter !~ /$expression/);
646: if ((! defined($min)) || ($max < $c{$parameter})) {
647: $max = $c{$parameter}
648: }
649: }
650: return $max;
651: }
652:
653:
654: sub calc {
655: %sheet_values = %t;
656: my $notfinished = 1;
657: my $lastcalc = '';
658: my $depth = 0;
659: while ($notfinished) {
660: $notfinished=0;
661: while (my ($cell,$value) = each(%t)) {
662: my $old=$sheet_values{$cell};
663: $sheet_values{$cell}=eval $value;
664: # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n";
665: if ($@) {
666: undef %sheet_values;
667: return $cell.': '.$@;
668: }
669: if ($sheet_values{$cell} ne $old) {
670: $notfinished=1;
671: $lastcalc=$cell;
672: }
673: }
674: # $errorlog.="------------------------------------------------";
675:
676: $depth++;
677: if ($depth>100) {
678: undef %sheet_values;
679: return $lastcalc.': Maximum calculation depth exceeded';
680: }
681: }
682: return 'okay';
683: }
684:
685: # ------------------------------------------- End of "Inside of the safe space"
686: ENDDEFS
687: $safeeval->reval($code);
688: }
689: $self->{'safe'} = $safeeval;
690: $self->{'root'} = $self->{'safe'}->root();
691: #
692: # Place some of the %$self items into the safe space except the safe space
693: # itself
694: my $initstring = '';
695: foreach (qw/name domain type usymb cid csec coursefilename
696: cnum cdom chome uhome/) {
697: $initstring.= qq{\$$_="$self->{$_}";};
698: }
699: $self->{'safe'}->reval($initstring);
700: return $self;
701: }
702:
703: }
704:
705: ######################################################
706:
707: =pod
708:
709: =back
710:
711: =cut
712:
713: ######################################################
714:
715:
716: ######################################################
717:
718: =pod
719:
720: =item &mask($lower,$upper)
721:
722: Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").
723:
724: Returns: Regular expression matching spreadsheet cells that are within
725: the rectangle defined by $lower and $upper. Due to the nature of the
726: regular expression this result must be used inside an eval().
727:
728: =cut
729:
730: ######################################################
731: {
732:
733: my %memoizer;
734:
735: sub mask {
736: my ($lower,$upper)=@_;
737: my $key = $lower.'_'.$upper;
738: if (exists($memoizer{$key})) {
739: return $memoizer{$key};
740: }
741: $upper = $lower if (! defined($upper));
742: #
743: my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);
744: my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);
745: #
746: my $alpha='';
747: my $num='';
748: #
749: # Do not put parenthases around $alpha.
750: # $num depends on the value in $1.
751: if (($la eq '*') || ($ua eq '*')) {
752: $alpha='[A-z]';
753: } else {
754: if ($la gt $ua) {
755: my $tmp = $ua;
756: $ua = $la;
757: $la = $ua;
758: }
759: $alpha=qq/[$la-$ua]/;
760: }
761: if ($ld ne '*' && $ud ne '*') {
762: # Make sure $ld <= $ud
763: if ($ld > $ud) {
764: my $tmp = $ud;
765: $ud = $ld;
766: $ld = $tmp;
767: }
768: # Here we make a regular expression using some advanced regexp
769: # abilities.
770: # (\d+) will match the digits of the cell name and dump them in
771: # to $1
772: # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will
773: # choose pattern_if_true if { ... code ... } is true and
774: # pattern_if_false if { ... code ... } is false.
775: # In this case, pattern_if_true is empty. pattern_if_false is
776: # 'donotmatch' and will not match our cells because none of
777: # them end with donotmatch.
778: # Unfortunately, the use of this type of regular expression
779: # requires that each match be wrapped in an eval(). Search for
780: # $mask in this module for examples
781: $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)';
782: } else {
783: $num = '(\d+)';
784: }
785: my $expression = '^'.$alpha.$num.'$';
786: $memoizer{$key} = $expression;
787: return $expression;
788: }
789:
790: #
791: # Debugging routine
792: sub dump_memoized_values {
793: while (my ($key,$value) = each(%memoizer)) {
794: &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value);
795: }
796: return;
797: }
798:
799: }
800:
801: ##
802: ## sub add_hash_to_safe {} # spreadsheet, would like to destroy
803: ##
804:
805: #
806: # expandnamed used to reside in the safe space
807: #
808: sub expandnamed {
809: my $self = shift;
810: my $expression=shift;
811: if ($expression=~/^\&/) {
812: my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
813: my @vars=split(/\W+/,$formula);
814: my %values=();
815: foreach my $varname ( @vars ) {
816: if ($varname=~/^(parameter|stores|timestamp)/) {
817: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
818: $varname=~s/$var/\([\\w:\\- ]\+\)/g;
819: foreach (keys(%{$self->{'constants'}})) {
820: if ($_=~/$varname/) {
821: $values{$1}=1;
822: }
823: }
824: }
825: }
826: if ($func eq 'EXPANDSUM') {
827: my $result='';
828: foreach (keys(%values)) {
829: my $thissum=$formula;
830: $thissum=~s/$var/$_/g;
831: $result.=$thissum.'+';
832: }
833: $result=~s/\+$//;
834: return $result;
835: } else {
836: return 0;
837: }
838: } else {
839: # it is not a function, so it is a parameter name
840: # We should do the following:
841: # 1. Take the list of parameter names
842: # 2. look through the list for ones that match the parameter we want
843: # 3. If there are no collisions, return the one that matches
844: # 4. If there is a collision, return 'bad parameter name error'
845: my $returnvalue = '';
846: my @matches = ();
847: my @values = ();
848: $#matches = -1;
849: study $expression;
850: while (my($parameter,$value) = each(%{$self->{'constants'}})) {
851: next if ($parameter !~ /$expression/);
852: push(@matches,$parameter);
853: push(@values,$value);
854: }
855: if (scalar(@matches) == 0) {
856: $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';
857: } elsif (scalar(@matches) == 1) {
858: # why do we not do this lookup here, instead of delaying it?
859: $returnvalue = $values[0];
860: } elsif (scalar(@matches) > 0) {
861: # more than one match. Look for a concise one
862: $returnvalue = "'non-unique parameter name : $expression'";
863: for (my $i=0; $i<=$#matches;$i++) {
864: if ($matches[$i] =~ /^$expression$/) {
865: # why do we not do this lookup here?
866: $returnvalue = $values[$i];
867: }
868: }
869: } else {
870: # There was a negative number of matches, which indicates
871: # something is wrong with reality. Better warn the user.
872: $returnvalue = '"bizzare parameter: '.$expression.'"';
873: }
874: return $returnvalue;
875: }
876: }
877:
878: sub sett {
879: my $self = shift;
880: my %t=();
881: #
882: # Deal with the template row
883: foreach my $col ($self->template_cells()) {
884: next if ($col=~/^[A-Z]/);
885: foreach my $row ($self->rows()) {
886: # Get the name of this cell
887: my $cell=$col.$row;
888: # Grab the template declaration
889: $t{$cell}=$self->formula('template_'.$col);
890: # Replace '#' with the row number
891: $t{$cell}=~s/\#/$row/g;
892: # Replace '....' with ','
893: $t{$cell}=~s/\.\.+/\,/g;
894: # Replace 'A0' with the value from 'A0'
895: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
896: # Replace parameters
897: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
898: }
899: }
900: #
901: # Deal with the normal cells
902: while (my($cell,$formula) = each(%{$self->{'formulas'}})) {
903: next if ($_=~/^template\_/);
904: my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/);
905: if ($row eq '0') {
906: $t{$cell}=$formula;
907: $t{$cell}=~s/\.\.+/\,/g;
908: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
909: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
910: } elsif ( $col =~ /^[A-Z]$/ ) {
911: if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) {
912: my $data = $self->{'constants'}->{$cell};
913: $t{$cell} = $data;
914: }
915: } else { # $row > 1 and $col =~ /[a-z]
916: $t{$cell}=$formula;
917: $t{$cell}=~s/\.\.+/\,/g;
918: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
919: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
920: }
921: }
922: %{$self->{'safe'}->varglob('t')}=%t;
923: }
924:
925: ##
926: ## sync_safe_space: Called by calcsheet to make sure all the data we
927: # need to calculate is placed into the safe space
928: ##
929: sub sync_safe_space {
930: my $self = shift;
931: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
932: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
933: # 'constants' leads a peaceful hidden life of 'c'.
934: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
935: # 'othersheets' hides as 'os', a disguise few can penetrate.
936: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
937: }
938:
939: ##
940: ## Retrieve the error log from the safe space (used for debugging)
941: ##
942: sub get_errorlog {
943: my $self = shift;
944: $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') };
945: return $self->{'errorlog'};
946: }
947:
948: ##
949: ## Clear the error log inside the safe space
950: ##
951: sub clear_errorlog {
952: my $self = shift;
953: $ {$self->{'safe'}->varglob('errorlog')} = '';
954: $self->{'errorlog'} = '';
955: }
956:
957: ##
958: ## constants: either set or get the constants
959: ##
960: sub constants {
961: my $self=shift;
962: my ($constants) = @_;
963: if (defined($constants)) {
964: if (! ref($constants)) {
965: my %tmp = @_;
966: $constants = \%tmp;
967: }
968: $self->{'constants'} = $constants;
969: return;
970: } else {
971: return %{$self->{'constants'}};
972: }
973: }
974:
975: ##
976: ## formulas: either set or get the formulas
977: ##
978: sub formulas {
979: my $self=shift;
980: my ($formulas) = @_;
981: if (defined($formulas)) {
982: if (! ref($formulas)) {
983: my %tmp = @_;
984: $formulas = \%tmp;
985: }
986: $self->{'formulas'} = $formulas;
987: $self->{'rows'} = [];
988: $self->{'template_cells'} = [];
989: return;
990: } else {
991: return %{$self->{'formulas'}};
992: }
993: }
994:
995: sub set_formula {
996: my $self = shift;
997: my ($cell,$formula) = @_;
998: $self->{'formulas'}->{$cell}=$formula;
999: return;
1000: }
1001:
1002: ##
1003: ## formulas_keys: Return the keys to the formulas hash.
1004: ##
1005: sub formulas_keys {
1006: my $self = shift;
1007: my @keys = keys(%{$self->{'formulas'}});
1008: return keys(%{$self->{'formulas'}});
1009: }
1010:
1011: ##
1012: ## formula: Return the formula for a given cell in the spreadsheet
1013: ## returns '' if the cell does not have a formula or does not exist
1014: ##
1015: sub formula {
1016: my $self = shift;
1017: my $cell = shift;
1018: if (defined($cell) && exists($self->{'formulas'}->{$cell})) {
1019: return $self->{'formulas'}->{$cell};
1020: }
1021: return '';
1022: }
1023:
1024: ##
1025: ## logthis: write the input to lonnet.log
1026: ##
1027: sub logthis {
1028: my $self = shift;
1029: my $message = shift;
1030: &Apache::lonnet::logthis($self->{'type'}.':'.
1031: $self->{'name'}.':'.$self->{'domain'}.':'.
1032: $message);
1033: return;
1034: }
1035:
1036: ##
1037: ## dump_formulas_to_log: makes lonnet.log huge...
1038: ##
1039: sub dump_formulas_to_log {
1040: my $self =shift;
1041: $self->logthis("Spreadsheet formulas");
1042: $self->logthis("--------------------------------------------------------");
1043: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) {
1044: $self->logthis(' '.$cell.' = '.$formula);
1045: }
1046: $self->logthis("--------------------------------------------------------");}
1047:
1048: ##
1049: ## value: returns the computed value of a particular cell
1050: ##
1051: sub value {
1052: my $self = shift;
1053: my $cell = shift;
1054: if (defined($cell) && exists($self->{'values'}->{$cell})) {
1055: return $self->{'values'}->{$cell};
1056: }
1057: return '';
1058: }
1059:
1060: ##
1061: ## dump_values_to_log: makes lonnet.log huge...
1062: ##
1063: sub dump_values_to_log {
1064: my $self =shift;
1065: $self->logthis("Spreadsheet Values");
1066: $self->logthis("------------------------------------------------------");
1067: while (my ($cell, $value) = each(%{$self->{'values'}})) {
1068: $self->logthis(' '.$cell.' = '.$value);
1069: }
1070: $self->logthis("------------------------------------------------------");
1071: }
1072:
1073: ##
1074: ## Yet another debugging function
1075: ##
1076: sub dump_hash_to_log {
1077: my $self= shift();
1078: my %tmp = @_;
1079: if (@_<2) {
1080: %tmp = %{$_[0]};
1081: }
1082: $self->logthis('---------------------------- (begin hash dump)');
1083: while (my ($key,$val) = each (%tmp)) {
1084: $self->logthis(' '.$key.' = '.$val.':');
1085: }
1086: $self->logthis('---------------------------- (finished hash dump)');
1087: }
1088:
1089: ##
1090: ## rebuild_stats: rebuilds the rows and template_cells arrays
1091: ##
1092: sub rebuild_stats {
1093: my $self = shift;
1094: $self->{'rows'}=[];
1095: $self->{'template_cells'}=[];
1096: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1097: push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);
1098: push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);
1099: }
1100: return;
1101: }
1102:
1103: ##
1104: ## template_cells returns a list of the cells defined in the template row
1105: ##
1106: sub template_cells {
1107: my $self = shift;
1108: $self->rebuild_stats() if (! defined($self->{'template_cells'}) ||
1109: ! @{$self->{'template_cells'}});
1110: return @{$self->{'template_cells'}};
1111: }
1112:
1113: ##
1114: ## Sigh....
1115: ##
1116: sub setothersheets {
1117: my $self = shift;
1118: my @othersheets = @_;
1119: $self->{'othersheets'} = \@othersheets;
1120: }
1121:
1122: ##
1123: ## rows returns a list of the names of cells defined in the A column
1124: ##
1125: sub rows {
1126: my $self = shift;
1127: $self->rebuild_stats() if (!@{$self->{'rows'}});
1128: return @{$self->{'rows'}};
1129: }
1130:
1131: #
1132: # calcsheet: makes all the calls to compute the spreadsheet.
1133: #
1134: sub calcsheet {
1135: my $self = shift;
1136: $self->sync_safe_space();
1137: $self->clear_errorlog();
1138: $self->sett();
1139: my $result = $self->{'safe'}->reval('&calc();');
1140: # $self->logthis($self->get_errorlog());
1141: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
1142: # $self->logthis($self->get_errorlog());
1143: if ($result ne 'okay') {
1144: $self->set_calcerror($result);
1145: }
1146: return $result;
1147: }
1148:
1149: sub set_badcalc {
1150: my $self = shift();
1151: $self->{'badcalc'} =1;
1152: return;
1153: }
1154:
1155: sub badcalc {
1156: my $self = shift;
1157: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
1158: return 1;
1159: } else {
1160: return 0;
1161: }
1162: }
1163:
1164: sub set_calcerror {
1165: my $self = shift;
1166: if (@_) {
1167: $self->set_badcalc();
1168: if (exists($self->{'calcerror'})) {
1169: $self->{'calcerror'}.="\n".$_[0];
1170: } else {
1171: $self->{'calcerror'}.=$_[0];
1172: }
1173: }
1174: }
1175:
1176: sub calcerror {
1177: my $self = shift;
1178: if ($self->badcalc()) {
1179: if (exists($self->{'calcerror'})) {
1180: return $self->{'calcerror'};
1181: }
1182: }
1183: return;
1184: }
1185:
1186: ###########################################################
1187: ##
1188: ## Output Helpers
1189: ##
1190: ###########################################################
1191: sub display {
1192: my $self = shift;
1193: my ($r) = @_;
1194: my $outputmode = 'html';
1195: foreach ($self->output_options()) {
1196: if ($ENV{'form.output_format'} eq $_->{'value'}) {
1197: $outputmode = $_->{'value'};
1198: last;
1199: }
1200: }
1201: if ($outputmode eq 'html') {
1202: $self->compute($r);
1203: $self->outsheet_html($r);
1204: } elsif ($outputmode eq 'htmlclasslist') {
1205: # No computation neccessary... This is kludgy
1206: $self->outsheet_htmlclasslist($r);
1207: } elsif ($outputmode eq 'excel') {
1208: $self->compute($r);
1209: $self->outsheet_excel($r);
1210: } elsif ($outputmode eq 'csv') {
1211: $self->compute($r);
1212: $self->outsheet_csv($r);
1213: } elsif ($outputmode eq 'xml') {
1214: # $self->compute($r);
1215: $self->outsheet_xml($r);
1216: }
1217: $self->cleanup();
1218: return;
1219: }
1220:
1221: ############################################
1222: ## HTML output routines ##
1223: ############################################
1224: sub html_report_error {
1225: my $self = shift();
1226: my $Str = '';
1227: if ($self->badcalc()) {
1228: $Str = '<h3 style="color:red">'.
1229: &mt('An error occurred while calculating this spreadsheet').
1230: "</h3>\n".
1231: '<pre>'.$self->calcerror()."</pre>\n";
1232: }
1233: return $Str;
1234: }
1235:
1236: sub html_export_row {
1237: my $self = shift();
1238: my ($color) = @_;
1239: $color = '#CCCCFF' if (! defined($color));
1240: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1241: my $row_html;
1242: my @rowdata = $self->get_row(0);
1243: foreach my $cell (@rowdata) {
1244: if ($cell->{'name'} =~ /^[A-Z]/) {
1245: $row_html .= '<td bgcolor="'.$color.'">'.
1246: &html_editable_cell($cell,$color,$allowed).'</td>';
1247: } else {
1248: $row_html .= '<td bgcolor="#DDCCFF">'.
1249: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';
1250: }
1251: }
1252: return $row_html;
1253: }
1254:
1255: sub html_template_row {
1256: my $self = shift();
1257: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1258: my ($num_uneditable,$importcolor) = @_;
1259: my $row_html;
1260: my @rowdata = $self->get_template_row();
1261: my $count = 0;
1262: for (my $i = 0; $i<=$#rowdata; $i++) {
1263: my $cell = $rowdata[$i];
1264: if ($i < $num_uneditable) {
1265: $row_html .= '<td bgcolor="'.$importcolor.'">'.
1266: &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
1267: } else {
1268: $row_html .= '<td bgcolor="#EOFFDD">'.
1269: &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>';
1270: }
1271: }
1272: return $row_html;
1273: }
1274:
1275: sub html_editable_cell {
1276: my ($cell,$bgcolor,$allowed) = @_;
1277: my $result;
1278: my ($name,$formula,$value);
1279: if (defined($cell)) {
1280: $name = $cell->{'name'};
1281: $formula = $cell->{'formula'};
1282: $value = $cell->{'value'};
1283: }
1284: $name = '' if (! defined($name));
1285: $formula = '' if (! defined($formula));
1286: if (! defined($value)) {
1287: $value = '<font color="'.$bgcolor.'">#</font>';
1288: if ($formula ne '') {
1289: $value = '<i>undefined value</i>';
1290: }
1291: } elsif ($value =~ /^\s*$/ ) {
1292: $value = '<font color="'.$bgcolor.'">#</font>';
1293: } else {
1294: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1295: }
1296: return $value if (! $allowed);
1297: #
1298: # The formula will be parsed by the browser twice before being
1299: # displayed to the user for editing.
1300: #
1301: # The encoding string "^A-blah" is placed in []'s inside a regexp, so
1302: # we specify the characters we want left alone by putting a '^' in front.
1303: $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~');
1304: # HTML::Entities::encode does not catch everything - we need '\' encoded
1305: $formula =~ s/\\/&\#092/g;
1306: # Escape it again - this time the only encodable character is '&'
1307: $formula =~ s/\&/\&/g;
1308: # Glue everything together
1309: $result .= "<a href=\"javascript:celledit(\'".
1310: $name."','".$formula."');\">".$value."</a>";
1311: return $result;
1312: }
1313:
1314: sub html_uneditable_cell {
1315: my ($cell,$bgcolor) = @_;
1316: my $value = (defined($cell) ? $cell->{'value'} : '');
1317: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1318: return ' '.$value.' ';
1319: }
1320:
1321: sub html_row {
1322: my $self = shift();
1323: my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;
1324: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1325: my @rowdata = $self->get_row($row);
1326: my $num_cols_output = 0;
1327: my $row_html;
1328: my $color = $importcolor;
1329: if ($row == 0) {
1330: $color = $exportcolor;
1331: }
1332: $color = '#FFDDDD' if (! defined($color));
1333: foreach my $cell (@rowdata) {
1334: if ($num_cols_output++ < $num_uneditable) {
1335: $row_html .= '<td bgcolor="'.$color.'">';
1336: $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
1337: } else {
1338: $row_html .= '<td bgcolor="#EOFFDD">';
1339: $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed);
1340: }
1341: $row_html .= '</td>';
1342: }
1343: return $row_html;
1344: }
1345:
1346: sub html_header {
1347: my $self = shift;
1348: return '' if (! $ENV{'request.role.adv'});
1349: return "<table>\n".
1350: '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
1351: '<tr><td>'.$self->output_selector()."</td></tr>\n".
1352: "</table>\n";
1353: }
1354:
1355: ##
1356: ## Default output types are HTML, Excel, and CSV
1357: sub output_options {
1358: my $self = shift();
1359: return ({value => 'html',
1360: description => 'HTML'},
1361: {value => 'excel',
1362: description => 'Excel'},
1363: # {value => 'xml',
1364: # description => 'XML'},
1365: {value => 'csv',
1366: description => 'Comma Separated Values'},);
1367: }
1368:
1369: sub output_selector {
1370: my $self = shift();
1371: my $output_selector = '<select name="output_format" size="3">'."\n";
1372: my $default = 'html';
1373: if (exists($ENV{'form.output_format'})) {
1374: $default = $ENV{'form.output_format'}
1375: } else {
1376: $ENV{'form.output_format'} = $default;
1377: }
1378: foreach ($self->output_options()) {
1379: $output_selector.='<option value="'.$_->{'value'}.'"';
1380: if ($_->{'value'} eq $default) {
1381: $output_selector .= ' selected';
1382: }
1383: $output_selector .= ">".&mt($_->{'description'})."</option>\n";
1384: }
1385: $output_selector .= "</select>\n";
1386: return $output_selector;
1387: }
1388:
1389: ################################################
1390: ## Excel output routines ##
1391: ################################################
1392: sub excel_output_row {
1393: my $self = shift;
1394: my ($worksheet,$rownum,$rows_output,@prepend) = @_;
1395: my $cols_output = 0;
1396: #
1397: my @rowdata = $self->get_row($rownum);
1398: foreach my $cell (@prepend,@rowdata) {
1399: my $value = $cell;
1400: $value = $cell->{'value'} if (ref($value));
1401: $value =~ s/\ / /gi;
1402: $worksheet->write($rows_output,$cols_output++,$value);
1403: }
1404: return;
1405: }
1406:
1407: sub create_excel_spreadsheet {
1408: my $self = shift;
1409: my ($r) = @_;
1410: my $filename = '/prtspool/'.
1411: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1412: time.'_'.rand(1000000000).'.xls';
1413: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1414: if (! defined($workbook)) {
1415: $r->log_error("Error creating excel spreadsheet $filename: $!");
1416: $r->print(&mt("Problems creating new Excel file. ".
1417: "This error has been logged. ".
1418: "Please alert your LON-CAPA administrator"));
1419: return undef;
1420: }
1421: #
1422: # The excel spreadsheet stores temporary data in files, then put them
1423: # together. If needed we should be able to disable this (memory only).
1424: # The temporary directory must be specified before calling 'addworksheet'.
1425: # File::Temp is used to determine the temporary directory.
1426: $workbook->set_tempdir('/home/httpd/perl/tmp');
1427: #
1428: # Determine the name to give the worksheet
1429: return ($workbook,$filename);
1430: }
1431:
1432: #
1433: # This routine is just a stub
1434: sub outsheet_htmlclasslist {
1435: my $self = shift;
1436: my ($r) = @_;
1437: $r->print('<h2>'.&mt("This output is not supported").'</h2>');
1438: $r->rflush();
1439: return;
1440: }
1441:
1442: sub outsheet_excel {
1443: my $self = shift;
1444: my ($r) = @_;
1445: my $connection = $r->connection();
1446: #
1447: $r->print($self->html_report_error());
1448: $r->rflush();
1449: #
1450: $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
1451: #
1452: # Create excel worksheet
1453: my ($workbook,$filename) = $self->create_excel_spreadsheet($r);
1454: return if (! defined($workbook));
1455: #
1456: # Create main worksheet
1457: my $worksheet = $workbook->addworksheet('main');
1458: my $rows_output = 0;
1459: my $cols_output = 0;
1460: #
1461: # Write excel header
1462: foreach my $value ($self->get_title()) {
1463: $cols_output = 0;
1464: $worksheet->write($rows_output++,$cols_output,$value);
1465: }
1466: $rows_output++; # skip a line
1467: #
1468: # Write summary/export row
1469: $cols_output = 0;
1470: $self->excel_output_row($worksheet,0,$rows_output++,'Summary');
1471: $rows_output++; # skip a line
1472: #
1473: $self->excel_rows($connection,$worksheet,$cols_output,$rows_output);
1474: #
1475: #
1476: # Close the excel file
1477: $workbook->close();
1478: #
1479: # Write a link to allow them to download it
1480: $r->print('<br />'.
1481: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
1482: return;
1483: }
1484:
1485: #################################
1486: ## CSV output routines ##
1487: #################################
1488: sub outsheet_csv {
1489: my $self = shift;
1490: my ($r) = @_;
1491: my $connection = $r->connection();
1492: #
1493: $r->print($self->html_report_error());
1494: $r->rflush();
1495: #
1496: my $csvdata = '';
1497: my @Values;
1498: #
1499: # Open the csv file
1500: my $filename = '/prtspool/'.
1501: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1502: time.'_'.rand(1000000000).'.csv';
1503: my $file;
1504: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
1505: $r->log_error("Couldn't open $filename for output $!");
1506: $r->print(&mt("Problems occured in writing the csv file. ".
1507: "This error has been logged. ".
1508: "Please alert your LON-CAPA administrator."));
1509: $r->print("<pre>\n".$csvdata."</pre>\n");
1510: return 0;
1511: }
1512: #
1513: # Output the title information
1514: foreach my $value ($self->get_title()) {
1515: print $file "'".&Apache::loncommon::csv_translate($value)."'\n";
1516: }
1517: #
1518: # Output the body of the spreadsheet
1519: $self->csv_rows($connection,$file);
1520: #
1521: # Close the csv file
1522: close($file);
1523: $r->print('<br /><br />'.
1524: '<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
1525: #
1526: return 1;
1527: }
1528:
1529: sub csv_output_row {
1530: my $self = shift;
1531: my ($filehandle,$rownum,@prepend) = @_;
1532: #
1533: my @rowdata = ();
1534: if (defined($rownum)) {
1535: @rowdata = $self->get_row($rownum);
1536: }
1537: my @output = ();
1538: foreach my $cell (@prepend,@rowdata) {
1539: my $value = $cell;
1540: $value = $cell->{'value'} if (ref($value));
1541: $value =~ s/\ / /gi;
1542: $value = "'".$value."'";
1543: push (@output,$value);
1544: }
1545: print $filehandle join(',',@output )."\n";
1546: return;
1547: }
1548:
1549: ############################################
1550: ## XML output routines ##
1551: ############################################
1552: sub outsheet_xml {
1553: my $self = shift;
1554: my ($r) = @_;
1555: ## Someday XML
1556: ## Will be rendered for the user
1557: ## But not on this day
1558: my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
1559: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1560: if ($cell =~ /^template_(\d+)/) {
1561: my $col = $1;
1562: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
1563: } else {
1564: my ($col,$row) = ($cell =~ /^([A-z])(\d+)/);
1565: next if (! defined($row) || ! defined($col));
1566: next if ($row != 0);
1567: $Str .=
1568: '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>'
1569: ."\n";
1570: }
1571: }
1572: $Str.="</spreadsheet>";
1573: # $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
1574: return $Str;
1575: }
1576:
1577: ############################################
1578: ### Filesystem routines ###
1579: ############################################
1580: sub parse_sheet {
1581: # $sheetxml is a scalar reference or a scalar
1582: my ($sheetxml) = @_;
1583: if (! ref($sheetxml)) {
1584: my $tmp = $sheetxml;
1585: $sheetxml = \$tmp;
1586: }
1587: my %formulas;
1588: my %sources;
1589: my $parser=HTML::TokeParser->new($sheetxml);
1590: my $token;
1591: while ($token=$parser->get_token) {
1592: if ($token->[0] eq 'S') {
1593: if ($token->[1] eq 'field') {
1594: my $cell = $token->[2]->{'col'}.$token->[2]->{'row'};
1595: my $source = $token->[2]->{'source'};
1596: my $formula = $parser->get_text('/field');
1597: $formulas{$cell} = $formula;
1598: $sources{$cell} = $source if (defined($source));
1599: $parser->get_text('/field');
1600: }
1601: if ($token->[1] eq 'template') {
1602: $formulas{'template_'.$token->[2]->{'col'}}=
1603: $parser->get_text('/template');
1604: }
1605: }
1606: }
1607: return (\%formulas,\%sources);
1608: }
1609:
1610: {
1611:
1612: my %spreadsheets;
1613:
1614: sub clear_spreadsheet_definition_cache {
1615: undef(%spreadsheets);
1616: }
1617:
1618: sub load_system_default_sheet {
1619: my $self = shift;
1620: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
1621: # load in the default defined spreadsheet
1622: my $sheetxml='';
1623: my $fh;
1624: if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) {
1625: $sheetxml=join('',<$fh>);
1626: $fh->close();
1627: } else {
1628: # $sheetxml='<field row="0" col="A">"Error"</field>';
1629: $sheetxml='<field row="0" col="A"></field>';
1630: }
1631: $self->filename('default_');
1632: my ($formulas,undef) = &parse_sheet(\$sheetxml);
1633: return $formulas;
1634: }
1635:
1636: sub load {
1637: my $self = shift;
1638: #
1639: my $stype = $self->{'type'};
1640: my $cnum = $self->{'cnum'};
1641: my $cdom = $self->{'cdom'};
1642: my $chome = $self->{'chome'};
1643: #
1644: my $filename = $self->filename();
1645: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1646: #
1647: # see if sheet is cached
1648: my ($formulas);
1649: if (exists($spreadsheets{$cachekey})) {
1650: $formulas = $spreadsheets{$cachekey}->{'formulas'};
1651: } else {
1652: # Not cached, need to read
1653: if (! defined($filename)) {
1654: $formulas = $self->load_system_default_sheet();
1655: } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
1656: # Load a spreadsheet definition file
1657: my $sheetxml=&Apache::lonnet::getfile
1658: (&Apache::lonnet::filelocation('',$filename));
1659: if ($sheetxml == -1) {
1660: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1661: .$self->filename().'"</field>';
1662: }
1663: ($formulas,undef) = &parse_sheet(\$sheetxml);
1664: # Get just the filename and set the sheets filename
1665: my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/);
1666: if ($self->is_default()) {
1667: $self->filename($newfilename);
1668: $self->make_default();
1669: } else {
1670: $self->filename($newfilename);
1671: }
1672: } else {
1673: # Load the spreadsheet definition file from the save file
1674: my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
1675: my ($tmp) = keys(%tmphash);
1676: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
1677: while (my ($cell,$formula) = each(%tmphash)) {
1678: $formulas->{$cell}=$formula;
1679: }
1680: } else {
1681: $formulas = $self->load_system_default_sheet();
1682: }
1683: }
1684: $filename=$self->filename(); # filename may have changed
1685: $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1686: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
1687: }
1688: $self->formulas($formulas);
1689: $self->set_row_sources();
1690: $self->set_row_numbers();
1691: }
1692:
1693: sub set_row_sources {
1694: my $self = shift;
1695: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1696: next if ($cell !~ /^A(\d+)/ || $1 < 1);
1697: my $row = $1;
1698: $self->{'row_source'}->{$row} = $value;
1699: }
1700: return;
1701: }
1702:
1703: sub set_row_numbers {
1704: my $self = shift;
1705: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1706: next if ($cell !~ /^A(\d+)$/);
1707: next if (! defined($value));
1708: $self->{'row_numbers'}->{$value} = $1;
1709: $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'});
1710: }
1711: }
1712:
1713: ##
1714: ## exportrow is *not* used to get the export row from a computed sub-sheet.
1715: ##
1716: sub exportrow {
1717: my $self = shift;
1718: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
1719: return ();
1720: }
1721: my @exportarray;
1722: foreach my $column (@UC_Columns) {
1723: push(@exportarray,$self->value($column.'0'));
1724: }
1725: return @exportarray;
1726: }
1727:
1728: sub save {
1729: my $self = shift;
1730: my ($makedef)=@_;
1731: my $cid=$self->{'cid'};
1732: # If we are saving it, it must not be temporary
1733: $self->temporary(0);
1734: if (&Apache::lonnet::allowed('opa',$cid)) {
1735: my %f=$self->formulas();
1736: my $stype = $self->{'type'};
1737: my $cnum = $self->{'cnum'};
1738: my $cdom = $self->{'cdom'};
1739: my $chome = $self->{'chome'};
1740: my $filename = $self->{'filename'};
1741: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1742: # Cache new sheet
1743: %{$spreadsheets{$cachekey}->{'formulas'}}=%f;
1744: # Write sheet
1745: foreach (keys(%f)) {
1746: delete($f{$_}) if ($f{$_} eq 'import');
1747: }
1748: my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);
1749: return $reply if ($reply ne 'ok');
1750: $reply = &Apache::lonnet::put($stype.'_spreadsheets',
1751: {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
1752: $cdom,$cnum);
1753: return $reply if ($reply ne 'ok');
1754: if ($makedef) {
1755: $reply = &Apache::lonnet::put('environment',
1756: {'spreadsheet_default_'.$stype => $filename },
1757: $cdom,$cnum);
1758: return $reply if ($reply ne 'ok');
1759: }
1760: if ($self->is_default()) {
1761: if ($self->{'type'} eq 'studentcalc') {
1762: &Apache::lonnet::expirespread('','','studentcalc','');
1763: } elsif ($self->{'type'} eq 'assesscalc') {
1764: &Apache::lonnet::expirespread('','','assesscalc','');
1765: &Apache::lonnet::expirespread('','','studentcalc','');
1766: }
1767: }
1768: return $reply;
1769: }
1770: return 'unauthorized';
1771: }
1772:
1773: } # end of scope for %spreadsheets
1774:
1775: sub save_tmp {
1776: my $self = shift;
1777: my $filename=$ENV{'user.name'}.'_'.
1778: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1779: $self->{'filename'};
1780: $filename=~s/\W/\_/g;
1781: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1782: $self->temporary(1);
1783: my $fh;
1784: if ($fh=Apache::File->new('>'.$filename)) {
1785: my %f = $self->formulas();
1786: while( my ($cell,$formula) = each(%f)) {
1787: next if ($formula eq 'import');
1788: print $fh &Apache::lonnet::escape($cell)."=".
1789: &Apache::lonnet::escape($formula)."\n";
1790: }
1791: $fh->close();
1792: }
1793: }
1794:
1795: sub load_tmp {
1796: my $self = shift;
1797: my $filename=$ENV{'user.name'}.'_'.
1798: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1799: $self->{'filename'};
1800: $filename=~s/\W/\_/g;
1801: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1802: my %formulas = ();
1803: if (my $spreadsheet_file = Apache::File->new($filename)) {
1804: while (<$spreadsheet_file>) {
1805: chomp;
1806: my ($cell,$formula) = split(/=/);
1807: $cell = &Apache::lonnet::unescape($cell);
1808: $formula = &Apache::lonnet::unescape($formula);
1809: $formulas{$cell} = $formula;
1810: }
1811: $spreadsheet_file->close();
1812: }
1813: # flag the sheet as temporary
1814: $self->temporary(1);
1815: $self->formulas(\%formulas);
1816: $self->set_row_sources();
1817: $self->set_row_numbers();
1818: return;
1819: }
1820:
1821: sub temporary {
1822: my $self=shift;
1823: if (@_) {
1824: ($self->{'temporary'})= @_;
1825: }
1826: return $self->{'temporary'};
1827: }
1828:
1829: sub modify_cell {
1830: # studentcalc overrides this
1831: my $self = shift;
1832: my ($cell,$formula) = @_;
1833: if ($cell =~ /([A-z])\-/) {
1834: $cell = 'template_'.$1;
1835: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) {
1836: return;
1837: }
1838: $self->set_formula($cell,$formula);
1839: $self->rebuild_stats();
1840: return;
1841: }
1842:
1843: ###########################################
1844: # othersheets: Returns the list of other spreadsheets available
1845: ###########################################
1846: sub othersheets {
1847: my $self = shift();
1848: my ($stype) = @_;
1849: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/);
1850: #
1851: my @alternatives=();
1852: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',
1853: $self->{'cdom'}, $self->{'cnum'});
1854: my ($tmp) = keys(%results);
1855: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
1856: @alternatives = (&mt('Default'));
1857: } else {
1858: @alternatives = (&mt('Default'), sort (keys(%results)));
1859: }
1860: return @alternatives;
1861: }
1862:
1863: sub blackout {
1864: my $self = shift;
1865: $self->{'blackout'} = $_[0] if (@_);
1866: return $self->{'blackout'};
1867: }
1868:
1869: sub get_row {
1870: my $self = shift;
1871: my ($n)=@_;
1872: my @cols=();
1873: foreach my $col (@UC_Columns,@LC_Columns) {
1874: my $cell = $col.$n;
1875: push(@cols,{ name => $cell,
1876: formula => $self->formula($cell),
1877: value => $self->value($cell)});
1878: }
1879: return @cols;
1880: }
1881:
1882: sub get_template_row {
1883: my $self = shift;
1884: my @cols=();
1885: foreach my $col (@UC_Columns,@LC_Columns) {
1886: my $cell = 'template_'.$col;
1887: push(@cols,{ name => $cell,
1888: formula => $self->formula($cell),
1889: value => $self->formula($cell) });
1890: }
1891: return @cols;
1892: }
1893:
1894: sub need_to_save {
1895: my $self = shift;
1896: if ($self->{'new_rows'} && ! $self->temporary()) {
1897: return 1;
1898: }
1899: return 0;
1900: }
1901:
1902: sub get_row_number_from_key {
1903: my $self = shift;
1904: my ($key) = @_;
1905: if (! exists($self->{'row_numbers'}->{$key}) ||
1906: ! defined($self->{'row_numbers'}->{$key})) {
1907: # I used to set $f here to the new value, but the key passed for lookup
1908: # may not be the key we need to save
1909: $self->{'maxrow'}++;
1910: $self->{'row_numbers'}->{$key} = $self->{'maxrow'};
1911: # $self->logthis('added row '.$self->{'row_numbers'}->{$key}.
1912: # ' for '.$key);
1913: $self->{'new_rows'} = 1;
1914: }
1915: return $self->{'row_numbers'}->{$key};
1916: }
1917:
1918: 1;
1919:
1920: __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