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