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