1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
4: # 11/11,11/15,11/27,12/04 Gerd Kortemeyer
5:
6: package Apache::lonspreadsheet;
7:
8: use strict;
9: use Safe;
10: use Safe::Hole;
11: use Opcode;
12: use Apache::lonnet;
13: use Apache::Constants qw(:common);
14: use HTML::TokeParser;
15:
16:
17:
18: sub initsheet {
19: my $safeeval = new Safe;
20: my $safehole = new Safe::Hole;
21: $safeeval->permit("entereval");
22: $safeeval->permit(":base_math");
23: $safeeval->permit("sort");
24: $safeeval->deny(":base_io");
25: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
26: my $code=<<'ENDDEFS';
27: # ---------------------------------------------------- Inside of the safe space
28:
29: #
30: # f: formulas
31: # t: intermediate format (variable references expanded)
32: # v: output values
33: #
34:
35: %v=();
36: %t=();
37: %f=();
38:
39: sub mask {
40: my ($lower,$upper)=@_;
41:
42: $lower=~/([A-Z]|\*)(\d+|\*)/;
43: my $la=$1;
44: my $ld=$2;
45:
46: $upper=~/([A-Z]|\*)(\d+|\*)/;
47: my $ua=$1;
48: my $ud=$2;
49: my $alpha='';
50: my $num='';
51:
52: if (($la eq '*') || ($ua eq '*')) {
53: $alpha='[A-Z]';
54: } else {
55: $alpha='['.$la.'-'.$ua.']';
56: }
57:
58: if (($ld eq '*') || ($ud eq '*')) {
59: $num='\d+';
60: } else {
61: if (length($ld)!=length($ud)) {
62: $num.='(';
63: map {
64: $num.='['.$_.'-9]';
65: } ($ld=~m/\d/g);
66: if (length($ud)-length($ld)>1) {
67: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
68: }
69: $num.='|';
70: map {
71: $num.='[0-'.$_.']';
72: } ($ud=~m/\d/g);
73: $num.=')';
74: } else {
75: my @lda=($ld=~m/\d/g);
76: my @uda=($ud=~m/\d/g);
77: my $i; $j=0;
78: for ($i=0;$i<=$#lda;$i++) {
79: if ($lda[$i]==$uda[$i]) {
80: $num.=$lda[$i];
81: $j=$i;
82: }
83: }
84: if ($j<$#lda-1) {
85: $num.='('.$lda[$j+1];
86: for ($i=$j+2;$i<=$#lda;$i++) {
87: $num.='['.$lda[$i].'-9]';
88: }
89: if ($uda[$j+1]-$lda[$j+1]>1) {
90: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
91: ($#lda-$j-1).'}';
92: }
93: $num.='|'.$uda[$j+1];
94: for ($i=$j+2;$i<=$#uda;$i++) {
95: $num.='[0-'.$uda[$i].']';
96: }
97: $num.=')';
98: } else {
99: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
100: }
101: }
102: }
103: return '^'.$alpha.$num."\$";
104: }
105:
106: sub NUM {
107: my $mask=mask(@_);
108: my $num=0;
109: map {
110: $num++;
111: } grep /$mask/,keys %v;
112: return $num;
113: }
114:
115: sub BIN {
116: my ($low,$high,$lower,$upper)=@_;
117: my $mask=mask($lower,$upper);
118: my $num=0;
119: map {
120: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
121: $num++;
122: }
123: } grep /$mask/,keys %v;
124: return $num;
125: }
126:
127:
128: sub SUM {
129: my $mask=mask(@_);
130: my $sum=0;
131: map {
132: $sum+=$v{$_};
133: } grep /$mask/,keys %v;
134: return $sum;
135: }
136:
137: sub MEAN {
138: my $mask=mask(@_);
139: my $sum=0; my $num=0;
140: map {
141: $sum+=$v{$_};
142: $num++;
143: } grep /$mask/,keys %v;
144: if ($num) {
145: return $sum/$num;
146: } else {
147: return undef;
148: }
149: }
150:
151: sub STDDEV {
152: my $mask=mask(@_);
153: my $sum=0; my $num=0;
154: map {
155: $sum+=$v{$_};
156: $num++;
157: } grep /$mask/,keys %v;
158: unless ($num>1) { return undef; }
159: my $mean=$sum/$num;
160: $sum=0;
161: map {
162: $sum+=($v{$_}-$mean)**2;
163: } grep /$mask/,keys %v;
164: return sqrt($sum/($num-1));
165: }
166:
167: sub PROD {
168: my $mask=mask(@_);
169: my $prod=1;
170: map {
171: $prod*=$v{$_};
172: } grep /$mask/,keys %v;
173: return $prod;
174: }
175:
176: sub MAX {
177: my $mask=mask(@_);
178: my $max='-';
179: map {
180: unless ($max) { $max=$v{$_}; }
181: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
182: } grep /$mask/,keys %v;
183: return $max;
184: }
185:
186: sub MIN {
187: my $mask=mask(@_);
188: my $min='-';
189: map {
190: unless ($max) { $max=$v{$_}; }
191: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
192: } grep /$mask/,keys %v;
193: return $min;
194: }
195:
196: sub SUMMAX {
197: my ($num,$lower,$upper)=@_;
198: my $mask=mask($lower,$upper);
199: my @inside=();
200: map {
201: $inside[$#inside+1]=$v{$_};
202: } grep /$mask/,keys %v;
203: @inside=sort(@inside);
204: my $sum=0; my $i;
205: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
206: $sum+=$inside[$i];
207: }
208: return $sum;
209: }
210:
211: sub SUMMIN {
212: my ($num,$lower,$upper)=@_;
213: my $mask=mask($lower,$upper);
214: my @inside=();
215: map {
216: $inside[$#inside+1]=$v{$_};
217: } grep /$mask/,keys %v;
218: @inside=sort(@inside);
219: my $sum=0; my $i;
220: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
221: $sum+=$inside[$i];
222: }
223: return $sum;
224: }
225:
226: sub sett {
227: %t=();
228: map {
229: if ($f{$_}) {
230: $t{$_}=$f{$_};
231: $t{$_}=~s/\.+/\,/g;
232: $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
233: }
234: } keys %f;
235: }
236:
237: sub calc {
238: %v=();
239: &sett();
240: my $notfinished=1;
241: my $depth=0;
242: while ($notfinished) {
243: $notfinished=0;
244: map {
245: my $old=$v{$_};
246: $v{$_}=eval($t{$_});
247: if ($@) {
248: %v=();
249: return $@;
250: }
251: if ($v{$_} ne $old) { $notfinished=1; }
252: } keys %t;
253: $depth++;
254: if ($depth>100) {
255: %v=();
256: return 'Maximum calculation depth exceeded';
257: }
258: }
259: return '';
260: }
261:
262: # ------------------------------------------- End of "Inside of the safe space"
263: ENDDEFS
264: $safeeval->reval($code);
265: return $safeeval;
266: }
267:
268: # ------------------------------------------------ Add or change formula values
269:
270: sub setformulas {
271: my ($safeeval,@f)=@_;
272: $safeeval->reval('%f=(%f,'."('".join("','",@f)."'));");
273: }
274:
275: # ------------------------------------------------------- Calculate spreadsheet
276:
277: sub calcsheet {
278: my $safeeval=shift;
279: $safeeval->reval('&calc();');
280: }
281:
282: # ------------------------------------------------------------------ Get values
283:
284: sub getvalues {
285: my $safeeval=shift;
286: return $safeeval->reval('%v');
287: }
288:
289: # ---------------------------------------------------------------- Get formulas
290:
291: sub getformulas {
292: my $safeeval=shift;
293: return $safeeval->reval('%f');
294: }
295:
296: # ------------------------------------------------------------ Read spreadsheet
297:
298: sub readf {
299: my $fn=shift;
300: my %f=();
301: my $content;
302: {
303: my $fh=Apache::File->new($fn);
304: $content=join('',<$fh>);
305: }
306: {
307: my $parser=HTML::TokeParser->new(\$content);
308: my $token;
309: while ($token=$parser->get_token) {
310: if ($token->[0] eq 'S') {
311: if ($token->[1] eq 'field') {
312: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
313: $parser->get_text('/field');
314: }
315: }
316: }
317: }
318: }
319:
320: # --------------------------------------------------------------- Read metadata
321:
322: sub readmeta {
323: my $fn=shift;
324: unless ($fn=~/\.meta$/) { $fn.='meta'; }
325: my $content;
326: my %returnhash=();
327: {
328: my $fh=Apache::File->new($fn);
329: $content=join('',<$fh>);
330: }
331: my $parser=HTML::TokeParser->new(\$content);
332: my $token;
333: while ($token=$parser->get_token) {
334: if ($token->[0] eq 'S') {
335: my $entry=$token->[1];
336: if (($entry eq 'stores') || ($entry eq 'parameter')) {
337: my $unikey=$entry;
338: $unikey.='_'.$token->[2]->{'part'};
339: $unikey.='_'.$token->[2]->{'name'};
340: $returnhash{$unikey}=$token->[2]->{'display'};
341: }
342: }
343: }
344: return %returnhash;
345: }
346:
347:
348: # -----------------------------------------------------------------------------
349:
350: sub handler {
351:
352: my $r=shift;
353:
354: $r->content_type('text/html');
355: $r->send_http_header;
356:
357: $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
358: $r->print('<body bgcolor="#FFFFFF">');
359:
360: my $sheetone=initsheet();
361:
362: &setformulas($sheetone,('A1' => '5', 'B2' => '6', 'C4' => 'A1+B2'));
363: $r->print(&calcsheet($sheetone));
364: my %output=&getformulas($sheetone);
365:
366: $r->print('FORM:'.$output{'A1'}.' '.$output{'B2'}.' '.$output{'C4'});
367:
368: my %output=&getvalues($sheetone);
369:
370: $r->print('<br>OUT:'.$output{'A1'}.' '.$output{'B2'}.' '.$output{'C4'});
371:
372: $r->print('</body></html>');
373: return OK;
374: }
375:
376: 1;
377: __END__
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonspreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface