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