Annotation of loncom/interface/lonspreadsheet.pm, revision 1.6
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.6 ! www 4: # 11/11,11/15,11/27,12/04,12/05,12/06 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;
1.6 ! www 15: use GDBM_File;
1.3 www 16:
1.5 www 17: # =============================================================================
18: # ===================================== Implements an instance of a spreadsheet
1.4 www 19:
20: sub initsheet {
21: my $safeeval = new Safe;
22: my $safehole = new Safe::Hole;
23: $safeeval->permit("entereval");
24: $safeeval->permit(":base_math");
25: $safeeval->permit("sort");
26: $safeeval->deny(":base_io");
27: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
28: my $code=<<'ENDDEFS';
29: # ---------------------------------------------------- Inside of the safe space
30:
1.3 www 31: #
32: # f: formulas
1.4 www 33: # t: intermediate format (variable references expanded)
34: # v: output values
1.6 ! www 35: # c: preloaded constants (A-column)
! 36: # rl: row label
1.3 www 37:
1.4 www 38: %v=();
39: %t=();
40: %f=();
1.6 ! www 41: %c=();
! 42: %rl=();
! 43:
! 44: $maxrow=0;
1.5 www 45: $sheettype='';
46: $filename='';
1.1 www 47:
48: sub mask {
49: my ($lower,$upper)=@_;
50:
51: $lower=~/([A-Z]|\*)(\d+|\*)/;
52: my $la=$1;
53: my $ld=$2;
54:
55: $upper=~/([A-Z]|\*)(\d+|\*)/;
56: my $ua=$1;
57: my $ud=$2;
58: my $alpha='';
59: my $num='';
60:
61: if (($la eq '*') || ($ua eq '*')) {
62: $alpha='[A-Z]';
63: } else {
64: $alpha='['.$la.'-'.$ua.']';
65: }
66:
67: if (($ld eq '*') || ($ud eq '*')) {
68: $num='\d+';
69: } else {
70: if (length($ld)!=length($ud)) {
71: $num.='(';
72: map {
73: $num.='['.$_.'-9]';
74: } ($ld=~m/\d/g);
75: if (length($ud)-length($ld)>1) {
76: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
77: }
78: $num.='|';
79: map {
80: $num.='[0-'.$_.']';
81: } ($ud=~m/\d/g);
82: $num.=')';
83: } else {
84: my @lda=($ld=~m/\d/g);
85: my @uda=($ud=~m/\d/g);
86: my $i; $j=0;
87: for ($i=0;$i<=$#lda;$i++) {
88: if ($lda[$i]==$uda[$i]) {
89: $num.=$lda[$i];
90: $j=$i;
91: }
92: }
93: if ($j<$#lda-1) {
94: $num.='('.$lda[$j+1];
95: for ($i=$j+2;$i<=$#lda;$i++) {
96: $num.='['.$lda[$i].'-9]';
97: }
98: if ($uda[$j+1]-$lda[$j+1]>1) {
99: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
100: ($#lda-$j-1).'}';
101: }
102: $num.='|'.$uda[$j+1];
103: for ($i=$j+2;$i<=$#uda;$i++) {
104: $num.='[0-'.$uda[$i].']';
105: }
106: $num.=')';
107: } else {
108: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
109: }
110: }
111: }
1.4 www 112: return '^'.$alpha.$num."\$";
1.1 www 113: }
114:
115: sub NUM {
116: my $mask=mask(@_);
117: my $num=0;
118: map {
119: $num++;
120: } grep /$mask/,keys %v;
121: return $num;
122: }
123:
124: sub BIN {
125: my ($low,$high,$lower,$upper)=@_;
126: my $mask=mask($lower,$upper);
127: my $num=0;
128: map {
129: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
130: $num++;
131: }
132: } grep /$mask/,keys %v;
133: return $num;
134: }
135:
136:
137: sub SUM {
138: my $mask=mask(@_);
139: my $sum=0;
140: map {
141: $sum+=$v{$_};
142: } grep /$mask/,keys %v;
143: return $sum;
144: }
145:
146: sub MEAN {
147: my $mask=mask(@_);
148: my $sum=0; my $num=0;
149: map {
150: $sum+=$v{$_};
151: $num++;
152: } grep /$mask/,keys %v;
153: if ($num) {
154: return $sum/$num;
155: } else {
156: return undef;
157: }
158: }
159:
160: sub STDDEV {
161: my $mask=mask(@_);
162: my $sum=0; my $num=0;
163: map {
164: $sum+=$v{$_};
165: $num++;
166: } grep /$mask/,keys %v;
167: unless ($num>1) { return undef; }
168: my $mean=$sum/$num;
169: $sum=0;
170: map {
171: $sum+=($v{$_}-$mean)**2;
172: } grep /$mask/,keys %v;
173: return sqrt($sum/($num-1));
174: }
175:
176: sub PROD {
177: my $mask=mask(@_);
178: my $prod=1;
179: map {
180: $prod*=$v{$_};
181: } grep /$mask/,keys %v;
182: return $prod;
183: }
184:
185: sub MAX {
186: my $mask=mask(@_);
187: my $max='-';
188: map {
189: unless ($max) { $max=$v{$_}; }
190: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
191: } grep /$mask/,keys %v;
192: return $max;
193: }
194:
195: sub MIN {
196: my $mask=mask(@_);
197: my $min='-';
198: map {
199: unless ($max) { $max=$v{$_}; }
200: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
201: } grep /$mask/,keys %v;
202: return $min;
203: }
204:
205: sub SUMMAX {
206: my ($num,$lower,$upper)=@_;
207: my $mask=mask($lower,$upper);
208: my @inside=();
209: map {
210: $inside[$#inside+1]=$v{$_};
211: } grep /$mask/,keys %v;
212: @inside=sort(@inside);
213: my $sum=0; my $i;
214: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
215: $sum+=$inside[$i];
216: }
217: return $sum;
218: }
219:
220: sub SUMMIN {
221: my ($num,$lower,$upper)=@_;
222: my $mask=mask($lower,$upper);
223: my @inside=();
224: map {
225: $inside[$#inside+1]=$v{$_};
226: } grep /$mask/,keys %v;
227: @inside=sort(@inside);
228: my $sum=0; my $i;
229: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
230: $sum+=$inside[$i];
231: }
232: return $sum;
233: }
234:
235: sub sett {
236: %t=();
237: map {
238: if ($f{$_}) {
1.6 ! www 239: if ($_=~/^A/) {
! 240: unless ($f{$_}=~/^\!/) {
! 241: $t{$_}=$c{$_};
! 242: }
! 243: } else {
! 244: $t{$_}=$f{$_};
! 245: $t{$_}=~s/\.+/\,/g;
! 246: $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
! 247: }
1.1 www 248: }
249: } keys %f;
250: }
251:
1.4 www 252: sub calc {
1.1 www 253: %v=();
1.4 www 254: &sett();
1.1 www 255: my $notfinished=1;
256: my $depth=0;
257: while ($notfinished) {
258: $notfinished=0;
259: map {
260: my $old=$v{$_};
1.4 www 261: $v{$_}=eval($t{$_});
1.1 www 262: if ($@) {
263: %v=();
264: return $@;
265: }
266: if ($v{$_} ne $old) { $notfinished=1; }
267: } keys %t;
268: $depth++;
269: if ($depth>100) {
270: %v=();
271: return 'Maximum calculation depth exceeded';
272: }
273: }
274: return '';
275: }
276:
1.6 ! www 277: sub outrow {
! 278: my $n=shift;
! 279: my @cols=();
! 280: if ($n) {
! 281: $cols[0]=$rl{$f{'A'.$n}};
! 282: } else {
! 283: $cols[0]='<b><font size=+1>Export</font></b>';
! 284: }
! 285: map {
! 286: my $fm=$f{$_.$n};
! 287: $fm=~s/[\'\"]/\&\#34;/g;
! 288: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
! 289: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
! 290: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
! 291: return @cols;
! 292: }
! 293:
1.4 www 294: # ------------------------------------------- End of "Inside of the safe space"
295: ENDDEFS
296: $safeeval->reval($code);
297: return $safeeval;
298: }
299:
300: # ------------------------------------------------ Add or change formula values
301:
302: sub setformulas {
303: my ($safeeval,@f)=@_;
1.6 ! www 304: $safeeval->reval('%f='."('".join("','",@f)."');");
! 305: }
! 306:
! 307: # ------------------------------------------------ Add or change formula values
! 308:
! 309: sub setconstants {
! 310: my ($safeeval,@c)=@_;
! 311: $safeeval->reval('%c='."('".join("','",@c)."');");
! 312: }
! 313:
! 314: # ------------------------------------------------ Add or change formula values
! 315:
! 316: sub setrowlabels {
! 317: my ($safeeval,@rl)=@_;
! 318: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 319: }
320:
321: # ------------------------------------------------------- Calculate spreadsheet
322:
323: sub calcsheet {
324: my $safeeval=shift;
325: $safeeval->reval('&calc();');
326: }
327:
328: # ------------------------------------------------------------------ Get values
329:
330: sub getvalues {
331: my $safeeval=shift;
332: return $safeeval->reval('%v');
333: }
334:
335: # ---------------------------------------------------------------- Get formulas
336:
337: sub getformulas {
338: my $safeeval=shift;
339: return $safeeval->reval('%f');
340: }
341:
1.5 www 342: # -------------------------------------------------------------------- Set type
343:
344: sub settype {
345: my ($safeeval,$type)=@_;
346: $safeeval->reval('$sheettype='.$type.';');
347: }
348:
349: # -------------------------------------------------------------------- Get type
350:
351: sub gettype {
352: my $safeeval=shift;
353: return $safeeval->reval('$sheettype');
354: }
1.6 ! www 355: # ------------------------------------------------------------------ Set maxrow
! 356:
! 357: sub setmaxrow {
! 358: my ($safeeval,$row)=@_;
! 359: $safeeval->reval('$maxrow='.$row.';');
! 360: }
! 361:
! 362: # ------------------------------------------------------------------ Get maxrow
! 363:
! 364: sub getmaxrow {
! 365: my $safeeval=shift;
! 366: return $safeeval->reval('$maxrow');
! 367: }
1.5 www 368:
1.6 ! www 369: # ---------------------------------------------------------------- Set filename
1.5 www 370:
371: sub setfilename {
372: my ($safeeval,$fn)=@_;
373: $safeeval->reval('$filename='.$fn.';');
374: }
375:
1.6 ! www 376: # ---------------------------------------------------------------- Get filename
1.5 www 377:
378: sub getfilename {
379: my $safeeval=shift;
380: return $safeeval->reval('$filename');
381: }
382:
383: # ========================================================== End of Spreadsheet
384: # =============================================================================
385:
386:
1.6 ! www 387: # --------------------------------------------- Produce output row n from sheet
! 388:
! 389: sub rown {
! 390: my ($safeeval,$n)=@_;
! 391: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
! 392: my $showf=0;
! 393: map {
! 394: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
! 395: if ($showf==0) { $vl=$_; }
! 396: if ($showf>1) {
! 397: if ($vl eq '') {
! 398: $vl='<font size=+2 color=white>#</font>';
! 399: }
! 400: $rowdata.=
! 401: '<td><a href="javascript:prompt('.$fm.');">'.$vl.
! 402: '</a></td>';
! 403: } else {
! 404: $rowdata.='<td> '.$vl.' </td>';
! 405: }
! 406: $showf++;
! 407: } $safeeval->reval('&outrow('.$n.')');
! 408: return $rowdata.'</tr>';
! 409: }
! 410:
! 411: # ------------------------------------------------------------- Print out sheet
! 412:
! 413: sub outsheet {
! 414: my $safeeval=shift;
! 415: my $tabledata='<table border=2><tr><td colspan=2> </td>';
! 416: map {
! 417: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
! 418: } ('A<br>Import','B','C','D','E','F','G','H','I','J','K','L','M',
! 419: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
! 420: $tabledata.='</tr>';
! 421: my $row;
! 422: my $maxrow=&getmaxrow($safeeval);
! 423: for ($row=0;$row<=$maxrow;$row++) {
! 424: $tabledata.=&rown($safeeval,$row);
! 425: }
! 426: $tabledata.='</table>';
! 427: }
! 428:
! 429:
1.5 www 430:
431: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 432:
1.5 www 433: sub readsheet {
434: my ($safeeval,$fn)=shift;
435: &setfilename($safeeval,$fn);
436: $fn=~/\.(\w+)/;
437: &settype($safeeval,$1);
1.4 www 438: my %f=();
1.3 www 439: my $content;
440: {
441: my $fh=Apache::File->new($fn);
442: $content=join('',<$fh>);
443: }
444: {
445: my $parser=HTML::TokeParser->new(\$content);
446: my $token;
447: while ($token=$parser->get_token) {
448: if ($token->[0] eq 'S') {
449: if ($token->[1] eq 'field') {
450: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
451: $parser->get_text('/field');
452: }
453: }
454: }
455: }
1.5 www 456: &setformulas($safeeval,%f);
1.3 www 457: }
458:
459: # --------------------------------------------------------------- Read metadata
460:
461: sub readmeta {
462: my $fn=shift;
463: unless ($fn=~/\.meta$/) { $fn.='meta'; }
464: my $content;
465: my %returnhash=();
466: {
467: my $fh=Apache::File->new($fn);
468: $content=join('',<$fh>);
469: }
470: my $parser=HTML::TokeParser->new(\$content);
471: my $token;
472: while ($token=$parser->get_token) {
473: if ($token->[0] eq 'S') {
474: my $entry=$token->[1];
475: if (($entry eq 'stores') || ($entry eq 'parameter')) {
476: my $unikey=$entry;
477: $unikey.='_'.$token->[2]->{'part'};
478: $unikey.='_'.$token->[2]->{'name'};
479: $returnhash{$unikey}=$token->[2]->{'display'};
480: }
481: }
482: }
483: return %returnhash;
484: }
485:
1.5 www 486: # ----------------------------------------------------------------- Update rows
487:
488: sub updaterows {
489: my $safeeval=shift;
490: my %bighash;
491: # -------------------------------------------------------------------- Tie hash
492: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
493: &GDBM_READER,0640)) {
494: # --------------------------------------------------------- Get all assessments
495:
496: my %allkeys=();
497: my %allassess=();
498:
499: my $stype=&gettype($safeeval);
500:
501: map {
502: if ($_=~/^src\_(\d+)\.(\d+)$/) {
503: my $mapid=$1;
504: my $resid=$2;
505: my $id=$mapid.'.'.$resid;
506: my $srcf=$bighash{$_};
507: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
508: my $symb=
509: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
510: '___'.$resid.'___'.
511: &Apache::lonnet::declutter($srcf);
512: $allassess{$symb}=$bighash{'title_'.$id};
1.6 ! www 513: if ($stype eq 'assesscalc') {
1.5 www 514: map {
515: if ($_=~/^stores\_(.*)/) {
516: my $key=$_;
517: my $display=
518: &Apache::lonnet::metadata($srcf,$key.'.display');
519: unless ($display) {
520: $display=
521: &Apache::lonnet::metadata($srcf,$key.'.name');
522: }
523: $allkeys{$key}=$display;
524: }
525: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
526: }
527: }
528: }
529: } keys %bighash;
530: untie(%bighash);
531:
532: #
533: # %allkeys has a list of storage displays by unikey
534: # %allassess has a list of all resource displays by symb
535: #
536: # -------------------- Find discrepancies between the course row table and this
537: #
538: my %f=&getformulas($safeeval);
1.6 ! www 539: my $changed=0;
! 540:
! 541: my %current=();
! 542: if ($stype eq 'assesscalc') {
! 543: %current=%allkeys;
! 544: } elsif ($stype eq 'studentcalc') {
! 545: %current=%allassess;
! 546: }
! 547:
! 548: my $maxrow=0;
! 549: my %existing=();
! 550:
! 551: # ----------------------------------------------------------- Now obsolete rows
1.5 www 552: map {
1.6 ! www 553: if ($_=~/^A(\d+)/) {
! 554: $maxrow=($1>$maxrow)?$1:$maxrow;
! 555: $existing{$f{$_}}=1;
! 556: unless (defined($current{$f{$_}})) {
! 557: $f{$_}='!!! Obsolete';
! 558: $changed=1;
1.5 www 559: }
560: }
561: } keys %f;
1.6 ! www 562:
! 563: # -------------------------------------------------------- New and unknown keys
! 564:
! 565: map {
! 566: unless ($existing{$_}) {
! 567: $changed=1;
! 568: $maxrow++;
! 569: $f{'A'.$maxrow}=$_;
! 570: }
! 571: } keys %current;
! 572:
! 573: if ($changed) { &setformulas($safeeval,%f); }
! 574:
! 575: &setmaxrow($safeeval,$maxrow);
! 576: &setrowlabels($safeeval,%current);
1.5 www 577:
578: } else {
579: return 'Could not access course data';
580: }
581: }
1.3 www 582:
1.6 ! www 583: # ------------------------------------------------ Load data for one assessment
! 584:
! 585: sub rowaassess {
! 586: my ($safeeval,$uname,$udom,$symb)=@_;
! 587: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
! 588: my $namespace;
! 589: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
! 590: my $answer=reply("restore:$udom:$uname:$namespace:$symb",$uhome);
! 591: my %returnhash=();
! 592: map {
! 593: my ($name,$value)=split(/\=/,$_);
! 594: $returnhash{&unescape($name)}=&unescape($value);
! 595: } split(/\&/,$answer);
! 596: my $version;
! 597: for ($version=1;$version<=$returnhash{'version'};$version++) {
! 598: map {
! 599: $returnhash{$_}=$returnhash{$version.':'.$_};
! 600: } split(/\:/,$returnhash{$version.':keys'});
! 601: }
! 602:
! 603: my %c=();
! 604: my %f=&getformulas($safeeval);
! 605: map {
! 606: if ($_=~/^A/) {
! 607: unless ($f{$_}=~/^\!/) {
! 608: $c{$_}=$returnhash{$f{$_}};
! 609: }
! 610: }
! 611: } keys %f;
! 612: &setconstants($safeeval,%c);
! 613: }
! 614:
1.3 www 615:
616: sub handler {
617:
618: my $r=shift;
619:
620: $r->content_type('text/html');
621: $r->send_http_header;
622:
623: $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
624: $r->print('<body bgcolor="#FFFFFF">');
625:
1.4 www 626: my $sheetone=initsheet();
1.6 ! www 627: &setformulas($sheetone,
! 628: 'B3' => 5, 'C4' => 6, 'C6' => 'B3+C4', 'C2' => 'C6+B5', 'B5'=>'&SUM("A*")',
! 629: 'A1' => 'a1', 'A2'=>'a2', 'A3'=>'a3','A4'=>'a4','A5'=>'a5','A6'=>'a6');
! 630: &setrowlabels($sheetone,
! 631: 'a1'=>'A Points','a2'=>'B Points','a3'=>'C Points',
! 632: 'a4'=>'Percentage Correct','a5'=>'Bonus Points','a6'=>'Points Awarded');
! 633: &setconstants($sheetone,
! 634: 'A1' => '3', 'A2'=>'4', 'A3'=>'0','A4'=>'76','A5'=>'1.5','A6'=>'6');
! 635:
! 636: &setmaxrow($sheetone,6);
! 637: &calcsheet($sheetone);
! 638: $r->print(&outsheet($sheetone));
1.3 www 639: $r->print('</body></html>');
640: return OK;
1.1 www 641: }
642:
643: 1;
644: __END__
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
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