Annotation of loncom/interface/lonspreadsheet.pm, revision 1.9
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.9 ! www 4: # 11/11,11/15,11/27,12/04,12/05,12/06,12/07,12/08 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)=@_;
1.9 ! www 402: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 403: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
404: my $showf=0;
405: map {
1.9 ! www 406: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 407: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
408: if ($showf==0) { $vl=$_; }
1.9 ! www 409: if ($showf<=1) { $bgcolor='#FFDDDD'; }
! 410: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.6 www 411: if ($showf>1) {
412: if ($vl eq '') {
1.9 ! www 413: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 414: }
415: $rowdata.=
1.9 ! www 416: '<td bgcolor='.$bgcolor.'><a href="javascript:prompt('.$fm.');">'.$vl.
1.6 www 417: '</a></td>';
418: } else {
1.9 ! www 419: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 420: }
421: $showf++;
422: } $safeeval->reval('&outrow('.$n.')');
423: return $rowdata.'</tr>';
424: }
425:
426: # ------------------------------------------------------------- Print out sheet
427:
428: sub outsheet {
429: my $safeeval=shift;
1.9 ! www 430: my $tabledata='<table border=2><tr><td colspan=2> </td>'.
! 431: '<td bgcolor=#FFDDDD><b>A Import</b></td>';
1.6 www 432: map {
433: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
1.9 ! www 434: } ('B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 435: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
436: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
437: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 438: $tabledata.='</tr>';
439: my $row;
440: my $maxrow=&getmaxrow($safeeval);
441: for ($row=0;$row<=$maxrow;$row++) {
442: $tabledata.=&rown($safeeval,$row);
443: }
444: $tabledata.='</table>';
445: }
446:
447:
1.5 www 448:
449: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 450:
1.5 www 451: sub readsheet {
1.8 www 452: my ($safeeval,$fn)=@_;
1.5 www 453: &setfilename($safeeval,$fn);
454: $fn=~/\.(\w+)/;
455: &settype($safeeval,$1);
1.4 www 456: my %f=();
1.8 www 457: my $content='';
1.3 www 458: {
1.8 www 459: my $fh;
460: if ($fh=Apache::File->new($fn)) {
461: $content=join('',<$fh>);
462: }
1.3 www 463: }
464: {
465: my $parser=HTML::TokeParser->new(\$content);
466: my $token;
467: while ($token=$parser->get_token) {
468: if ($token->[0] eq 'S') {
469: if ($token->[1] eq 'field') {
470: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
471: $parser->get_text('/field');
472: }
473: }
474: }
475: }
1.5 www 476: &setformulas($safeeval,%f);
1.3 www 477: }
478:
479: # --------------------------------------------------------------- Read metadata
480:
481: sub readmeta {
482: my $fn=shift;
483: unless ($fn=~/\.meta$/) { $fn.='meta'; }
484: my $content;
485: my %returnhash=();
486: {
487: my $fh=Apache::File->new($fn);
488: $content=join('',<$fh>);
489: }
490: my $parser=HTML::TokeParser->new(\$content);
491: my $token;
492: while ($token=$parser->get_token) {
493: if ($token->[0] eq 'S') {
494: my $entry=$token->[1];
495: if (($entry eq 'stores') || ($entry eq 'parameter')) {
496: my $unikey=$entry;
497: $unikey.='_'.$token->[2]->{'part'};
498: $unikey.='_'.$token->[2]->{'name'};
499: $returnhash{$unikey}=$token->[2]->{'display'};
500: }
501: }
502: }
503: return %returnhash;
504: }
505:
1.5 www 506: # ----------------------------------------------------------------- Update rows
507:
508: sub updaterows {
509: my $safeeval=shift;
510: my %bighash;
511: # -------------------------------------------------------------------- Tie hash
512: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
513: &GDBM_READER,0640)) {
514: # --------------------------------------------------------- Get all assessments
515:
516: my %allkeys=();
517: my %allassess=();
518:
519: my $stype=&gettype($safeeval);
520:
521: map {
522: if ($_=~/^src\_(\d+)\.(\d+)$/) {
523: my $mapid=$1;
524: my $resid=$2;
525: my $id=$mapid.'.'.$resid;
526: my $srcf=$bighash{$_};
527: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
528: my $symb=
529: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
530: '___'.$resid.'___'.
531: &Apache::lonnet::declutter($srcf);
532: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 533:
1.6 www 534: if ($stype eq 'assesscalc') {
1.5 www 535: map {
536: if ($_=~/^stores\_(.*)/) {
537: my $key=$_;
538: my $display=
539: &Apache::lonnet::metadata($srcf,$key.'.display');
540: unless ($display) {
541: $display=
542: &Apache::lonnet::metadata($srcf,$key.'.name');
543: }
1.8 www 544:
545:
1.5 www 546: $allkeys{$key}=$display;
547: }
548: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
549: }
550: }
551: }
552: } keys %bighash;
553: untie(%bighash);
554:
555: #
556: # %allkeys has a list of storage displays by unikey
557: # %allassess has a list of all resource displays by symb
558: #
559: # -------------------- Find discrepancies between the course row table and this
560: #
561: my %f=&getformulas($safeeval);
1.6 www 562: my $changed=0;
563:
564: my %current=();
565: if ($stype eq 'assesscalc') {
566: %current=%allkeys;
567: } elsif ($stype eq 'studentcalc') {
568: %current=%allassess;
569: }
570:
571: my $maxrow=0;
572: my %existing=();
573:
574: # ----------------------------------------------------------- Now obsolete rows
1.5 www 575: map {
1.6 www 576: if ($_=~/^A(\d+)/) {
577: $maxrow=($1>$maxrow)?$1:$maxrow;
578: $existing{$f{$_}}=1;
579: unless (defined($current{$f{$_}})) {
580: $f{$_}='!!! Obsolete';
581: $changed=1;
1.5 www 582: }
583: }
584: } keys %f;
1.6 www 585:
586: # -------------------------------------------------------- New and unknown keys
587:
588: map {
589: unless ($existing{$_}) {
590: $changed=1;
591: $maxrow++;
592: $f{'A'.$maxrow}=$_;
593: }
594: } keys %current;
595:
596: if ($changed) { &setformulas($safeeval,%f); }
597:
598: &setmaxrow($safeeval,$maxrow);
599: &setrowlabels($safeeval,%current);
1.5 www 600:
601: } else {
602: return 'Could not access course data';
603: }
604: }
1.3 www 605:
1.6 www 606: # ------------------------------------------------ Load data for one assessment
607:
608: sub rowaassess {
609: my ($safeeval,$uname,$udom,$symb)=@_;
610: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
611: my $namespace;
612: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
613: my $answer=reply("restore:$udom:$uname:$namespace:$symb",$uhome);
614: my %returnhash=();
615: map {
616: my ($name,$value)=split(/\=/,$_);
617: $returnhash{&unescape($name)}=&unescape($value);
618: } split(/\&/,$answer);
619: my $version;
620: for ($version=1;$version<=$returnhash{'version'};$version++) {
621: map {
622: $returnhash{$_}=$returnhash{$version.':'.$_};
623: } split(/\:/,$returnhash{$version.':keys'});
624: }
625:
626: my %c=();
627: my %f=&getformulas($safeeval);
628: map {
629: if ($_=~/^A/) {
630: unless ($f{$_}=~/^\!/) {
631: $c{$_}=$returnhash{$f{$_}};
632: }
633: }
634: } keys %f;
635: &setconstants($safeeval,%c);
636: }
637:
1.3 www 638:
639: sub handler {
1.7 www 640: my $r=shift;
641:
642: if ($r->header_only) {
643: $r->content_type('text/html');
644: $r->send_http_header;
645: return OK;
646: }
1.3 www 647:
1.7 www 648: # ----------------------------------------------------- Needs to be in a course
1.3 www 649:
1.7 www 650: if (($ENV{'request.course.fn'}) ||
651: ($ENV{'request.state'} eq 'construct')) {
652:
653: $r->content_type('text/html');
654: $r->send_http_header;
1.3 www 655:
1.7 www 656: $r->print('<html><head><title>LON-CAPA Spreadsheet</title></head>');
657: $r->print('<body bgcolor="#FFFFFF">');
1.3 www 658:
1.4 www 659: my $sheetone=initsheet();
1.8 www 660: &readsheet($sheetone,$r->filename);
661: &updaterows($sheetone);
1.6 www 662: &calcsheet($sheetone);
663: $r->print(&outsheet($sheetone));
1.8 www 664:
1.3 www 665: $r->print('</body></html>');
1.7 www 666:
667: } else {
668: # ----------------------------- Not in a course, or not allowed to modify parms
669: $ENV{'user.error.msg'}=
670: $r->uri.":opa:0:0:Cannot modify spreadsheet";
671: return HTTP_NOT_ACCEPTABLE;
672: }
1.3 www 673: return OK;
1.1 www 674: }
675:
676: 1;
677: __END__
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
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