Annotation of loncom/interface/lonspreadsheet.pm, revision 1.5
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.5 ! www 4: # 11/11,11/15,11/27,12/04,12/05 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:
1.5 ! www 16: # =============================================================================
! 17: # ===================================== Implements an instance of a spreadsheet
1.4 www 18:
19: sub initsheet {
20: my $safeeval = new Safe;
21: my $safehole = new Safe::Hole;
22: $safeeval->permit("entereval");
23: $safeeval->permit(":base_math");
24: $safeeval->permit("sort");
25: $safeeval->deny(":base_io");
26: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
27: my $code=<<'ENDDEFS';
28: # ---------------------------------------------------- Inside of the safe space
29:
1.3 www 30: #
31: # f: formulas
1.4 www 32: # t: intermediate format (variable references expanded)
33: # v: output values
1.3 www 34: #
35:
1.4 www 36: %v=();
37: %t=();
38: %f=();
1.5 ! www 39: $sheettype='';
! 40: $filename='';
1.1 www 41:
42: sub mask {
43: my ($lower,$upper)=@_;
44:
45: $lower=~/([A-Z]|\*)(\d+|\*)/;
46: my $la=$1;
47: my $ld=$2;
48:
49: $upper=~/([A-Z]|\*)(\d+|\*)/;
50: my $ua=$1;
51: my $ud=$2;
52: my $alpha='';
53: my $num='';
54:
55: if (($la eq '*') || ($ua eq '*')) {
56: $alpha='[A-Z]';
57: } else {
58: $alpha='['.$la.'-'.$ua.']';
59: }
60:
61: if (($ld eq '*') || ($ud eq '*')) {
62: $num='\d+';
63: } else {
64: if (length($ld)!=length($ud)) {
65: $num.='(';
66: map {
67: $num.='['.$_.'-9]';
68: } ($ld=~m/\d/g);
69: if (length($ud)-length($ld)>1) {
70: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
71: }
72: $num.='|';
73: map {
74: $num.='[0-'.$_.']';
75: } ($ud=~m/\d/g);
76: $num.=')';
77: } else {
78: my @lda=($ld=~m/\d/g);
79: my @uda=($ud=~m/\d/g);
80: my $i; $j=0;
81: for ($i=0;$i<=$#lda;$i++) {
82: if ($lda[$i]==$uda[$i]) {
83: $num.=$lda[$i];
84: $j=$i;
85: }
86: }
87: if ($j<$#lda-1) {
88: $num.='('.$lda[$j+1];
89: for ($i=$j+2;$i<=$#lda;$i++) {
90: $num.='['.$lda[$i].'-9]';
91: }
92: if ($uda[$j+1]-$lda[$j+1]>1) {
93: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
94: ($#lda-$j-1).'}';
95: }
96: $num.='|'.$uda[$j+1];
97: for ($i=$j+2;$i<=$#uda;$i++) {
98: $num.='[0-'.$uda[$i].']';
99: }
100: $num.=')';
101: } else {
102: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
103: }
104: }
105: }
1.4 www 106: return '^'.$alpha.$num."\$";
1.1 www 107: }
108:
109: sub NUM {
110: my $mask=mask(@_);
111: my $num=0;
112: map {
113: $num++;
114: } grep /$mask/,keys %v;
115: return $num;
116: }
117:
118: sub BIN {
119: my ($low,$high,$lower,$upper)=@_;
120: my $mask=mask($lower,$upper);
121: my $num=0;
122: map {
123: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
124: $num++;
125: }
126: } grep /$mask/,keys %v;
127: return $num;
128: }
129:
130:
131: sub SUM {
132: my $mask=mask(@_);
133: my $sum=0;
134: map {
135: $sum+=$v{$_};
136: } grep /$mask/,keys %v;
137: return $sum;
138: }
139:
140: sub MEAN {
141: my $mask=mask(@_);
142: my $sum=0; my $num=0;
143: map {
144: $sum+=$v{$_};
145: $num++;
146: } grep /$mask/,keys %v;
147: if ($num) {
148: return $sum/$num;
149: } else {
150: return undef;
151: }
152: }
153:
154: sub STDDEV {
155: my $mask=mask(@_);
156: my $sum=0; my $num=0;
157: map {
158: $sum+=$v{$_};
159: $num++;
160: } grep /$mask/,keys %v;
161: unless ($num>1) { return undef; }
162: my $mean=$sum/$num;
163: $sum=0;
164: map {
165: $sum+=($v{$_}-$mean)**2;
166: } grep /$mask/,keys %v;
167: return sqrt($sum/($num-1));
168: }
169:
170: sub PROD {
171: my $mask=mask(@_);
172: my $prod=1;
173: map {
174: $prod*=$v{$_};
175: } grep /$mask/,keys %v;
176: return $prod;
177: }
178:
179: sub MAX {
180: my $mask=mask(@_);
181: my $max='-';
182: map {
183: unless ($max) { $max=$v{$_}; }
184: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
185: } grep /$mask/,keys %v;
186: return $max;
187: }
188:
189: sub MIN {
190: my $mask=mask(@_);
191: my $min='-';
192: map {
193: unless ($max) { $max=$v{$_}; }
194: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
195: } grep /$mask/,keys %v;
196: return $min;
197: }
198:
199: sub SUMMAX {
200: my ($num,$lower,$upper)=@_;
201: my $mask=mask($lower,$upper);
202: my @inside=();
203: map {
204: $inside[$#inside+1]=$v{$_};
205: } grep /$mask/,keys %v;
206: @inside=sort(@inside);
207: my $sum=0; my $i;
208: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
209: $sum+=$inside[$i];
210: }
211: return $sum;
212: }
213:
214: sub SUMMIN {
215: my ($num,$lower,$upper)=@_;
216: my $mask=mask($lower,$upper);
217: my @inside=();
218: map {
219: $inside[$#inside+1]=$v{$_};
220: } grep /$mask/,keys %v;
221: @inside=sort(@inside);
222: my $sum=0; my $i;
223: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
224: $sum+=$inside[$i];
225: }
226: return $sum;
227: }
228:
229: sub sett {
230: %t=();
231: map {
232: if ($f{$_}) {
233: $t{$_}=$f{$_};
234: $t{$_}=~s/\.+/\,/g;
235: $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
236: }
237: } keys %f;
238: }
239:
1.4 www 240: sub calc {
1.1 www 241: %v=();
1.4 www 242: &sett();
1.1 www 243: my $notfinished=1;
244: my $depth=0;
245: while ($notfinished) {
246: $notfinished=0;
247: map {
248: my $old=$v{$_};
1.4 www 249: $v{$_}=eval($t{$_});
1.1 www 250: if ($@) {
251: %v=();
252: return $@;
253: }
254: if ($v{$_} ne $old) { $notfinished=1; }
255: } keys %t;
256: $depth++;
257: if ($depth>100) {
258: %v=();
259: return 'Maximum calculation depth exceeded';
260: }
261: }
262: return '';
263: }
264:
1.4 www 265: # ------------------------------------------- End of "Inside of the safe space"
266: ENDDEFS
267: $safeeval->reval($code);
268: return $safeeval;
269: }
270:
271: # ------------------------------------------------ Add or change formula values
272:
273: sub setformulas {
274: my ($safeeval,@f)=@_;
275: $safeeval->reval('%f=(%f,'."('".join("','",@f)."'));");
276: }
277:
278: # ------------------------------------------------------- Calculate spreadsheet
279:
280: sub calcsheet {
281: my $safeeval=shift;
282: $safeeval->reval('&calc();');
283: }
284:
285: # ------------------------------------------------------------------ Get values
286:
287: sub getvalues {
288: my $safeeval=shift;
289: return $safeeval->reval('%v');
290: }
291:
292: # ---------------------------------------------------------------- Get formulas
293:
294: sub getformulas {
295: my $safeeval=shift;
296: return $safeeval->reval('%f');
297: }
298:
1.5 ! www 299: # -------------------------------------------------------------------- Set type
! 300:
! 301: sub settype {
! 302: my ($safeeval,$type)=@_;
! 303: $safeeval->reval('$sheettype='.$type.';');
! 304: }
! 305:
! 306: # -------------------------------------------------------------------- Get type
! 307:
! 308: sub gettype {
! 309: my $safeeval=shift;
! 310: return $safeeval->reval('$sheettype');
! 311: }
! 312:
! 313: # -------------------------------------------------------------------- Set type
! 314:
! 315: sub setfilename {
! 316: my ($safeeval,$fn)=@_;
! 317: $safeeval->reval('$filename='.$fn.';');
! 318: }
! 319:
! 320: # -------------------------------------------------------------------- Get type
! 321:
! 322: sub getfilename {
! 323: my $safeeval=shift;
! 324: return $safeeval->reval('$filename');
! 325: }
! 326:
! 327: # ========================================================== End of Spreadsheet
! 328: # =============================================================================
! 329:
! 330:
! 331:
! 332: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 333:
1.5 ! www 334: sub readsheet {
! 335: my ($safeeval,$fn)=shift;
! 336: &setfilename($safeeval,$fn);
! 337: $fn=~/\.(\w+)/;
! 338: &settype($safeeval,$1);
1.4 www 339: my %f=();
1.3 www 340: my $content;
341: {
342: my $fh=Apache::File->new($fn);
343: $content=join('',<$fh>);
344: }
345: {
346: my $parser=HTML::TokeParser->new(\$content);
347: my $token;
348: while ($token=$parser->get_token) {
349: if ($token->[0] eq 'S') {
350: if ($token->[1] eq 'field') {
351: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
352: $parser->get_text('/field');
353: }
354: }
355: }
356: }
1.5 ! www 357: &setformulas($safeeval,%f);
1.3 www 358: }
359:
360: # --------------------------------------------------------------- Read metadata
361:
362: sub readmeta {
363: my $fn=shift;
364: unless ($fn=~/\.meta$/) { $fn.='meta'; }
365: my $content;
366: my %returnhash=();
367: {
368: my $fh=Apache::File->new($fn);
369: $content=join('',<$fh>);
370: }
371: my $parser=HTML::TokeParser->new(\$content);
372: my $token;
373: while ($token=$parser->get_token) {
374: if ($token->[0] eq 'S') {
375: my $entry=$token->[1];
376: if (($entry eq 'stores') || ($entry eq 'parameter')) {
377: my $unikey=$entry;
378: $unikey.='_'.$token->[2]->{'part'};
379: $unikey.='_'.$token->[2]->{'name'};
380: $returnhash{$unikey}=$token->[2]->{'display'};
381: }
382: }
383: }
384: return %returnhash;
385: }
386:
1.5 ! www 387: # ----------------------------------------------------------------- Update rows
! 388:
! 389: sub updaterows {
! 390: my $safeeval=shift;
! 391: my %bighash;
! 392: # -------------------------------------------------------------------- Tie hash
! 393: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
! 394: &GDBM_READER,0640)) {
! 395: # --------------------------------------------------------- Get all assessments
! 396:
! 397: my %allkeys=();
! 398: my %allassess=();
! 399:
! 400: my $stype=&gettype($safeeval);
! 401:
! 402: map {
! 403: if ($_=~/^src\_(\d+)\.(\d+)$/) {
! 404: my $mapid=$1;
! 405: my $resid=$2;
! 406: my $id=$mapid.'.'.$resid;
! 407: my $srcf=$bighash{$_};
! 408: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
! 409: my $symb=
! 410: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
! 411: '___'.$resid.'___'.
! 412: &Apache::lonnet::declutter($srcf);
! 413: $allassess{$symb}=$bighash{'title_'.$id};
! 414: if ($stype eq 'assesssheet') {
! 415: map {
! 416: if ($_=~/^stores\_(.*)/) {
! 417: my $key=$_;
! 418: my $display=
! 419: &Apache::lonnet::metadata($srcf,$key.'.display');
! 420: unless ($display) {
! 421: $display=
! 422: &Apache::lonnet::metadata($srcf,$key.'.name');
! 423: }
! 424: $allkeys{$key}=$display;
! 425: }
! 426: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
! 427: }
! 428: }
! 429: }
! 430: } keys %bighash;
! 431: untie(%bighash);
! 432:
! 433: #
! 434: # %allkeys has a list of storage displays by unikey
! 435: # %allassess has a list of all resource displays by symb
! 436: #
! 437: # -------------------- Find discrepancies between the course row table and this
! 438: #
! 439: my %f=&getformulas($safeeval);
! 440: map {
! 441: if ($_=~/^A/) {
! 442: if ($stype eq 'assesssheet') {
! 443: } elsif ($stype eq 'coursesheet') {
! 444: }
! 445: }
! 446: } keys %f;
! 447: # ------------------------------------------------ Find new and obsolete values
! 448:
! 449: } else {
! 450: return 'Could not access course data';
! 451: }
! 452: }
1.3 www 453:
454: # -----------------------------------------------------------------------------
455:
456: sub handler {
457:
458: my $r=shift;
459:
460: $r->content_type('text/html');
461: $r->send_http_header;
462:
463: $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
464: $r->print('<body bgcolor="#FFFFFF">');
465:
1.4 www 466: my $sheetone=initsheet();
1.3 www 467:
1.4 www 468: &setformulas($sheetone,('A1' => '5', 'B2' => '6', 'C4' => 'A1+B2'));
469: $r->print(&calcsheet($sheetone));
470: my %output=&getformulas($sheetone);
471:
472: $r->print('FORM:'.$output{'A1'}.' '.$output{'B2'}.' '.$output{'C4'});
473:
474: my %output=&getvalues($sheetone);
475:
476: $r->print('<br>OUT:'.$output{'A1'}.' '.$output{'B2'}.' '.$output{'C4'});
1.3 www 477:
478: $r->print('</body></html>');
479: return OK;
1.1 www 480: }
481:
482: 1;
483: __END__
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
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