Annotation of loncom/interface/spreadsheet/Spreadsheet.pm, revision 1.35
1.1 matthew 1: #
1.35 ! albertel 2: # $Id: Spreadsheet.pm,v 1.34 2004/01/15 21:20:07 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;
1.24 matthew 51: #use warnings FATAL=>'all';
52: #no warnings 'uninitialized';
1.1 matthew 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;
1.28 www 62: use Apache::lonlocal;
1.1 matthew 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 => '',
1.22 matthew 96: maxrow => 0,
1.1 matthew 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'},
1.12 matthew 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
1.1 matthew 107: #
1.3 matthew 108: # blackout is used to determine if any data needs to be hidden from the
109: # student.
110: blackout => 0,
111: #
1.1 matthew 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' ||
1.13 matthew 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'};
1.1 matthew 158: }
1.13 matthew 159: }
160: if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) {
161: $newfilename = 'default_'.$self->{'type'};
162: }
1.33 matthew 163: if ($newfilename !~ /^default\.$self->{'type'}$/ &&
164: $newfilename !~ /^\/res\/(.*)spreadsheet$/) {
1.13 matthew 165: if ($newfilename !~ /_$self->{'type'}$/) {
166: $newfilename =~ s/[\s_]*$//;
1.1 matthew 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',
1.13 matthew 191: {'spreadsheet_default_'.$self->{'type'} => $self->filename()},
1.1 matthew 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: }
1.13 matthew 224: if ($default_filename =~ /^\s*$/) {
225: $default_filename = 'default_'.$self->{'type'};
226: }
1.1 matthew 227: return 1 if ($self->filename() eq $default_filename);
228: return 0;
1.11 matthew 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.
1.1 matthew 234: }
235:
1.23 matthew 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:
1.1 matthew 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)=@_;
1.22 matthew 265: return 0 if (! defined($time));
1.19 matthew 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
1.1 matthew 274: $key1 = '::'.$self->{'type'}.':';
275: $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
276: $key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
1.19 matthew 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) {
1.1 matthew 281: next if (! defined($key));
1.19 matthew 282: if (exists($expiredates{$key}) && $expiredates{$key} > $time) {
283: $returnvalue = 0; # need to recompute
1.1 matthew 284: }
285: }
1.19 matthew 286: return $returnvalue;
1.1 matthew 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: ######################################################
1.25 matthew 304: {
305:
306: my $safeeval;
307:
1.1 matthew 308: sub initialize_safe_space {
1.25 matthew 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';
1.1 matthew 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(@_);
1.26 matthew 385: my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
1.1 matthew 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;
1.26 matthew 402: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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;
1.26 matthew 424: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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;
1.26 matthew 445: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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;
1.26 matthew 470: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 471: $sum+=$sheet_values{$_};
472: $num++;
473: }
474: unless ($num>1) { return undef; }
475: my $mean=$sum/$num;
476: $sum=0;
1.26 matthew 477: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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;
1.26 matthew 497: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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='-';
1.26 matthew 517: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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='-';
1.26 matthew 540: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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=();
1.26 matthew 565: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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=();
1.26 matthew 592: foreach (grep eval("/$mask/"),keys(%sheet_values)) {
1.1 matthew 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: foreach $parameter (keys(%c)) {
619: next if ($parameter !~ /$expression/);
620: if ((! defined($min)) || ($min > $c{$parameter})) {
621: $min = $c{$parameter}
622: }
623: }
624: return $min;
625: }
626:
627: #-------------------------------------------------------
628:
629: =pod
630:
631: =item MAXPARM(parametername)
632:
633: Returns the maximum value of the parameters matching the input parameter name.
634: parametername should be a string such as 'duedate'.
635:
636: =cut
637:
638: #-------------------------------------------------------
639: sub MAXPARM {
640: my ($expression) = @_;
641: my $max = undef;
642: foreach $parameter (keys(%c)) {
643: next if ($parameter !~ /$expression/);
644: if ((! defined($min)) || ($max < $c{$parameter})) {
645: $max = $c{$parameter}
646: }
647: }
648: return $max;
649: }
650:
651:
652: sub calc {
653: %sheet_values = %t;
654: my $notfinished = 1;
655: my $lastcalc = '';
656: my $depth = 0;
657: while ($notfinished) {
658: $notfinished=0;
659: while (my ($cell,$value) = each(%t)) {
660: my $old=$sheet_values{$cell};
661: $sheet_values{$cell}=eval $value;
662: # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n";
663: if ($@) {
664: undef %sheet_values;
665: return $cell.': '.$@;
666: }
667: if ($sheet_values{$cell} ne $old) {
668: $notfinished=1;
669: $lastcalc=$cell;
670: }
671: }
672: # $errorlog.="------------------------------------------------";
673:
674: $depth++;
675: if ($depth>100) {
676: undef %sheet_values;
677: return $lastcalc.': Maximum calculation depth exceeded';
678: }
679: }
1.30 matthew 680: return 'okay';
1.1 matthew 681: }
682:
683: # ------------------------------------------- End of "Inside of the safe space"
684: ENDDEFS
1.25 matthew 685: $safeeval->reval($code);
686: }
1.1 matthew 687: $self->{'safe'} = $safeeval;
688: $self->{'root'} = $self->{'safe'}->root();
689: #
690: # Place some of the %$self items into the safe space except the safe space
691: # itself
692: my $initstring = '';
693: foreach (qw/name domain type usymb cid csec coursefilename
694: cnum cdom chome uhome/) {
695: $initstring.= qq{\$$_="$self->{$_}";};
696: }
697: $self->{'safe'}->reval($initstring);
698: return $self;
699: }
1.25 matthew 700:
701: }
702:
1.1 matthew 703: ######################################################
704:
705: =pod
706:
707: =back
708:
709: =cut
710:
711: ######################################################
712:
713:
714: ######################################################
715:
1.26 matthew 716: =pod
717:
718: =item &mask($lower,$upper)
719:
720: Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").
721:
722: Returns: Regular expression matching spreadsheet cells that are within
723: the rectangle defined by $lower and $upper. Due to the nature of the
724: regular expression this result must be used inside an eval().
725:
726: =cut
1.1 matthew 727:
728: ######################################################
729: {
730:
731: my %memoizer;
732:
733: sub mask {
734: my ($lower,$upper)=@_;
735: my $key = $lower.'_'.$upper;
736: if (exists($memoizer{$key})) {
737: return $memoizer{$key};
738: }
739: $upper = $lower if (! defined($upper));
740: #
1.26 matthew 741: my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);
742: my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);
1.1 matthew 743: #
744: my $alpha='';
745: my $num='';
746: #
1.26 matthew 747: # Do not put parenthases around $alpha.
748: # $num depends on the value in $1.
1.1 matthew 749: if (($la eq '*') || ($ua eq '*')) {
1.26 matthew 750: $alpha='[A-z]';
1.1 matthew 751: } else {
1.27 matthew 752: if ($la gt $ua) {
753: my $tmp = $ua;
754: $ua = $la;
755: $la = $ua;
756: }
1.26 matthew 757: $alpha=qq/[$la-$ua]/;
758: }
759: if ($ld ne '*' && $ud ne '*') {
760: # Make sure $ld <= $ud
761: if ($ld > $ud) {
762: my $tmp = $ud;
763: $ud = $ld;
764: $ld = $tmp;
765: }
766: # Here we make a regular expression using some advanced regexp
767: # abilities.
768: # (\d+) will match the digits of the cell name and dump them in
769: # to $1
770: # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will
771: # choose pattern_if_true if { ... code ... } is true and
772: # pattern_if_false if { ... code ... } is false.
773: # In this case, pattern_if_true is empty. pattern_if_false is
774: # 'donotmatch' and will not match our cells because none of
775: # them end with donotmatch.
776: # Unfortunately, the use of this type of regular expression
777: # requires that each match be wrapped in an eval(). Search for
778: # $mask in this module for examples
779: $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)';
1.1 matthew 780: } else {
1.26 matthew 781: $num = '(\d+)';
1.1 matthew 782: }
1.26 matthew 783: my $expression = '^'.$alpha.$num.'$';
1.1 matthew 784: $memoizer{$key} = $expression;
785: return $expression;
1.26 matthew 786: }
787:
788: #
789: # Debugging routine
790: sub dump_memoized_values {
791: while (my ($key,$value) = each(%memoizer)) {
792: &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value);
793: }
794: return;
1.1 matthew 795: }
796:
797: }
798:
799: ##
800: ## sub add_hash_to_safe {} # spreadsheet, would like to destroy
801: ##
802:
803: #
804: # expandnamed used to reside in the safe space
805: #
806: sub expandnamed {
807: my $self = shift;
808: my $expression=shift;
809: if ($expression=~/^\&/) {
810: my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
811: my @vars=split(/\W+/,$formula);
812: my %values=();
813: foreach my $varname ( @vars ) {
1.20 matthew 814: if ($varname=~/^(parameter|stores|timestamp)/) {
815: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
1.1 matthew 816: $varname=~s/$var/\([\\w:\\- ]\+\)/g;
817: foreach (keys(%{$self->{'constants'}})) {
818: if ($_=~/$varname/) {
819: $values{$1}=1;
820: }
821: }
822: }
823: }
824: if ($func eq 'EXPANDSUM') {
825: my $result='';
826: foreach (keys(%values)) {
827: my $thissum=$formula;
828: $thissum=~s/$var/$_/g;
829: $result.=$thissum.'+';
830: }
831: $result=~s/\+$//;
832: return $result;
833: } else {
834: return 0;
835: }
836: } else {
837: # it is not a function, so it is a parameter name
838: # We should do the following:
839: # 1. Take the list of parameter names
840: # 2. look through the list for ones that match the parameter we want
841: # 3. If there are no collisions, return the one that matches
842: # 4. If there is a collision, return 'bad parameter name error'
843: my $returnvalue = '';
844: my @matches = ();
1.14 matthew 845: my @values = ();
1.1 matthew 846: $#matches = -1;
1.14 matthew 847: while (my($parameter,$value) = each(%{$self->{'constants'}})) {
848: next if ($parameter !~ /$expression/);
849: push(@matches,$parameter);
850: push(@values,$value);
1.1 matthew 851: }
852: if (scalar(@matches) == 0) {
1.10 matthew 853: $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';
1.1 matthew 854: } elsif (scalar(@matches) == 1) {
855: # why do we not do this lookup here, instead of delaying it?
1.14 matthew 856: $returnvalue = $values[0];
1.1 matthew 857: } elsif (scalar(@matches) > 0) {
858: # more than one match. Look for a concise one
859: $returnvalue = "'non-unique parameter name : $expression'";
1.14 matthew 860: for (my $i=0; $i<=$#matches;$i++) {
861: if ($matches[$i] =~ /^$expression$/) {
1.1 matthew 862: # why do we not do this lookup here?
1.14 matthew 863: $returnvalue = $values[$i];
1.1 matthew 864: }
865: }
866: } else {
867: # There was a negative number of matches, which indicates
868: # something is wrong with reality. Better warn the user.
1.14 matthew 869: $returnvalue = '"bizzare parameter: '.$expression.'"';
1.1 matthew 870: }
871: return $returnvalue;
872: }
873: }
874:
875: sub sett {
876: my $self = shift;
877: my %t=();
878: #
879: # Deal with the template row
880: foreach my $col ($self->template_cells()) {
881: next if ($col=~/^[A-Z]/);
882: foreach my $row ($self->rows()) {
883: # Get the name of this cell
884: my $cell=$col.$row;
885: # Grab the template declaration
886: $t{$cell}=$self->formula('template_'.$col);
887: # Replace '#' with the row number
888: $t{$cell}=~s/\#/$row/g;
889: # Replace '....' with ','
890: $t{$cell}=~s/\.\.+/\,/g;
891: # Replace 'A0' with the value from 'A0'
892: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
893: # Replace parameters
894: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
895: }
896: }
897: #
898: # Deal with the normal cells
899: while (my($cell,$formula) = each(%{$self->{'formulas'}})) {
900: next if ($_=~/^template\_/);
901: my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/);
902: if ($row eq '0') {
903: $t{$cell}=$formula;
904: $t{$cell}=~s/\.\.+/\,/g;
905: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
906: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
907: } elsif ( $col =~ /^[A-Z]$/ ) {
908: if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) {
909: my $data = $self->{'constants'}->{$cell};
910: $t{$cell} = $data;
911: }
912: } else { # $row > 1 and $col =~ /[a-z]
913: $t{$cell}=$formula;
914: $t{$cell}=~s/\.\.+/\,/g;
915: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
916: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
917: }
918: }
919: %{$self->{'safe'}->varglob('t')}=%t;
920: }
921:
922: ##
923: ## sync_safe_space: Called by calcsheet to make sure all the data we
924: # need to calculate is placed into the safe space
925: ##
926: sub sync_safe_space {
927: my $self = shift;
928: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
929: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
930: # 'constants' leads a peaceful hidden life of 'c'.
931: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
932: # 'othersheets' hides as 'os', a disguise few can penetrate.
933: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
934: }
935:
936: ##
937: ## Retrieve the error log from the safe space (used for debugging)
938: ##
939: sub get_errorlog {
940: my $self = shift;
941: $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') };
942: return $self->{'errorlog'};
943: }
944:
945: ##
946: ## Clear the error log inside the safe space
947: ##
948: sub clear_errorlog {
949: my $self = shift;
950: $ {$self->{'safe'}->varglob('errorlog')} = '';
951: $self->{'errorlog'} = '';
952: }
953:
954: ##
955: ## constants: either set or get the constants
956: ##
957: sub constants {
958: my $self=shift;
959: my ($constants) = @_;
960: if (defined($constants)) {
961: if (! ref($constants)) {
962: my %tmp = @_;
963: $constants = \%tmp;
964: }
965: $self->{'constants'} = $constants;
966: return;
967: } else {
968: return %{$self->{'constants'}};
969: }
970: }
971:
972: ##
973: ## formulas: either set or get the formulas
974: ##
975: sub formulas {
976: my $self=shift;
977: my ($formulas) = @_;
978: if (defined($formulas)) {
979: if (! ref($formulas)) {
980: my %tmp = @_;
981: $formulas = \%tmp;
982: }
983: $self->{'formulas'} = $formulas;
984: $self->{'rows'} = [];
985: $self->{'template_cells'} = [];
986: return;
987: } else {
988: return %{$self->{'formulas'}};
989: }
990: }
991:
992: sub set_formula {
993: my $self = shift;
994: my ($cell,$formula) = @_;
995: $self->{'formulas'}->{$cell}=$formula;
996: return;
997: }
998:
999: ##
1000: ## formulas_keys: Return the keys to the formulas hash.
1001: ##
1002: sub formulas_keys {
1003: my $self = shift;
1004: my @keys = keys(%{$self->{'formulas'}});
1005: return keys(%{$self->{'formulas'}});
1006: }
1007:
1008: ##
1009: ## formula: Return the formula for a given cell in the spreadsheet
1010: ## returns '' if the cell does not have a formula or does not exist
1011: ##
1012: sub formula {
1013: my $self = shift;
1014: my $cell = shift;
1015: if (defined($cell) && exists($self->{'formulas'}->{$cell})) {
1016: return $self->{'formulas'}->{$cell};
1017: }
1018: return '';
1019: }
1020:
1021: ##
1022: ## logthis: write the input to lonnet.log
1023: ##
1024: sub logthis {
1025: my $self = shift;
1026: my $message = shift;
1027: &Apache::lonnet::logthis($self->{'type'}.':'.
1028: $self->{'name'}.':'.$self->{'domain'}.':'.
1029: $message);
1030: return;
1031: }
1032:
1033: ##
1034: ## dump_formulas_to_log: makes lonnet.log huge...
1035: ##
1036: sub dump_formulas_to_log {
1037: my $self =shift;
1038: $self->logthis("Spreadsheet formulas");
1039: $self->logthis("--------------------------------------------------------");
1040: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) {
1041: $self->logthis(' '.$cell.' = '.$formula);
1042: }
1043: $self->logthis("--------------------------------------------------------");}
1044:
1045: ##
1046: ## value: returns the computed value of a particular cell
1047: ##
1048: sub value {
1049: my $self = shift;
1050: my $cell = shift;
1051: if (defined($cell) && exists($self->{'values'}->{$cell})) {
1052: return $self->{'values'}->{$cell};
1053: }
1054: return '';
1055: }
1056:
1057: ##
1058: ## dump_values_to_log: makes lonnet.log huge...
1059: ##
1060: sub dump_values_to_log {
1061: my $self =shift;
1062: $self->logthis("Spreadsheet Values");
1063: $self->logthis("------------------------------------------------------");
1064: while (my ($cell, $value) = each(%{$self->{'values'}})) {
1065: $self->logthis(' '.$cell.' = '.$value);
1066: }
1067: $self->logthis("------------------------------------------------------");
1068: }
1069:
1070: ##
1071: ## Yet another debugging function
1072: ##
1073: sub dump_hash_to_log {
1074: my $self= shift();
1075: my %tmp = @_;
1076: if (@_<2) {
1077: %tmp = %{$_[0]};
1078: }
1079: $self->logthis('---------------------------- (begin hash dump)');
1080: while (my ($key,$val) = each (%tmp)) {
1081: $self->logthis(' '.$key.' = '.$val.':');
1082: }
1083: $self->logthis('---------------------------- (finished hash dump)');
1084: }
1085:
1086: ##
1087: ## rebuild_stats: rebuilds the rows and template_cells arrays
1088: ##
1089: sub rebuild_stats {
1090: my $self = shift;
1091: $self->{'rows'}=[];
1092: $self->{'template_cells'}=[];
1093: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1094: push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);
1095: push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);
1096: }
1097: return;
1098: }
1099:
1100: ##
1101: ## template_cells returns a list of the cells defined in the template row
1102: ##
1103: sub template_cells {
1104: my $self = shift;
1105: $self->rebuild_stats() if (! defined($self->{'template_cells'}) ||
1106: ! @{$self->{'template_cells'}});
1107: return @{$self->{'template_cells'}};
1108: }
1109:
1110: ##
1111: ## Sigh....
1112: ##
1113: sub setothersheets {
1114: my $self = shift;
1115: my @othersheets = @_;
1116: $self->{'othersheets'} = \@othersheets;
1117: }
1118:
1119: ##
1120: ## rows returns a list of the names of cells defined in the A column
1121: ##
1122: sub rows {
1123: my $self = shift;
1124: $self->rebuild_stats() if (!@{$self->{'rows'}});
1125: return @{$self->{'rows'}};
1126: }
1127:
1128: #
1129: # calcsheet: makes all the calls to compute the spreadsheet.
1130: #
1131: sub calcsheet {
1132: my $self = shift;
1133: $self->sync_safe_space();
1134: $self->clear_errorlog();
1135: $self->sett();
1136: my $result = $self->{'safe'}->reval('&calc();');
1137: # $self->logthis($self->get_errorlog());
1138: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
1139: # $self->logthis($self->get_errorlog());
1.30 matthew 1140: if ($result ne 'okay') {
1141: $self->set_calcerror($result);
1142: }
1.1 matthew 1143: return $result;
1144: }
1145:
1.30 matthew 1146: sub set_badcalc {
1147: my $self = shift();
1148: $self->{'badcalc'} =1;
1149: return;
1150: }
1151:
1152: sub badcalc {
1153: my $self = shift;
1154: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
1155: return 1;
1156: } else {
1157: return 0;
1158: }
1159: }
1160:
1161: sub set_calcerror {
1162: my $self = shift;
1163: if (@_) {
1164: $self->set_badcalc();
1165: if (exists($self->{'calcerror'})) {
1166: $self->{'calcerror'}.="\n".$_[0];
1167: } else {
1168: $self->{'calcerror'}.=$_[0];
1169: }
1170: }
1171: }
1172:
1173: sub calcerror {
1174: my $self = shift;
1175: if ($self->badcalc()) {
1176: if (exists($self->{'calcerror'})) {
1177: return $self->{'calcerror'};
1178: }
1179: }
1180: return;
1181: }
1182:
1.1 matthew 1183: ###########################################################
1184: ##
1185: ## Output Helpers
1186: ##
1187: ###########################################################
1.5 matthew 1188: sub display {
1189: my $self = shift;
1190: my ($r) = @_;
1191: my $outputmode = 'html';
1.31 matthew 1192: foreach ($self->output_options()) {
1193: if ($ENV{'form.output_format'} eq $_->{'value'}) {
1194: $outputmode = $_->{'value'};
1195: last;
1196: }
1.5 matthew 1197: }
1198: if ($outputmode eq 'html') {
1.31 matthew 1199: $self->compute($r);
1.5 matthew 1200: $self->outsheet_html($r);
1.31 matthew 1201: } elsif ($outputmode eq 'htmlclasslist') {
1202: # No computation neccessary... This is kludgy
1203: $self->outsheet_htmlclasslist($r);
1.5 matthew 1204: } elsif ($outputmode eq 'excel') {
1.31 matthew 1205: $self->compute($r);
1.5 matthew 1206: $self->outsheet_excel($r);
1207: } elsif ($outputmode eq 'csv') {
1.31 matthew 1208: $self->compute($r);
1.5 matthew 1209: $self->outsheet_csv($r);
1.33 matthew 1210: } elsif ($outputmode eq 'xml') {
1211: # $self->compute($r);
1212: $self->outsheet_xml($r);
1.5 matthew 1213: }
1.22 matthew 1214: $self->cleanup();
1.5 matthew 1215: return;
1216: }
1217:
1.1 matthew 1218: ############################################
1219: ## HTML output routines ##
1220: ############################################
1.30 matthew 1221: sub html_report_error {
1222: my $self = shift();
1223: my $Str = '';
1224: if ($self->badcalc()) {
1225: $Str = '<h3 style="color:red">'.
1226: &mt('An error occurred while calculating this spreadsheet').
1227: "</h3>\n".
1228: '<pre>'.$self->calcerror()."</pre>\n";
1229: }
1230: return $Str;
1231: }
1232:
1.1 matthew 1233: sub html_export_row {
1234: my $self = shift();
1.17 matthew 1235: my ($color) = @_;
1236: $color = '#CCCCFF' if (! defined($color));
1.1 matthew 1237: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1238: my $row_html;
1239: my @rowdata = $self->get_row(0);
1240: foreach my $cell (@rowdata) {
1241: if ($cell->{'name'} =~ /^[A-Z]/) {
1.17 matthew 1242: $row_html .= '<td bgcolor="'.$color.'">'.
1243: &html_editable_cell($cell,$color,$allowed).'</td>';
1.1 matthew 1244: } else {
1245: $row_html .= '<td bgcolor="#DDCCFF">'.
1246: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';
1247: }
1248: }
1249: return $row_html;
1250: }
1251:
1252: sub html_template_row {
1253: my $self = shift();
1254: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1.17 matthew 1255: my ($num_uneditable,$importcolor) = @_;
1.1 matthew 1256: my $row_html;
1257: my @rowdata = $self->get_template_row();
1258: my $count = 0;
1259: for (my $i = 0; $i<=$#rowdata; $i++) {
1260: my $cell = $rowdata[$i];
1261: if ($i < $num_uneditable) {
1.17 matthew 1262: $row_html .= '<td bgcolor="'.$importcolor.'">'.
1.7 matthew 1263: &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
1.1 matthew 1264: } else {
1265: $row_html .= '<td bgcolor="#EOFFDD">'.
1266: &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>';
1267: }
1268: }
1269: return $row_html;
1270: }
1271:
1272: sub html_editable_cell {
1273: my ($cell,$bgcolor,$allowed) = @_;
1274: my $result;
1275: my ($name,$formula,$value);
1276: if (defined($cell)) {
1277: $name = $cell->{'name'};
1278: $formula = $cell->{'formula'};
1279: $value = $cell->{'value'};
1280: }
1281: $name = '' if (! defined($name));
1282: $formula = '' if (! defined($formula));
1283: if (! defined($value)) {
1284: $value = '<font color="'.$bgcolor.'">#</font>';
1285: if ($formula ne '') {
1286: $value = '<i>undefined value</i>';
1287: }
1288: } elsif ($value =~ /^\s*$/ ) {
1289: $value = '<font color="'.$bgcolor.'">#</font>';
1290: } else {
1291: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1292: }
1293: return $value if (! $allowed);
1.18 matthew 1294: #
1.1 matthew 1295: # The formula will be parsed by the browser twice before being
1.18 matthew 1296: # displayed to the user for editing.
1297: #
1298: # The encoding string "^A-blah" is placed in []'s inside a regexp, so
1299: # we specify the characters we want left alone by putting a '^' in front.
1.21 matthew 1300: $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~');
1301: # HTML::Entities::encode does not catch everything - we need '\' encoded
1302: $formula =~ s/\\/&\#092/g;
1.18 matthew 1303: # Escape it again - this time the only encodable character is '&'
1304: $formula =~ s/\&/\&/g;
1.1 matthew 1305: # Glue everything together
1306: $result .= "<a href=\"javascript:celledit(\'".
1307: $name."','".$formula."');\">".$value."</a>";
1308: return $result;
1309: }
1310:
1311: sub html_uneditable_cell {
1312: my ($cell,$bgcolor) = @_;
1313: my $value = (defined($cell) ? $cell->{'value'} : '');
1314: $value = &HTML::Entities::encode($value) if ($value !~/ /);
1315: return ' '.$value.' ';
1316: }
1317:
1318: sub html_row {
1319: my $self = shift();
1.17 matthew 1320: my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;
1.1 matthew 1321: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});
1322: my @rowdata = $self->get_row($row);
1323: my $num_cols_output = 0;
1324: my $row_html;
1.17 matthew 1325: my $color = $importcolor;
1326: if ($row == 0) {
1327: $color = $exportcolor;
1328: }
1329: $color = '#FFDDDD' if (! defined($color));
1.1 matthew 1330: foreach my $cell (@rowdata) {
1331: if ($num_cols_output++ < $num_uneditable) {
1.17 matthew 1332: $row_html .= '<td bgcolor="'.$color.'">';
1.1 matthew 1333: $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
1334: } else {
1335: $row_html .= '<td bgcolor="#EOFFDD">';
1336: $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed);
1337: }
1338: $row_html .= '</td>';
1339: }
1340: return $row_html;
1341: }
1342:
1.5 matthew 1343: sub html_header {
1344: my $self = shift;
1345: return '' if (! $ENV{'request.role.adv'});
1346: return "<table>\n".
1.29 matthew 1347: '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
1.31 matthew 1348: '<tr><td>'.$self->output_selector()."</td></tr>\n".
1.5 matthew 1349: "</table>\n";
1350: }
1351:
1.31 matthew 1352: ##
1353: ## Default output types are HTML, Excel, and CSV
1354: sub output_options {
1355: my $self = shift();
1356: return ({value => 'html',
1357: description => 'HTML'},
1358: {value => 'excel',
1359: description => 'Excel'},
1.33 matthew 1360: # {value => 'xml',
1361: # description => 'XML'},
1.31 matthew 1362: {value => 'csv',
1363: description => 'Comma Separated Values'},);
1364: }
1365:
1.5 matthew 1366: sub output_selector {
1.31 matthew 1367: my $self = shift();
1.5 matthew 1368: my $output_selector = '<select name="output_format" size="3">'."\n";
1369: my $default = 'html';
1370: if (exists($ENV{'form.output_format'})) {
1371: $default = $ENV{'form.output_format'}
1372: } else {
1373: $ENV{'form.output_format'} = $default;
1374: }
1.31 matthew 1375: foreach ($self->output_options()) {
1376: $output_selector.='<option value="'.$_->{'value'}.'"';
1377: if ($_->{'value'} eq $default) {
1.5 matthew 1378: $output_selector .= ' selected';
1379: }
1.31 matthew 1380: $output_selector .= ">".&mt($_->{'description'})."</option>\n";
1.5 matthew 1381: }
1382: $output_selector .= "</select>\n";
1383: return $output_selector;
1384: }
1385:
1386: ################################################
1387: ## Excel output routines ##
1388: ################################################
1389: sub excel_output_row {
1390: my $self = shift;
1391: my ($worksheet,$rownum,$rows_output,@prepend) = @_;
1392: my $cols_output = 0;
1393: #
1394: my @rowdata = $self->get_row($rownum);
1395: foreach my $cell (@prepend,@rowdata) {
1396: my $value = $cell;
1397: $value = $cell->{'value'} if (ref($value));
1398: $value =~ s/\ / /gi;
1399: $worksheet->write($rows_output,$cols_output++,$value);
1400: }
1401: return;
1402: }
1403:
1.1 matthew 1404: sub create_excel_spreadsheet {
1405: my $self = shift;
1406: my ($r) = @_;
1407: my $filename = '/prtspool/'.
1408: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1409: time.'_'.rand(1000000000).'.xls';
1410: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1411: if (! defined($workbook)) {
1412: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.28 www 1413: $r->print(&mt("Problems creating new Excel file. ".
1.1 matthew 1414: "This error has been logged. ".
1.28 www 1415: "Please alert your LON-CAPA administrator"));
1.1 matthew 1416: return undef;
1417: }
1418: #
1419: # The excel spreadsheet stores temporary data in files, then put them
1420: # together. If needed we should be able to disable this (memory only).
1421: # The temporary directory must be specified before calling 'addworksheet'.
1422: # File::Temp is used to determine the temporary directory.
1423: $workbook->set_tempdir('/home/httpd/perl/tmp');
1424: #
1425: # Determine the name to give the worksheet
1426: return ($workbook,$filename);
1.31 matthew 1427: }
1428:
1429: #
1430: # This routine is just a stub
1431: sub outsheet_htmlclasslist {
1432: my $self = shift;
1433: my ($r) = @_;
1434: $r->print('<h2>'.&mt("This output is not supported").'</h2>');
1435: $r->rflush();
1436: return;
1.5 matthew 1437: }
1438:
1439: sub outsheet_excel {
1440: my $self = shift;
1441: my ($r) = @_;
1.23 matthew 1442: my $connection = $r->connection();
1.32 matthew 1443: #
1444: $r->print($self->html_report_error());
1445: $r->rflush();
1446: #
1.28 www 1447: $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
1.5 matthew 1448: #
1449: # Create excel worksheet
1450: my ($workbook,$filename) = $self->create_excel_spreadsheet($r);
1451: return if (! defined($workbook));
1452: #
1453: # Create main worksheet
1454: my $worksheet = $workbook->addworksheet('main');
1455: my $rows_output = 0;
1456: my $cols_output = 0;
1457: #
1458: # Write excel header
1459: foreach my $value ($self->get_title()) {
1460: $cols_output = 0;
1461: $worksheet->write($rows_output++,$cols_output,$value);
1462: }
1463: $rows_output++; # skip a line
1464: #
1465: # Write summary/export row
1466: $cols_output = 0;
1467: $self->excel_output_row($worksheet,0,$rows_output++,'Summary');
1468: $rows_output++; # skip a line
1469: #
1.23 matthew 1470: $self->excel_rows($connection,$worksheet,$cols_output,$rows_output);
1.5 matthew 1471: #
1472: #
1473: # Close the excel file
1474: $workbook->close();
1475: #
1476: # Write a link to allow them to download it
1477: $r->print('<br />'.
1478: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
1.6 matthew 1479: return;
1480: }
1481:
1482: #################################
1483: ## CSV output routines ##
1484: #################################
1485: sub outsheet_csv {
1486: my $self = shift;
1487: my ($r) = @_;
1.23 matthew 1488: my $connection = $r->connection();
1.32 matthew 1489: #
1490: $r->print($self->html_report_error());
1491: $r->rflush();
1492: #
1.6 matthew 1493: my $csvdata = '';
1494: my @Values;
1495: #
1496: # Open the csv file
1497: my $filename = '/prtspool/'.
1498: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
1499: time.'_'.rand(1000000000).'.csv';
1500: my $file;
1501: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
1502: $r->log_error("Couldn't open $filename for output $!");
1.28 www 1503: $r->print(&mt("Problems occured in writing the csv file. ".
1.6 matthew 1504: "This error has been logged. ".
1.28 www 1505: "Please alert your LON-CAPA administrator."));
1.6 matthew 1506: $r->print("<pre>\n".$csvdata."</pre>\n");
1507: return 0;
1508: }
1509: #
1510: # Output the title information
1511: foreach my $value ($self->get_title()) {
1512: print $file "'".&Apache::loncommon::csv_translate($value)."'\n";
1513: }
1514: #
1515: # Output the body of the spreadsheet
1.23 matthew 1516: $self->csv_rows($connection,$file);
1.6 matthew 1517: #
1518: # Close the csv file
1519: close($file);
1520: $r->print('<br /><br />'.
1.28 www 1521: '<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
1.6 matthew 1522: #
1523: return 1;
1524: }
1525:
1526: sub csv_output_row {
1527: my $self = shift;
1528: my ($filehandle,$rownum,@prepend) = @_;
1529: #
1530: my @rowdata = ();
1531: if (defined($rownum)) {
1532: @rowdata = $self->get_row($rownum);
1533: }
1534: my @output = ();
1535: foreach my $cell (@prepend,@rowdata) {
1536: my $value = $cell;
1537: $value = $cell->{'value'} if (ref($value));
1538: $value =~ s/\ / /gi;
1539: $value = "'".$value."'";
1540: push (@output,$value);
1541: }
1542: print $filehandle join(',',@output )."\n";
1.5 matthew 1543: return;
1.1 matthew 1544: }
1545:
1546: ############################################
1547: ## XML output routines ##
1548: ############################################
1549: sub outsheet_xml {
1550: my $self = shift;
1551: my ($r) = @_;
1552: ## Someday XML
1553: ## Will be rendered for the user
1554: ## But not on this day
1555: my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
1556: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
1.34 matthew 1557: if ($cell =~ /^template_(\w+)/) {
1.1 matthew 1558: my $col = $1;
1559: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
1560: } else {
1.33 matthew 1561: my ($col,$row) = ($cell =~ /^([A-z])(\d+)/);
1.1 matthew 1562: next if (! defined($row) || ! defined($col));
1.33 matthew 1563: next if ($row != 0);
1564: $Str .=
1565: '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>'
1.1 matthew 1566: ."\n";
1567: }
1568: }
1569: $Str.="</spreadsheet>";
1.34 matthew 1570: $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
1.1 matthew 1571: return $Str;
1572: }
1573:
1574: ############################################
1575: ### Filesystem routines ###
1576: ############################################
1577: sub parse_sheet {
1578: # $sheetxml is a scalar reference or a scalar
1579: my ($sheetxml) = @_;
1580: if (! ref($sheetxml)) {
1581: my $tmp = $sheetxml;
1582: $sheetxml = \$tmp;
1583: }
1584: my %formulas;
1585: my %sources;
1586: my $parser=HTML::TokeParser->new($sheetxml);
1587: my $token;
1588: while ($token=$parser->get_token) {
1589: if ($token->[0] eq 'S') {
1590: if ($token->[1] eq 'field') {
1591: my $cell = $token->[2]->{'col'}.$token->[2]->{'row'};
1592: my $source = $token->[2]->{'source'};
1593: my $formula = $parser->get_text('/field');
1594: $formulas{$cell} = $formula;
1595: $sources{$cell} = $source if (defined($source));
1596: $parser->get_text('/field');
1.34 matthew 1597: } elsif ($token->[1] eq 'template') {
1.1 matthew 1598: $formulas{'template_'.$token->[2]->{'col'}}=
1599: $parser->get_text('/template');
1600: }
1601: }
1602: }
1603: return (\%formulas,\%sources);
1604: }
1605:
1606: {
1607:
1608: my %spreadsheets;
1609:
1610: sub clear_spreadsheet_definition_cache {
1611: undef(%spreadsheets);
1612: }
1613:
1.13 matthew 1614: sub load_system_default_sheet {
1615: my $self = shift;
1616: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
1617: # load in the default defined spreadsheet
1618: my $sheetxml='';
1619: my $fh;
1620: if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) {
1621: $sheetxml=join('',<$fh>);
1622: $fh->close();
1623: } else {
1624: # $sheetxml='<field row="0" col="A">"Error"</field>';
1625: $sheetxml='<field row="0" col="A"></field>';
1626: }
1627: $self->filename('default_');
1628: my ($formulas,undef) = &parse_sheet(\$sheetxml);
1629: return $formulas;
1630: }
1631:
1.1 matthew 1632: sub load {
1633: my $self = shift;
1634: #
1635: my $stype = $self->{'type'};
1636: my $cnum = $self->{'cnum'};
1637: my $cdom = $self->{'cdom'};
1638: my $chome = $self->{'chome'};
1639: #
1.13 matthew 1640: my $filename = $self->filename();
1.1 matthew 1641: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1642: #
1643: # see if sheet is cached
1644: my ($formulas);
1645: if (exists($spreadsheets{$cachekey})) {
1646: $formulas = $spreadsheets{$cachekey}->{'formulas'};
1647: } else {
1648: # Not cached, need to read
1.13 matthew 1649: if (! defined($filename)) {
1650: $formulas = $self->load_system_default_sheet();
1.33 matthew 1651: } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
1.1 matthew 1652: # Load a spreadsheet definition file
1653: my $sheetxml=&Apache::lonnet::getfile
1654: (&Apache::lonnet::filelocation('',$filename));
1655: if ($sheetxml == -1) {
1656: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1657: .$self->filename().'"</field>';
1658: }
1659: ($formulas,undef) = &parse_sheet(\$sheetxml);
1.13 matthew 1660: # Get just the filename and set the sheets filename
1661: my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/);
1662: if ($self->is_default()) {
1663: $self->filename($newfilename);
1664: $self->make_default();
1665: } else {
1666: $self->filename($newfilename);
1667: }
1.1 matthew 1668: } else {
1669: # Load the spreadsheet definition file from the save file
1.13 matthew 1670: my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
1.1 matthew 1671: my ($tmp) = keys(%tmphash);
1672: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
1673: while (my ($cell,$formula) = each(%tmphash)) {
1674: $formulas->{$cell}=$formula;
1675: }
1676: } else {
1.13 matthew 1677: $formulas = $self->load_system_default_sheet();
1.1 matthew 1678: }
1679: }
1.13 matthew 1680: $filename=$self->filename(); # filename may have changed
1.1 matthew 1681: $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1682: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
1683: }
1684: $self->formulas($formulas);
1685: $self->set_row_sources();
1686: $self->set_row_numbers();
1687: }
1688:
1689: sub set_row_sources {
1690: my $self = shift;
1691: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1.22 matthew 1692: next if ($cell !~ /^A(\d+)/ || $1 < 1);
1.1 matthew 1693: my $row = $1;
1694: $self->{'row_source'}->{$row} = $value;
1695: }
1696: return;
1697: }
1698:
1.12 matthew 1699: sub set_row_numbers {
1700: my $self = shift;
1701: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1702: next if ($cell !~ /^A(\d+)$/);
1703: next if (! defined($value));
1704: $self->{'row_numbers'}->{$value} = $1;
1705: $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'});
1706: }
1707: }
1708:
1.1 matthew 1709: ##
1710: ## exportrow is *not* used to get the export row from a computed sub-sheet.
1711: ##
1712: sub exportrow {
1713: my $self = shift;
1.30 matthew 1714: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
1715: return ();
1716: }
1.1 matthew 1717: my @exportarray;
1718: foreach my $column (@UC_Columns) {
1719: push(@exportarray,$self->value($column.'0'));
1720: }
1721: return @exportarray;
1722: }
1723:
1724: sub save {
1725: my $self = shift;
1726: my ($makedef)=@_;
1727: my $cid=$self->{'cid'};
1.4 matthew 1728: # If we are saving it, it must not be temporary
1729: $self->temporary(0);
1.1 matthew 1730: if (&Apache::lonnet::allowed('opa',$cid)) {
1731: my %f=$self->formulas();
1732: my $stype = $self->{'type'};
1733: my $cnum = $self->{'cnum'};
1734: my $cdom = $self->{'cdom'};
1735: my $chome = $self->{'chome'};
1.12 matthew 1736: my $filename = $self->{'filename'};
1737: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1.1 matthew 1738: # Cache new sheet
1.13 matthew 1739: %{$spreadsheets{$cachekey}->{'formulas'}}=%f;
1.1 matthew 1740: # Write sheet
1741: foreach (keys(%f)) {
1742: delete($f{$_}) if ($f{$_} eq 'import');
1743: }
1.12 matthew 1744: my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);
1.1 matthew 1745: return $reply if ($reply ne 'ok');
1746: $reply = &Apache::lonnet::put($stype.'_spreadsheets',
1.12 matthew 1747: {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
1.1 matthew 1748: $cdom,$cnum);
1749: return $reply if ($reply ne 'ok');
1750: if ($makedef) {
1751: $reply = &Apache::lonnet::put('environment',
1.12 matthew 1752: {'spreadsheet_default_'.$stype => $filename },
1.1 matthew 1753: $cdom,$cnum);
1754: return $reply if ($reply ne 'ok');
1755: }
1756: if ($self->is_default()) {
1.22 matthew 1757: if ($self->{'type'} eq 'studentcalc') {
1758: &Apache::lonnet::expirespread('','','studentcalc','');
1759: } elsif ($self->{'type'} eq 'assesscalc') {
1760: &Apache::lonnet::expirespread('','','assesscalc','');
1.16 matthew 1761: &Apache::lonnet::expirespread('','','studentcalc','');
1762: }
1.1 matthew 1763: }
1764: return $reply;
1765: }
1766: return 'unauthorized';
1767: }
1768:
1769: } # end of scope for %spreadsheets
1770:
1771: sub save_tmp {
1772: my $self = shift;
1.9 matthew 1773: my $filename=$ENV{'user.name'}.'_'.
1.19 matthew 1774: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1.1 matthew 1775: $self->{'filename'};
1.9 matthew 1776: $filename=~s/\W/\_/g;
1777: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1.4 matthew 1778: $self->temporary(1);
1.1 matthew 1779: my $fh;
1.9 matthew 1780: if ($fh=Apache::File->new('>'.$filename)) {
1.1 matthew 1781: my %f = $self->formulas();
1782: while( my ($cell,$formula) = each(%f)) {
1783: next if ($formula eq 'import');
1784: print $fh &Apache::lonnet::escape($cell)."=".
1785: &Apache::lonnet::escape($formula)."\n";
1786: }
1787: $fh->close();
1788: }
1789: }
1790:
1791: sub load_tmp {
1792: my $self = shift;
1793: my $filename=$ENV{'user.name'}.'_'.
1.19 matthew 1794: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1.1 matthew 1795: $self->{'filename'};
1796: $filename=~s/\W/\_/g;
1797: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1798: my %formulas = ();
1799: if (my $spreadsheet_file = Apache::File->new($filename)) {
1800: while (<$spreadsheet_file>) {
1801: chomp;
1802: my ($cell,$formula) = split(/=/);
1803: $cell = &Apache::lonnet::unescape($cell);
1804: $formula = &Apache::lonnet::unescape($formula);
1805: $formulas{$cell} = $formula;
1806: }
1807: $spreadsheet_file->close();
1808: }
1.4 matthew 1809: # flag the sheet as temporary
1810: $self->temporary(1);
1.1 matthew 1811: $self->formulas(\%formulas);
1812: $self->set_row_sources();
1813: $self->set_row_numbers();
1814: return;
1.4 matthew 1815: }
1816:
1817: sub temporary {
1818: my $self=shift;
1819: if (@_) {
1820: ($self->{'temporary'})= @_;
1821: }
1822: return $self->{'temporary'};
1.1 matthew 1823: }
1824:
1825: sub modify_cell {
1826: # studentcalc overrides this
1827: my $self = shift;
1828: my ($cell,$formula) = @_;
1829: if ($cell =~ /([A-z])\-/) {
1830: $cell = 'template_'.$1;
1831: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) {
1832: return;
1833: }
1834: $self->set_formula($cell,$formula);
1835: $self->rebuild_stats();
1836: return;
1837: }
1838:
1839: ###########################################
1840: # othersheets: Returns the list of other spreadsheets available
1841: ###########################################
1842: sub othersheets {
1843: my $self = shift();
1844: my ($stype) = @_;
1845: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/);
1846: #
1847: my @alternatives=();
1848: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',
1849: $self->{'cdom'}, $self->{'cnum'});
1850: my ($tmp) = keys(%results);
1.2 matthew 1851: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
1.28 www 1852: @alternatives = (&mt('Default'));
1.2 matthew 1853: } else {
1.28 www 1854: @alternatives = (&mt('Default'), sort (keys(%results)));
1.1 matthew 1855: }
1856: return @alternatives;
1.3 matthew 1857: }
1858:
1859: sub blackout {
1860: my $self = shift;
1861: $self->{'blackout'} = $_[0] if (@_);
1862: return $self->{'blackout'};
1.1 matthew 1863: }
1864:
1865: sub get_row {
1866: my $self = shift;
1867: my ($n)=@_;
1868: my @cols=();
1869: foreach my $col (@UC_Columns,@LC_Columns) {
1870: my $cell = $col.$n;
1871: push(@cols,{ name => $cell,
1872: formula => $self->formula($cell),
1873: value => $self->value($cell)});
1874: }
1875: return @cols;
1876: }
1877:
1878: sub get_template_row {
1879: my $self = shift;
1880: my @cols=();
1881: foreach my $col (@UC_Columns,@LC_Columns) {
1882: my $cell = 'template_'.$col;
1883: push(@cols,{ name => $cell,
1884: formula => $self->formula($cell),
1885: value => $self->formula($cell) });
1886: }
1887: return @cols;
1888: }
1889:
1.12 matthew 1890: sub need_to_save {
1.1 matthew 1891: my $self = shift;
1.12 matthew 1892: if ($self->{'new_rows'} && ! $self->temporary()) {
1893: return 1;
1.1 matthew 1894: }
1.12 matthew 1895: return 0;
1.1 matthew 1896: }
1897:
1898: sub get_row_number_from_key {
1899: my $self = shift;
1900: my ($key) = @_;
1901: if (! exists($self->{'row_numbers'}->{$key}) ||
1902: ! defined($self->{'row_numbers'}->{$key})) {
1903: # I used to set $f here to the new value, but the key passed for lookup
1904: # may not be the key we need to save
1905: $self->{'maxrow'}++;
1906: $self->{'row_numbers'}->{$key} = $self->{'maxrow'};
1.13 matthew 1907: # $self->logthis('added row '.$self->{'row_numbers'}->{$key}.
1908: # ' for '.$key);
1.12 matthew 1909: $self->{'new_rows'} = 1;
1.1 matthew 1910: }
1911: return $self->{'row_numbers'}->{$key};
1912: }
1913:
1914: 1;
1915:
1916: __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