Annotation of loncom/interface/lonspreadsheet.pm, revision 1.7
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;
1.7 ! www 13: use Apache::Constants qw(:common :http);
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:
1.7 ! www 51: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 52: my $la=$1;
53: my $ld=$2;
54:
1.7 ! www 55: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 56: my $ua=$1;
57: my $ud=$2;
58: my $alpha='';
59: my $num='';
60:
61: if (($la eq '*') || ($ua eq '*')) {
1.7 ! www 62: $alpha='[A-Za-z]';
1.1 www 63: } else {
1.7 ! www 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: }
1.1 www 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);
1.7 ! www 91: my $i; $j=0; $notdone=1;
! 92: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
1.1 www 93: if ($lda[$i]==$uda[$i]) {
94: $num.=$lda[$i];
95: $j=$i;
1.7 ! www 96: } else {
! 97: $notdone=0;
1.1 www 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 {
1.7 ! www 115: if ($lda[$#lda]!=$uda[$#uda]) {
! 116: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
! 117: }
1.1 www 118: }
119: }
120: }
1.4 www 121: return '^'.$alpha.$num."\$";
1.1 www 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{$_}) {
1.6 www 248: if ($_=~/^A/) {
249: unless ($f{$_}=~/^\!/) {
250: $t{$_}=$c{$_};
251: }
252: } else {
253: $t{$_}=$f{$_};
1.7 ! www 254: $t{$_}=~s/\.\.+/\,/g;
! 255: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 256: }
1.1 www 257: }
258: } keys %f;
259: }
260:
1.4 www 261: sub calc {
1.1 www 262: %v=();
1.4 www 263: &sett();
1.1 www 264: my $notfinished=1;
265: my $depth=0;
266: while ($notfinished) {
267: $notfinished=0;
268: map {
269: my $old=$v{$_};
1.4 www 270: $v{$_}=eval($t{$_});
1.1 www 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:
1.6 www 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',
1.7 ! www 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');
1.6 www 302: return @cols;
303: }
304:
1.4 www 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)=@_;
1.6 www 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)."');");
1.4 www 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:
1.5 www 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: }
1.6 www 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: }
1.5 www 379:
1.6 www 380: # ---------------------------------------------------------------- Set filename
1.5 www 381:
382: sub setfilename {
383: my ($safeeval,$fn)=@_;
384: $safeeval->reval('$filename='.$fn.';');
385: }
386:
1.6 www 387: # ---------------------------------------------------------------- Get filename
1.5 www 388:
389: sub getfilename {
390: my $safeeval=shift;
391: return $safeeval->reval('$filename');
392: }
393:
394: # ========================================================== End of Spreadsheet
395: # =============================================================================
396:
397:
1.6 www 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',
1.7 ! www 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');
1.6 www 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:
1.5 www 443:
444: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 445:
1.5 www 446: sub readsheet {
447: my ($safeeval,$fn)=shift;
448: &setfilename($safeeval,$fn);
449: $fn=~/\.(\w+)/;
450: &settype($safeeval,$1);
1.4 www 451: my %f=();
1.3 www 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: }
1.5 www 469: &setformulas($safeeval,%f);
1.3 www 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:
1.5 www 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};
1.6 www 526: if ($stype eq 'assesscalc') {
1.5 www 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);
1.6 www 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
1.5 www 565: map {
1.6 www 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;
1.5 www 572: }
573: }
574: } keys %f;
1.6 www 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);
1.5 www 590:
591: } else {
592: return 'Could not access course data';
593: }
594: }
1.3 www 595:
1.6 www 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:
1.3 www 628:
629: sub handler {
1.7 ! www 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: }
1.3 www 637:
1.7 ! www 638: # ----------------------------------------------------- Needs to be in a course
1.3 www 639:
1.7 ! www 640: if (($ENV{'request.course.fn'}) ||
! 641: ($ENV{'request.state'} eq 'construct')) {
! 642:
! 643: $r->content_type('text/html');
! 644: $r->send_http_header;
1.3 www 645:
1.7 ! www 646: $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
! 647: $r->print('<body bgcolor="#FFFFFF">');
1.3 www 648:
1.4 www 649: my $sheetone=initsheet();
1.6 www 650: &setformulas($sheetone,
651: 'B3' => 5, 'C4' => 6, 'C6' => 'B3+C4', 'C2' => 'C6+B5', 'B5'=>'&SUM("A*")',
1.7 ! www 652: 'A1' => 'da1', 'A2'=>'da2', 'A3'=>'da3','A4'=>'da4','A5'=>'da5','A6'=>'da6',
! 653: 'a1' => '28.7', 'a2' => 'C4+a1','G1'=>'&SUM("*25")');
1.6 www 654: &setrowlabels($sheetone,
1.7 ! www 655: 'da1'=>'A Points','da2'=>'B Points','da3'=>'C Points',
! 656: 'da4'=>'Percentage Correct','da5'=>'Bonus Points','da6'=>'Points Awarded');
1.6 www 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));
1.3 www 663: $r->print('</body></html>');
1.7 ! www 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: }
1.3 www 671: return OK;
1.1 www 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