Annotation of loncom/interface/spreadsheet/Spreadsheet.pm, revision 1.34
1.1 matthew 1: #
1.34 ! matthew 2: # $Id: Spreadsheet.pm,v 1.33 2004/01/14 16:47:39 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: 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: }
1.30 matthew 682: return 'okay';
1.1 matthew 683: }
684:
685: # ------------------------------------------- End of "Inside of the safe space"
686: ENDDEFS
1.25 matthew 687: $safeeval->reval($code);
688: }
1.1 matthew 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: }
1.25 matthew 702:
703: }
704:
1.1 matthew 705: ######################################################
706:
707: =pod
708:
709: =back
710:
711: =cut
712:
713: ######################################################
714:
715:
716: ######################################################
717:
1.26 matthew 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
1.1 matthew 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: #
1.26 matthew 743: my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);
744: my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);
1.1 matthew 745: #
746: my $alpha='';
747: my $num='';
748: #
1.26 matthew 749: # Do not put parenthases around $alpha.
750: # $num depends on the value in $1.
1.1 matthew 751: if (($la eq '*') || ($ua eq '*')) {
1.26 matthew 752: $alpha='[A-z]';
1.1 matthew 753: } else {
1.27 matthew 754: if ($la gt $ua) {
755: my $tmp = $ua;
756: $ua = $la;
757: $la = $ua;
758: }
1.26 matthew 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)';
1.1 matthew 782: } else {
1.26 matthew 783: $num = '(\d+)';
1.1 matthew 784: }
1.26 matthew 785: my $expression = '^'.$alpha.$num.'$';
1.1 matthew 786: $memoizer{$key} = $expression;
787: return $expression;
1.26 matthew 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;
1.1 matthew 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 ) {
1.20 matthew 816: if ($varname=~/^(parameter|stores|timestamp)/) {
817: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
1.1 matthew 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 = ();
1.14 matthew 847: my @values = ();
1.1 matthew 848: $#matches = -1;
849: study $expression;
1.14 matthew 850: while (my($parameter,$value) = each(%{$self->{'constants'}})) {
851: next if ($parameter !~ /$expression/);
852: push(@matches,$parameter);
853: push(@values,$value);
1.1 matthew 854: }
855: if (scalar(@matches) == 0) {
1.10 matthew 856: $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';
1.1 matthew 857: } elsif (scalar(@matches) == 1) {
858: # why do we not do this lookup here, instead of delaying it?
1.14 matthew 859: $returnvalue = $values[0];
1.1 matthew 860: } elsif (scalar(@matches) > 0) {
861: # more than one match. Look for a concise one
862: $returnvalue = "'non-unique parameter name : $expression'";
1.14 matthew 863: for (my $i=0; $i<=$#matches;$i++) {
864: if ($matches[$i] =~ /^$expression$/) {
1.1 matthew 865: # why do we not do this lookup here?
1.14 matthew 866: $returnvalue = $values[$i];
1.1 matthew 867: }
868: }
869: } else {
870: # There was a negative number of matches, which indicates
871: # something is wrong with reality. Better warn the user.
1.14 matthew 872: $returnvalue = '"bizzare parameter: '.$expression.'"';
1.1 matthew 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());
1.30 matthew 1143: if ($result ne 'okay') {
1144: $self->set_calcerror($result);
1145: }
1.1 matthew 1146: return $result;
1147: }
1148:
1.30 matthew 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:
1.1 matthew 1186: ###########################################################
1187: ##
1188: ## Output Helpers
1189: ##
1190: ###########################################################
1.5 matthew 1191: sub display {
1192: my $self = shift;
1193: my ($r) = @_;
1194: my $outputmode = 'html';
1.31 matthew 1195: foreach ($self->output_options()) {
1196: if ($ENV{'form.output_format'} eq $_->{'value'}) {
1197: $outputmode = $_->{'value'};
1198: last;
1199: }
1.5 matthew 1200: }
1201: if ($outputmode eq 'html') {
1.31 matthew 1202: $self->compute($r);
1.5 matthew 1203: $self->outsheet_html($r);
1.31 matthew 1204: } elsif ($outputmode eq 'htmlclasslist') {
1205: # No computation neccessary... This is kludgy
1206: $self->outsheet_htmlclasslist($r);
1.5 matthew 1207: } elsif ($outputmode eq 'excel') {
1.31 matthew 1208: $self->compute($r);
1.5 matthew 1209: $self->outsheet_excel($r);
1210: } elsif ($outputmode eq 'csv') {
1.31 matthew 1211: $self->compute($r);
1.5 matthew 1212: $self->outsheet_csv($r);
1.33 matthew 1213: } elsif ($outputmode eq 'xml') {
1214: # $self->compute($r);
1215: $self->outsheet_xml($r);
1.5 matthew 1216: }
1.22 matthew 1217: $self->cleanup();
1.5 matthew 1218: return;
1219: }
1220:
1.1 matthew 1221: ############################################
1222: ## HTML output routines ##
1223: ############################################
1.30 matthew 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:
1.1 matthew 1236: sub html_export_row {
1237: my $self = shift();
1.17 matthew 1238: my ($color) = @_;
1239: $color = '#CCCCFF' if (! defined($color));
1.1 matthew 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]/) {
1.17 matthew 1245: $row_html .= '<td bgcolor="'.$color.'">'.
1246: &html_editable_cell($cell,$color,$allowed).'</td>';
1.1 matthew 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'});
1.17 matthew 1258: my ($num_uneditable,$importcolor) = @_;
1.1 matthew 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) {
1.17 matthew 1265: $row_html .= '<td bgcolor="'.$importcolor.'">'.
1.7 matthew 1266: &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
1.1 matthew 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);
1.18 matthew 1297: #
1.1 matthew 1298: # The formula will be parsed by the browser twice before being
1.18 matthew 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.
1.21 matthew 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;
1.18 matthew 1306: # Escape it again - this time the only encodable character is '&'
1307: $formula =~ s/\&/\&/g;
1.1 matthew 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();
1.17 matthew 1323: my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;
1.1 matthew 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;
1.17 matthew 1328: my $color = $importcolor;
1329: if ($row == 0) {
1330: $color = $exportcolor;
1331: }
1332: $color = '#FFDDDD' if (! defined($color));
1.1 matthew 1333: foreach my $cell (@rowdata) {
1334: if ($num_cols_output++ < $num_uneditable) {
1.17 matthew 1335: $row_html .= '<td bgcolor="'.$color.'">';
1.1 matthew 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:
1.5 matthew 1346: sub html_header {
1347: my $self = shift;
1348: return '' if (! $ENV{'request.role.adv'});
1349: return "<table>\n".
1.29 matthew 1350: '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
1.31 matthew 1351: '<tr><td>'.$self->output_selector()."</td></tr>\n".
1.5 matthew 1352: "</table>\n";
1353: }
1354:
1.31 matthew 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'},
1.33 matthew 1363: # {value => 'xml',
1364: # description => 'XML'},
1.31 matthew 1365: {value => 'csv',
1366: description => 'Comma Separated Values'},);
1367: }
1368:
1.5 matthew 1369: sub output_selector {
1.31 matthew 1370: my $self = shift();
1.5 matthew 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: }
1.31 matthew 1378: foreach ($self->output_options()) {
1379: $output_selector.='<option value="'.$_->{'value'}.'"';
1380: if ($_->{'value'} eq $default) {
1.5 matthew 1381: $output_selector .= ' selected';
1382: }
1.31 matthew 1383: $output_selector .= ">".&mt($_->{'description'})."</option>\n";
1.5 matthew 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:
1.1 matthew 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: $!");
1.28 www 1416: $r->print(&mt("Problems creating new Excel file. ".
1.1 matthew 1417: "This error has been logged. ".
1.28 www 1418: "Please alert your LON-CAPA administrator"));
1.1 matthew 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);
1.31 matthew 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;
1.5 matthew 1440: }
1441:
1442: sub outsheet_excel {
1443: my $self = shift;
1444: my ($r) = @_;
1.23 matthew 1445: my $connection = $r->connection();
1.32 matthew 1446: #
1447: $r->print($self->html_report_error());
1448: $r->rflush();
1449: #
1.28 www 1450: $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
1.5 matthew 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: #
1.23 matthew 1473: $self->excel_rows($connection,$worksheet,$cols_output,$rows_output);
1.5 matthew 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");
1.6 matthew 1482: return;
1483: }
1484:
1485: #################################
1486: ## CSV output routines ##
1487: #################################
1488: sub outsheet_csv {
1489: my $self = shift;
1490: my ($r) = @_;
1.23 matthew 1491: my $connection = $r->connection();
1.32 matthew 1492: #
1493: $r->print($self->html_report_error());
1494: $r->rflush();
1495: #
1.6 matthew 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 $!");
1.28 www 1506: $r->print(&mt("Problems occured in writing the csv file. ".
1.6 matthew 1507: "This error has been logged. ".
1.28 www 1508: "Please alert your LON-CAPA administrator."));
1.6 matthew 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
1.23 matthew 1519: $self->csv_rows($connection,$file);
1.6 matthew 1520: #
1521: # Close the csv file
1522: close($file);
1523: $r->print('<br /><br />'.
1.28 www 1524: '<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
1.6 matthew 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";
1.5 matthew 1546: return;
1.1 matthew 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'}})) {
1.34 ! matthew 1560: if ($cell =~ /^template_(\w+)/) {
1.1 matthew 1561: my $col = $1;
1562: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
1563: } else {
1.33 matthew 1564: my ($col,$row) = ($cell =~ /^([A-z])(\d+)/);
1.1 matthew 1565: next if (! defined($row) || ! defined($col));
1.33 matthew 1566: next if ($row != 0);
1567: $Str .=
1568: '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>'
1.1 matthew 1569: ."\n";
1570: }
1571: }
1572: $Str.="</spreadsheet>";
1.34 ! matthew 1573: $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
1.1 matthew 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');
1.34 ! matthew 1600: } elsif ($token->[1] eq 'template') {
1.1 matthew 1601: $formulas{'template_'.$token->[2]->{'col'}}=
1602: $parser->get_text('/template');
1603: }
1604: }
1605: }
1606: return (\%formulas,\%sources);
1607: }
1608:
1609: {
1610:
1611: my %spreadsheets;
1612:
1613: sub clear_spreadsheet_definition_cache {
1614: undef(%spreadsheets);
1615: }
1616:
1.13 matthew 1617: sub load_system_default_sheet {
1618: my $self = shift;
1619: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
1620: # load in the default defined spreadsheet
1621: my $sheetxml='';
1622: my $fh;
1623: if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) {
1624: $sheetxml=join('',<$fh>);
1625: $fh->close();
1626: } else {
1627: # $sheetxml='<field row="0" col="A">"Error"</field>';
1628: $sheetxml='<field row="0" col="A"></field>';
1629: }
1630: $self->filename('default_');
1631: my ($formulas,undef) = &parse_sheet(\$sheetxml);
1632: return $formulas;
1633: }
1634:
1.1 matthew 1635: sub load {
1636: my $self = shift;
1637: #
1638: my $stype = $self->{'type'};
1639: my $cnum = $self->{'cnum'};
1640: my $cdom = $self->{'cdom'};
1641: my $chome = $self->{'chome'};
1642: #
1.13 matthew 1643: my $filename = $self->filename();
1.1 matthew 1644: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1645: #
1646: # see if sheet is cached
1647: my ($formulas);
1648: if (exists($spreadsheets{$cachekey})) {
1649: $formulas = $spreadsheets{$cachekey}->{'formulas'};
1650: } else {
1651: # Not cached, need to read
1.13 matthew 1652: if (! defined($filename)) {
1653: $formulas = $self->load_system_default_sheet();
1.33 matthew 1654: } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
1.1 matthew 1655: # Load a spreadsheet definition file
1656: my $sheetxml=&Apache::lonnet::getfile
1657: (&Apache::lonnet::filelocation('',$filename));
1658: if ($sheetxml == -1) {
1659: $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
1660: .$self->filename().'"</field>';
1661: }
1662: ($formulas,undef) = &parse_sheet(\$sheetxml);
1.13 matthew 1663: # Get just the filename and set the sheets filename
1664: my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/);
1665: if ($self->is_default()) {
1666: $self->filename($newfilename);
1667: $self->make_default();
1668: } else {
1669: $self->filename($newfilename);
1670: }
1.1 matthew 1671: } else {
1672: # Load the spreadsheet definition file from the save file
1.13 matthew 1673: my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
1.1 matthew 1674: my ($tmp) = keys(%tmphash);
1675: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
1676: while (my ($cell,$formula) = each(%tmphash)) {
1677: $formulas->{$cell}=$formula;
1678: }
1679: } else {
1.13 matthew 1680: $formulas = $self->load_system_default_sheet();
1.1 matthew 1681: }
1682: }
1.13 matthew 1683: $filename=$self->filename(); # filename may have changed
1.1 matthew 1684: $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1685: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas};
1686: }
1687: $self->formulas($formulas);
1688: $self->set_row_sources();
1689: $self->set_row_numbers();
1690: }
1691:
1692: sub set_row_sources {
1693: my $self = shift;
1694: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1.22 matthew 1695: next if ($cell !~ /^A(\d+)/ || $1 < 1);
1.1 matthew 1696: my $row = $1;
1697: $self->{'row_source'}->{$row} = $value;
1698: }
1699: return;
1700: }
1701:
1.12 matthew 1702: sub set_row_numbers {
1703: my $self = shift;
1704: while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
1705: next if ($cell !~ /^A(\d+)$/);
1706: next if (! defined($value));
1707: $self->{'row_numbers'}->{$value} = $1;
1708: $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'});
1709: }
1710: }
1711:
1.1 matthew 1712: ##
1713: ## exportrow is *not* used to get the export row from a computed sub-sheet.
1714: ##
1715: sub exportrow {
1716: my $self = shift;
1.30 matthew 1717: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
1718: return ();
1719: }
1.1 matthew 1720: my @exportarray;
1721: foreach my $column (@UC_Columns) {
1722: push(@exportarray,$self->value($column.'0'));
1723: }
1724: return @exportarray;
1725: }
1726:
1727: sub save {
1728: my $self = shift;
1729: my ($makedef)=@_;
1730: my $cid=$self->{'cid'};
1.4 matthew 1731: # If we are saving it, it must not be temporary
1732: $self->temporary(0);
1.1 matthew 1733: if (&Apache::lonnet::allowed('opa',$cid)) {
1734: my %f=$self->formulas();
1735: my $stype = $self->{'type'};
1736: my $cnum = $self->{'cnum'};
1737: my $cdom = $self->{'cdom'};
1738: my $chome = $self->{'chome'};
1.12 matthew 1739: my $filename = $self->{'filename'};
1740: my $cachekey = join('_',($cnum,$cdom,$stype,$filename));
1.1 matthew 1741: # Cache new sheet
1.13 matthew 1742: %{$spreadsheets{$cachekey}->{'formulas'}}=%f;
1.1 matthew 1743: # Write sheet
1744: foreach (keys(%f)) {
1745: delete($f{$_}) if ($f{$_} eq 'import');
1746: }
1.12 matthew 1747: my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);
1.1 matthew 1748: return $reply if ($reply ne 'ok');
1749: $reply = &Apache::lonnet::put($stype.'_spreadsheets',
1.12 matthew 1750: {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
1.1 matthew 1751: $cdom,$cnum);
1752: return $reply if ($reply ne 'ok');
1753: if ($makedef) {
1754: $reply = &Apache::lonnet::put('environment',
1.12 matthew 1755: {'spreadsheet_default_'.$stype => $filename },
1.1 matthew 1756: $cdom,$cnum);
1757: return $reply if ($reply ne 'ok');
1758: }
1759: if ($self->is_default()) {
1.22 matthew 1760: if ($self->{'type'} eq 'studentcalc') {
1761: &Apache::lonnet::expirespread('','','studentcalc','');
1762: } elsif ($self->{'type'} eq 'assesscalc') {
1763: &Apache::lonnet::expirespread('','','assesscalc','');
1.16 matthew 1764: &Apache::lonnet::expirespread('','','studentcalc','');
1765: }
1.1 matthew 1766: }
1767: return $reply;
1768: }
1769: return 'unauthorized';
1770: }
1771:
1772: } # end of scope for %spreadsheets
1773:
1774: sub save_tmp {
1775: my $self = shift;
1.9 matthew 1776: my $filename=$ENV{'user.name'}.'_'.
1.19 matthew 1777: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1.1 matthew 1778: $self->{'filename'};
1.9 matthew 1779: $filename=~s/\W/\_/g;
1780: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1.4 matthew 1781: $self->temporary(1);
1.1 matthew 1782: my $fh;
1.9 matthew 1783: if ($fh=Apache::File->new('>'.$filename)) {
1.1 matthew 1784: my %f = $self->formulas();
1785: while( my ($cell,$formula) = each(%f)) {
1786: next if ($formula eq 'import');
1787: print $fh &Apache::lonnet::escape($cell)."=".
1788: &Apache::lonnet::escape($formula)."\n";
1789: }
1790: $fh->close();
1791: }
1792: }
1793:
1794: sub load_tmp {
1795: my $self = shift;
1796: my $filename=$ENV{'user.name'}.'_'.
1.19 matthew 1797: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
1.1 matthew 1798: $self->{'filename'};
1799: $filename=~s/\W/\_/g;
1800: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
1801: my %formulas = ();
1802: if (my $spreadsheet_file = Apache::File->new($filename)) {
1803: while (<$spreadsheet_file>) {
1804: chomp;
1805: my ($cell,$formula) = split(/=/);
1806: $cell = &Apache::lonnet::unescape($cell);
1807: $formula = &Apache::lonnet::unescape($formula);
1808: $formulas{$cell} = $formula;
1809: }
1810: $spreadsheet_file->close();
1811: }
1.4 matthew 1812: # flag the sheet as temporary
1813: $self->temporary(1);
1.1 matthew 1814: $self->formulas(\%formulas);
1815: $self->set_row_sources();
1816: $self->set_row_numbers();
1817: return;
1.4 matthew 1818: }
1819:
1820: sub temporary {
1821: my $self=shift;
1822: if (@_) {
1823: ($self->{'temporary'})= @_;
1824: }
1825: return $self->{'temporary'};
1.1 matthew 1826: }
1827:
1828: sub modify_cell {
1829: # studentcalc overrides this
1830: my $self = shift;
1831: my ($cell,$formula) = @_;
1832: if ($cell =~ /([A-z])\-/) {
1833: $cell = 'template_'.$1;
1834: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) {
1835: return;
1836: }
1837: $self->set_formula($cell,$formula);
1838: $self->rebuild_stats();
1839: return;
1840: }
1841:
1842: ###########################################
1843: # othersheets: Returns the list of other spreadsheets available
1844: ###########################################
1845: sub othersheets {
1846: my $self = shift();
1847: my ($stype) = @_;
1848: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/);
1849: #
1850: my @alternatives=();
1851: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',
1852: $self->{'cdom'}, $self->{'cnum'});
1853: my ($tmp) = keys(%results);
1.2 matthew 1854: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
1.28 www 1855: @alternatives = (&mt('Default'));
1.2 matthew 1856: } else {
1.28 www 1857: @alternatives = (&mt('Default'), sort (keys(%results)));
1.1 matthew 1858: }
1859: return @alternatives;
1.3 matthew 1860: }
1861:
1862: sub blackout {
1863: my $self = shift;
1864: $self->{'blackout'} = $_[0] if (@_);
1865: return $self->{'blackout'};
1.1 matthew 1866: }
1867:
1868: sub get_row {
1869: my $self = shift;
1870: my ($n)=@_;
1871: my @cols=();
1872: foreach my $col (@UC_Columns,@LC_Columns) {
1873: my $cell = $col.$n;
1874: push(@cols,{ name => $cell,
1875: formula => $self->formula($cell),
1876: value => $self->value($cell)});
1877: }
1878: return @cols;
1879: }
1880:
1881: sub get_template_row {
1882: my $self = shift;
1883: my @cols=();
1884: foreach my $col (@UC_Columns,@LC_Columns) {
1885: my $cell = 'template_'.$col;
1886: push(@cols,{ name => $cell,
1887: formula => $self->formula($cell),
1888: value => $self->formula($cell) });
1889: }
1890: return @cols;
1891: }
1892:
1.12 matthew 1893: sub need_to_save {
1.1 matthew 1894: my $self = shift;
1.12 matthew 1895: if ($self->{'new_rows'} && ! $self->temporary()) {
1896: return 1;
1.1 matthew 1897: }
1.12 matthew 1898: return 0;
1.1 matthew 1899: }
1900:
1901: sub get_row_number_from_key {
1902: my $self = shift;
1903: my ($key) = @_;
1904: if (! exists($self->{'row_numbers'}->{$key}) ||
1905: ! defined($self->{'row_numbers'}->{$key})) {
1906: # I used to set $f here to the new value, but the key passed for lookup
1907: # may not be the key we need to save
1908: $self->{'maxrow'}++;
1909: $self->{'row_numbers'}->{$key} = $self->{'maxrow'};
1.13 matthew 1910: # $self->logthis('added row '.$self->{'row_numbers'}->{$key}.
1911: # ' for '.$key);
1.12 matthew 1912: $self->{'new_rows'} = 1;
1.1 matthew 1913: }
1914: return $self->{'row_numbers'}->{$key};
1915: }
1916:
1917: 1;
1918:
1919: __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