1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
4: # 11/11,11/15,11/27,12/04,12/05,12/06 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: use GDBM_File;
16:
17: # =============================================================================
18: # ===================================== Implements an instance of a spreadsheet
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:
31: #
32: # f: formulas
33: # t: intermediate format (variable references expanded)
34: # v: output values
35: # c: preloaded constants (A-column)
36: # rl: row label
37:
38: %v=();
39: %t=();
40: %f=();
41: %c=();
42: %rl=();
43:
44: $maxrow=0;
45: $sheettype='';
46: $filename='';
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: }
112: return '^'.$alpha.$num."\$";
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{$_}) {
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: }
248: }
249: } keys %f;
250: }
251:
252: sub calc {
253: %v=();
254: &sett();
255: my $notfinished=1;
256: my $depth=0;
257: while ($notfinished) {
258: $notfinished=0;
259: map {
260: my $old=$v{$_};
261: $v{$_}=eval($t{$_});
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:
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:
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)=@_;
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)."');");
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:
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: }
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: }
368:
369: # ---------------------------------------------------------------- Set filename
370:
371: sub setfilename {
372: my ($safeeval,$fn)=@_;
373: $safeeval->reval('$filename='.$fn.';');
374: }
375:
376: # ---------------------------------------------------------------- Get filename
377:
378: sub getfilename {
379: my $safeeval=shift;
380: return $safeeval->reval('$filename');
381: }
382:
383: # ========================================================== End of Spreadsheet
384: # =============================================================================
385:
386:
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:
430:
431: # --------------------------------------- Read spreadsheet formulas from a file
432:
433: sub readsheet {
434: my ($safeeval,$fn)=shift;
435: &setfilename($safeeval,$fn);
436: $fn=~/\.(\w+)/;
437: &settype($safeeval,$1);
438: my %f=();
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: }
456: &setformulas($safeeval,%f);
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:
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};
513: if ($stype eq 'assesscalc') {
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);
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
552: map {
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;
559: }
560: }
561: } keys %f;
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);
577:
578: } else {
579: return 'Could not access course data';
580: }
581: }
582:
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:
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:
626: my $sheetone=initsheet();
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));
639: $r->print('</body></html>');
640: return OK;
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