Annotation of loncom/interface/lonspreadsheet.pm, revision 1.16
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.15 www 4: # 11/11,11/15,11/27,12/04,12/05,12/06,12/07,
1.16 ! www 5: # 12/08,12/09,12/11,12/12,12/15,12/16 Gerd Kortemeyer
1.1 www 6:
7: package Apache::lonspreadsheet;
8:
9: use strict;
10: use Safe;
1.3 www 11: use Safe::Hole;
1.1 www 12: use Opcode;
13: use Apache::lonnet;
1.7 www 14: use Apache::Constants qw(:common :http);
1.3 www 15: use HTML::TokeParser;
1.6 www 16: use GDBM_File;
1.3 www 17:
1.11 www 18: #
19: # These cache hashes need to be independent of user, resource and course
20: # (user and course are in the keys)
21: #
22: use vars qw(%spreadsheets %courserdatas %userrdatas);
23: #
24: # These global hashes are dependent on user, course and resource,
25: # and need to be initialized every time when a sheet is calculated
26: #
27: my %courseopt;
28: my %useropt;
29: my %parmhash;
30: my $csec;
31: my $uname;
32: my $udom;
33:
1.5 www 34: # =============================================================================
35: # ===================================== Implements an instance of a spreadsheet
1.4 www 36:
37: sub initsheet {
38: my $safeeval = new Safe;
39: my $safehole = new Safe::Hole;
40: $safeeval->permit("entereval");
41: $safeeval->permit(":base_math");
42: $safeeval->permit("sort");
43: $safeeval->deny(":base_io");
44: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
45: my $code=<<'ENDDEFS';
46: # ---------------------------------------------------- Inside of the safe space
47:
1.3 www 48: #
49: # f: formulas
1.4 www 50: # t: intermediate format (variable references expanded)
51: # v: output values
1.6 www 52: # c: preloaded constants (A-column)
53: # rl: row label
1.3 www 54:
1.4 www 55: %v=();
56: %t=();
57: %f=();
1.6 www 58: %c=();
59: %rl=();
60:
61: $maxrow=0;
1.5 www 62: $sheettype='';
63: $filename='';
1.1 www 64:
65: sub mask {
66: my ($lower,$upper)=@_;
67:
1.7 www 68: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 69: my $la=$1;
70: my $ld=$2;
71:
1.7 www 72: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 73: my $ua=$1;
74: my $ud=$2;
75: my $alpha='';
76: my $num='';
77:
78: if (($la eq '*') || ($ua eq '*')) {
1.7 www 79: $alpha='[A-Za-z]';
1.1 www 80: } else {
1.7 www 81: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
82: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
83: $alpha='['.$la.'-'.$ua.']';
84: } else {
85: $alpha='['.$la.'-Za-'.$ua.']';
86: }
1.1 www 87: }
88:
89: if (($ld eq '*') || ($ud eq '*')) {
90: $num='\d+';
91: } else {
92: if (length($ld)!=length($ud)) {
93: $num.='(';
94: map {
95: $num.='['.$_.'-9]';
96: } ($ld=~m/\d/g);
97: if (length($ud)-length($ld)>1) {
98: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
99: }
100: $num.='|';
101: map {
102: $num.='[0-'.$_.']';
103: } ($ud=~m/\d/g);
104: $num.=')';
105: } else {
106: my @lda=($ld=~m/\d/g);
107: my @uda=($ud=~m/\d/g);
1.7 www 108: my $i; $j=0; $notdone=1;
109: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
1.1 www 110: if ($lda[$i]==$uda[$i]) {
111: $num.=$lda[$i];
112: $j=$i;
1.7 www 113: } else {
114: $notdone=0;
1.1 www 115: }
116: }
117: if ($j<$#lda-1) {
118: $num.='('.$lda[$j+1];
119: for ($i=$j+2;$i<=$#lda;$i++) {
120: $num.='['.$lda[$i].'-9]';
121: }
122: if ($uda[$j+1]-$lda[$j+1]>1) {
123: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
124: ($#lda-$j-1).'}';
125: }
126: $num.='|'.$uda[$j+1];
127: for ($i=$j+2;$i<=$#uda;$i++) {
128: $num.='[0-'.$uda[$i].']';
129: }
130: $num.=')';
131: } else {
1.7 www 132: if ($lda[$#lda]!=$uda[$#uda]) {
133: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
134: }
1.1 www 135: }
136: }
137: }
1.4 www 138: return '^'.$alpha.$num."\$";
1.1 www 139: }
140:
141: sub NUM {
142: my $mask=mask(@_);
143: my $num=0;
144: map {
145: $num++;
146: } grep /$mask/,keys %v;
147: return $num;
148: }
149:
150: sub BIN {
151: my ($low,$high,$lower,$upper)=@_;
152: my $mask=mask($lower,$upper);
153: my $num=0;
154: map {
155: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
156: $num++;
157: }
158: } grep /$mask/,keys %v;
159: return $num;
160: }
161:
162:
163: sub SUM {
164: my $mask=mask(@_);
165: my $sum=0;
166: map {
167: $sum+=$v{$_};
168: } grep /$mask/,keys %v;
169: return $sum;
170: }
171:
172: sub MEAN {
173: my $mask=mask(@_);
174: my $sum=0; my $num=0;
175: map {
176: $sum+=$v{$_};
177: $num++;
178: } grep /$mask/,keys %v;
179: if ($num) {
180: return $sum/$num;
181: } else {
182: return undef;
183: }
184: }
185:
186: sub STDDEV {
187: my $mask=mask(@_);
188: my $sum=0; my $num=0;
189: map {
190: $sum+=$v{$_};
191: $num++;
192: } grep /$mask/,keys %v;
193: unless ($num>1) { return undef; }
194: my $mean=$sum/$num;
195: $sum=0;
196: map {
197: $sum+=($v{$_}-$mean)**2;
198: } grep /$mask/,keys %v;
199: return sqrt($sum/($num-1));
200: }
201:
202: sub PROD {
203: my $mask=mask(@_);
204: my $prod=1;
205: map {
206: $prod*=$v{$_};
207: } grep /$mask/,keys %v;
208: return $prod;
209: }
210:
211: sub MAX {
212: my $mask=mask(@_);
213: my $max='-';
214: map {
215: unless ($max) { $max=$v{$_}; }
216: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
217: } grep /$mask/,keys %v;
218: return $max;
219: }
220:
221: sub MIN {
222: my $mask=mask(@_);
223: my $min='-';
224: map {
225: unless ($max) { $max=$v{$_}; }
226: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
227: } grep /$mask/,keys %v;
228: return $min;
229: }
230:
231: sub SUMMAX {
232: my ($num,$lower,$upper)=@_;
233: my $mask=mask($lower,$upper);
234: my @inside=();
235: map {
236: $inside[$#inside+1]=$v{$_};
237: } grep /$mask/,keys %v;
238: @inside=sort(@inside);
239: my $sum=0; my $i;
240: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
241: $sum+=$inside[$i];
242: }
243: return $sum;
244: }
245:
246: sub SUMMIN {
247: my ($num,$lower,$upper)=@_;
248: my $mask=mask($lower,$upper);
249: my @inside=();
250: map {
251: $inside[$#inside+1]=$v{$_};
252: } grep /$mask/,keys %v;
253: @inside=sort(@inside);
254: my $sum=0; my $i;
255: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
256: $sum+=$inside[$i];
257: }
258: return $sum;
259: }
260:
261: sub sett {
262: %t=();
1.16 ! www 263: my $pattern='';
! 264: if ($sheettype eq 'assesscalc') {
! 265: $pattern='A';
! 266: } else {
! 267: $pattern='[A-Z]';
! 268: }
1.1 www 269: map {
270: if ($f{$_}) {
1.16 ! www 271: if ($_=~/^$pattern/) {
1.6 www 272: unless ($f{$_}=~/^\!/) {
273: $t{$_}=$c{$_};
274: }
275: } else {
276: $t{$_}=$f{$_};
1.7 www 277: $t{$_}=~s/\.\.+/\,/g;
278: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 279: }
1.1 www 280: }
281: } keys %f;
282: }
283:
1.4 www 284: sub calc {
1.1 www 285: %v=();
1.4 www 286: &sett();
1.1 www 287: my $notfinished=1;
288: my $depth=0;
289: while ($notfinished) {
290: $notfinished=0;
291: map {
292: my $old=$v{$_};
1.4 www 293: $v{$_}=eval($t{$_});
1.1 www 294: if ($@) {
295: %v=();
296: return $@;
297: }
298: if ($v{$_} ne $old) { $notfinished=1; }
299: } keys %t;
300: $depth++;
301: if ($depth>100) {
302: %v=();
303: return 'Maximum calculation depth exceeded';
304: }
305: }
306: return '';
307: }
308:
1.16 ! www 309: sub outrowassess {
1.6 www 310: my $n=shift;
311: my @cols=();
312: if ($n) {
313: $cols[0]=$rl{$f{'A'.$n}};
314: } else {
315: $cols[0]='<b><font size=+1>Export</font></b>';
316: }
317: map {
318: my $fm=$f{$_.$n};
319: $fm=~s/[\'\"]/\&\#34;/g;
320: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
321: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 322: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
323: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
324: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 325: return @cols;
326: }
327:
1.14 www 328: sub exportrowa {
329: my $rowa='';
330: map {
331: $rowa.=$v{$_.'0'}."','";
332: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
333: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
334: $rowa=~s/\'\,\'$//;
335: return $rowa;
336: }
337:
1.4 www 338: # ------------------------------------------- End of "Inside of the safe space"
339: ENDDEFS
340: $safeeval->reval($code);
341: return $safeeval;
342: }
343:
344: # ------------------------------------------------ Add or change formula values
345:
346: sub setformulas {
347: my ($safeeval,@f)=@_;
1.6 www 348: $safeeval->reval('%f='."('".join("','",@f)."');");
349: }
350:
351: # ------------------------------------------------ Add or change formula values
352:
353: sub setconstants {
354: my ($safeeval,@c)=@_;
355: $safeeval->reval('%c='."('".join("','",@c)."');");
356: }
357:
358: # ------------------------------------------------ Add or change formula values
359:
360: sub setrowlabels {
361: my ($safeeval,@rl)=@_;
362: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 363: }
364:
365: # ------------------------------------------------------- Calculate spreadsheet
366:
367: sub calcsheet {
368: my $safeeval=shift;
369: $safeeval->reval('&calc();');
370: }
371:
372: # ------------------------------------------------------------------ Get values
373:
374: sub getvalues {
375: my $safeeval=shift;
376: return $safeeval->reval('%v');
377: }
378:
379: # ---------------------------------------------------------------- Get formulas
380:
381: sub getformulas {
382: my $safeeval=shift;
383: return $safeeval->reval('%f');
384: }
385:
1.5 www 386: # -------------------------------------------------------------------- Set type
387:
388: sub settype {
389: my ($safeeval,$type)=@_;
1.11 www 390: $safeeval->reval('$sheettype="'.$type.'";');
1.5 www 391: }
392:
393: # -------------------------------------------------------------------- Get type
394:
395: sub gettype {
396: my $safeeval=shift;
397: return $safeeval->reval('$sheettype');
398: }
1.6 www 399: # ------------------------------------------------------------------ Set maxrow
400:
401: sub setmaxrow {
402: my ($safeeval,$row)=@_;
403: $safeeval->reval('$maxrow='.$row.';');
404: }
405:
406: # ------------------------------------------------------------------ Get maxrow
407:
408: sub getmaxrow {
409: my $safeeval=shift;
410: return $safeeval->reval('$maxrow');
411: }
1.5 www 412:
1.6 www 413: # ---------------------------------------------------------------- Set filename
1.5 www 414:
415: sub setfilename {
416: my ($safeeval,$fn)=@_;
1.11 www 417: $safeeval->reval('$filename="'.$fn.'";');
1.5 www 418: }
419:
1.6 www 420: # ---------------------------------------------------------------- Get filename
1.5 www 421:
422: sub getfilename {
423: my $safeeval=shift;
424: return $safeeval->reval('$filename');
425: }
1.14 www 426:
427: # ------------------------------------------------------------- Export of A-row
428:
429: sub exportrow {
430: my $safeeval=shift;
431: return $safeeval->reval('&exportrowa()');
432: }
433:
1.5 www 434: # ========================================================== End of Spreadsheet
435: # =============================================================================
436:
437:
1.6 www 438: # --------------------------------------------- Produce output row n from sheet
439:
440: sub rown {
441: my ($safeeval,$n)=@_;
1.9 www 442: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 443: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
444: my $showf=0;
1.16 ! www 445: my $proc;
! 446: if (&gettype($safeeval) eq 'assesscalc') {
! 447: $proc='&outrowassess';
! 448: } else {
! 449: $proc='&outrow';
! 450: }
1.6 www 451: map {
1.9 www 452: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 453: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
454: if ($showf==0) { $vl=$_; }
1.9 www 455: if ($showf<=1) { $bgcolor='#FFDDDD'; }
456: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.6 www 457: if ($showf>1) {
458: if ($vl eq '') {
1.9 www 459: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 460: }
461: $rowdata.=
1.10 www 462: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 463: '</a></td>';
464: } else {
1.9 www 465: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 466: }
467: $showf++;
1.16 ! www 468: } $safeeval->reval($proc.'('.$n.')');
1.6 www 469: return $rowdata.'</tr>';
470: }
471:
472: # ------------------------------------------------------------- Print out sheet
473:
474: sub outsheet {
475: my $safeeval=shift;
1.9 www 476: my $tabledata='<table border=2><tr><td colspan=2> </td>'.
477: '<td bgcolor=#FFDDDD><b>A Import</b></td>';
1.6 www 478: map {
479: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
1.9 www 480: } ('B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 481: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
482: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
483: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 484: $tabledata.='</tr>';
485: my $row;
486: my $maxrow=&getmaxrow($safeeval);
487: for ($row=0;$row<=$maxrow;$row++) {
488: $tabledata.=&rown($safeeval,$row);
489: }
490: $tabledata.='</table>';
491: }
492:
493:
1.5 www 494:
495: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 496:
1.5 www 497: sub readsheet {
1.8 www 498: my ($safeeval,$fn)=@_;
1.5 www 499: &setfilename($safeeval,$fn);
500: $fn=~/\.(\w+)/;
501: &settype($safeeval,$1);
1.4 www 502: my %f=();
1.10 www 503: unless ($spreadsheets{$fn}) {
504: $spreadsheets{$fn}='';
505: {
506: my $fh;
507: if ($fh=Apache::File->new($fn)) {
508: $spreadsheets{$fn}=join('',<$fh>);
509: }
510: }
1.3 www 511: }
512: {
1.10 www 513: my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
1.3 www 514: my $token;
515: while ($token=$parser->get_token) {
516: if ($token->[0] eq 'S') {
517: if ($token->[1] eq 'field') {
518: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
519: $parser->get_text('/field');
520: }
521: }
522: }
523: }
1.5 www 524: &setformulas($safeeval,%f);
1.3 www 525: }
526:
1.10 www 527: # ----------------------------------------------- Make a temp copy of the sheet
528:
529: sub tmpwrite {
1.11 www 530: my ($safeeval,$tmpdir,$symb)=@_;
1.10 www 531: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
532: $fn=~s/\W/\_/g;
533: $fn=$tmpdir.$fn.'.tmp';
534: my $fh;
535: if ($fh=Apache::File->new('>'.$fn)) {
536: print $fh join("\n",&getformulas($safeeval));
537: }
538: }
539:
540: # ---------------------------------------------------------- Read the temp copy
541:
542: sub tmpread {
1.11 www 543: my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
1.10 www 544: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
545: $fn=~s/\W/\_/g;
546: $fn=$tmpdir.$fn.'.tmp';
547: my $fh;
548: my %fo=();
549: if ($fh=Apache::File->new($fn)) {
550: my $name;
551: while ($name=<$fh>) {
552: chomp($name);
553: my $value=<$fh>;
554: chomp($value);
555: $fo{$name}=$value;
556: }
557: }
558: $fo{$nfield}=$nform;
559: &setformulas($safeeval,%fo);
560: }
561:
1.3 www 562: # --------------------------------------------------------------- Read metadata
563:
564: sub readmeta {
565: my $fn=shift;
566: unless ($fn=~/\.meta$/) { $fn.='meta'; }
567: my $content;
568: my %returnhash=();
569: {
570: my $fh=Apache::File->new($fn);
571: $content=join('',<$fh>);
572: }
573: my $parser=HTML::TokeParser->new(\$content);
574: my $token;
575: while ($token=$parser->get_token) {
576: if ($token->[0] eq 'S') {
577: my $entry=$token->[1];
578: if (($entry eq 'stores') || ($entry eq 'parameter')) {
579: my $unikey=$entry;
580: $unikey.='_'.$token->[2]->{'part'};
581: $unikey.='_'.$token->[2]->{'name'};
582: $returnhash{$unikey}=$token->[2]->{'display'};
583: }
584: }
585: }
586: return %returnhash;
587: }
588:
1.11 www 589: # ================================================================== Parameters
590: # -------------------------------------------- Figure out a cascading parameter
591:
592: sub parmval {
593: my ($what,$symb)=@_;
594:
595: unless ($symb) { return ''; }
596: my $result='';
597:
598: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
599: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 600: my $rwhat=$what;
601: $what=~s/^parameter\_//;
602: $what=~s/\_/\./;
1.11 www 603:
604: my $symbparm=$symb.'.'.$what;
605: my $mapparm=$mapname.'___(all).'.$what;
606:
607: my $seclevel=
608: $ENV{'request.course.id'}.'.['.
609: $csec.'].'.$what;
610: my $seclevelr=
611: $ENV{'request.course.id'}.'.['.
612: $csec.'].'.$symbparm;
613: my $seclevelm=
614: $ENV{'request.course.id'}.'.['.
615: $csec.'].'.$mapparm;
616:
617: my $courselevel=
618: $ENV{'request.course.id'}.'.'.$what;
619: my $courselevelr=
620: $ENV{'request.course.id'}.'.'.$symbparm;
621: my $courselevelm=
622: $ENV{'request.course.id'}.'.'.$mapparm;
1.12 www 623:
1.11 www 624: # ---------------------------------------------------------- fourth, check user
625:
626: if ($uname) {
627:
628: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
629:
630: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
631:
632: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
633:
634: }
635:
636: # --------------------------------------------------------- third, check course
637:
638: if ($csec) {
639:
640: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
641:
642: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
643:
644: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
645:
646: }
647:
648: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
649:
650: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
651:
652: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
653:
654: # ----------------------------------------------------- second, check map parms
655:
656: my $thisparm=$parmhash{$symbparm};
657: if ($thisparm) { return $thisparm; }
658:
659: # -------------------------------------------------------- first, check default
660:
1.12 www 661: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 662:
663: }
664:
665:
1.5 www 666: # ----------------------------------------------------------------- Update rows
667:
668: sub updaterows {
669: my $safeeval=shift;
670: my %bighash;
671: # -------------------------------------------------------------------- Tie hash
672: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
673: &GDBM_READER,0640)) {
674: # --------------------------------------------------------- Get all assessments
675:
676: my %allkeys=();
677: my %allassess=();
678:
679: my $stype=&gettype($safeeval);
680:
681: map {
682: if ($_=~/^src\_(\d+)\.(\d+)$/) {
683: my $mapid=$1;
684: my $resid=$2;
685: my $id=$mapid.'.'.$resid;
686: my $srcf=$bighash{$_};
687: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
688: my $symb=
689: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
690: '___'.$resid.'___'.
691: &Apache::lonnet::declutter($srcf);
692: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 693:
1.6 www 694: if ($stype eq 'assesscalc') {
1.5 www 695: map {
1.11 www 696: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 697: my $key=$_;
698: my $display=
699: &Apache::lonnet::metadata($srcf,$key.'.display');
700: unless ($display) {
701: $display=
702: &Apache::lonnet::metadata($srcf,$key.'.name');
703: }
704: $allkeys{$key}=$display;
705: }
706: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
707: }
708: }
709: }
710: } keys %bighash;
711: untie(%bighash);
712:
713: #
1.11 www 714: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 715: # %allassess has a list of all resource displays by symb
716: #
717: # -------------------- Find discrepancies between the course row table and this
718: #
719: my %f=&getformulas($safeeval);
1.6 www 720: my $changed=0;
721:
722: my %current=();
723: if ($stype eq 'assesscalc') {
724: %current=%allkeys;
725: } elsif ($stype eq 'studentcalc') {
726: %current=%allassess;
727: }
728:
729: my $maxrow=0;
730: my %existing=();
731:
732: # ----------------------------------------------------------- Now obsolete rows
1.5 www 733: map {
1.6 www 734: if ($_=~/^A(\d+)/) {
735: $maxrow=($1>$maxrow)?$1:$maxrow;
736: $existing{$f{$_}}=1;
737: unless (defined($current{$f{$_}})) {
738: $f{$_}='!!! Obsolete';
739: $changed=1;
1.5 www 740: }
741: }
742: } keys %f;
1.6 www 743:
744: # -------------------------------------------------------- New and unknown keys
745:
746: map {
747: unless ($existing{$_}) {
748: $changed=1;
749: $maxrow++;
750: $f{'A'.$maxrow}=$_;
751: }
752: } keys %current;
753:
754: if ($changed) { &setformulas($safeeval,%f); }
755:
756: &setmaxrow($safeeval,$maxrow);
757: &setrowlabels($safeeval,%current);
1.5 www 758:
759: } else {
760: return 'Could not access course data';
761: }
762: }
1.3 www 763:
1.16 ! www 764: # --------------------------------------------------- Load data for one student
! 765:
! 766: sub rowazstudent {
! 767: my $safeeval=shift;
! 768: my %c=();
! 769: my %f=&getformulas($safeeval);
! 770: map {
! 771: if ($_=~/^A/) {
! 772: unless ($f{$_}=~/^\!/) {
! 773: print &Apache::lonnet::ssi(
! 774: '/res/msu/korte/junk.assesscalc',('utarget' => 'export',
! 775: 'uname' => $uname,
! 776: 'udom' => $udom,
! 777: 'usymb' => $f{$_})).
! 778: '<br>'.$f{$_}.'<br>';
! 779: }
! 780: }
! 781: } keys %f;
! 782:
! 783: &setconstants($safeeval,%c);
! 784: }
! 785:
1.6 www 786: # ------------------------------------------------ Load data for one assessment
787:
788: sub rowaassess {
1.11 www 789: my ($safeeval,$symb)=@_;
1.6 www 790: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
791: my $namespace;
792: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
1.11 www 793:
794: # ----------------------------------------------------------- Get stored values
795: my $answer=&Apache::lonnet::reply(
1.15 www 796: "restore:$udom:$uname:".
797: &Apache::lonnet::escape($namespace).":".
798: &Apache::lonnet::escape($symb),$uhome);
1.6 www 799: my %returnhash=();
800: map {
801: my ($name,$value)=split(/\=/,$_);
1.11 www 802: $returnhash{&Apache::lonnet::unescape($name)}=
803: &Apache::lonnet::unescape($value);
1.6 www 804: } split(/\&/,$answer);
805: my $version;
806: for ($version=1;$version<=$returnhash{'version'};$version++) {
807: map {
808: $returnhash{$_}=$returnhash{$version.':'.$_};
809: } split(/\:/,$returnhash{$version.':keys'});
810: }
1.11 www 811: # ----------------------------- returnhash now has all stores for this resource
812:
813: # ---------------------------- initialize coursedata and userdata for this user
814: %courseopt=();
815: %useropt=();
816: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
817: unless ($uhome eq 'no_host') {
818: # -------------------------------------------------------------- Get coursedata
1.13 www 819: unless
820: ((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
1.11 www 821: my $reply=&Apache::lonnet::reply('dump:'.
822: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
823: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
824: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
825: if ($reply!~/^error\:/) {
826: $courserdatas{$ENV{'request.course.id'}}=$reply;
1.13 www 827: $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
1.11 www 828: }
829: }
830: map {
831: my ($name,$value)=split(/\=/,$_);
832: $courseopt{&Apache::lonnet::unescape($name)}=
833: &Apache::lonnet::unescape($value);
834: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
835: # --------------------------------------------------- Get userdata (if present)
1.13 www 836: unless
837: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
1.11 www 838: my $reply=
839: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
840: if ($reply!~/^error\:/) {
841: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 842: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 843: }
844: }
845: map {
846: my ($name,$value)=split(/\=/,$_);
847: $useropt{&Apache::lonnet::unescape($name)}=
1.15 www 848: &Apache::lonnet::unescape($value);
1.11 www 849: } split(/\&/,$userrdatas{$uname.'___'.$udom});
850: }
851: # -- now courseopt, useropt initialized for this user and course (used parmval)
1.6 www 852:
853: my %c=();
854: my %f=&getformulas($safeeval);
855: map {
856: if ($_=~/^A/) {
857: unless ($f{$_}=~/^\!/) {
1.11 www 858: if ($f{$_}=~/^parameter/) {
859: $c{$_}=&parmval($f{$_},$symb);
860: } else {
1.15 www 861: my $key=$f{$_};
862: $key=~s/^stores\_/resource\./;
863: $key=~s/\_/\./;
864: $c{$_}=$returnhash{$key};
1.11 www 865: }
866: }
1.6 www 867: }
868: } keys %f;
1.11 www 869:
1.6 www 870: &setconstants($safeeval,%c);
871: }
872:
1.10 www 873: # --------------------------------------------------------- Various form fields
874:
875: sub textfield {
876: my ($title,$name,$value)=@_;
877: return "\n<p><b>$title:</b><br>".
878: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
879: }
880:
881: sub hiddenfield {
882: my ($name,$value)=@_;
883: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
884: }
885:
886: sub selectbox {
887: my ($title,$name,$value,%options)=@_;
888: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
889: map {
890: $selout.='<option value="'.$_.'"';
891: if ($_ eq $value) { $selout.=' selected'; }
892: $selout.='>'.$options{$_}.'</option>';
893: } sort keys %options;
894: return $selout.'</select>';
895: }
896:
1.12 www 897: # ================================================================ Main handler
1.3 www 898:
899: sub handler {
1.7 www 900: my $r=shift;
901:
1.11 www 902: $uname='';
903: $udom='';
904: $csec='';
905:
1.7 www 906: if ($r->header_only) {
907: $r->content_type('text/html');
908: $r->send_http_header;
909: return OK;
910: }
1.3 www 911:
1.7 www 912: # ----------------------------------------------------- Needs to be in a course
1.3 www 913:
1.7 www 914: if (($ENV{'request.course.fn'}) ||
915: ($ENV{'request.state'} eq 'construct')) {
1.10 www 916:
917: # --------------------------- Get query string for limited number of parameters
918: map {
919: my ($name, $value) = split(/=/,$_);
920: $value =~ tr/+/ /;
921: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.11 www 922: if (($name eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
1.10 www 923: unless ($ENV{'form.'.$name}) {
924: $ENV{'form.'.$name}=$value;
925: }
926: }
927: } (split(/&/,$ENV{'QUERY_STRING'}));
928:
929: # ------------------------------------------- Nothing there? Must be login user
930:
931: unless ($ENV{'form.uname'}) {
1.11 www 932: $uname=$ENV{'user.name'};
933: $udom=$ENV{'user.domain'};
934: } else {
935: $uname=$ENV{'form.uname'};
936: $udom=$ENV{'form.udom'};
1.10 www 937: }
1.14 www 938: # ----------------------------------------------------------- Change of target?
939:
1.16 ! www 940: my $reroute=($ENV{'form.utarget'} eq 'export');
1.14 www 941:
1.10 www 942: # ------------------------------------------------------------------- Open page
943:
1.7 www 944: $r->content_type('text/html');
1.11 www 945: $r->header_out('Cache-control','no-cache');
946: $r->header_out('Pragma','no-cache');
1.7 www 947: $r->send_http_header;
1.3 www 948:
1.14 www 949: # --------------------------------------------------------------- Screen output
950:
951: unless ($reroute) {
1.10 www 952: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
953: $r->print(<<ENDSCRIPT);
954: <script language="JavaScript">
955:
956: function celledit(cn,cf) {
957: var cnf=prompt(cn,cf);
958: if (cnf!=null) {
959: document.sheet.unewfield.value=cn;
960: document.sheet.unewformula.value=cnf;
961: document.sheet.submit();
962: }
963: }
964:
965: </script>
966: ENDSCRIPT
967: $r->print('</head><body bgcolor="#FFFFFF">'.
968: '<form action="'.$r->uri.'" name=sheet method=post>'.
969: &hiddenfield('uname',$ENV{'form.uname'}).
970: &hiddenfield('udom',$ENV{'form.udom'}).
971: &hiddenfield('usymb',$ENV{'form.usymb'}).
972: &hiddenfield('unewfield','').
973: &hiddenfield('unewformula',''));
1.14 www 974: }
975:
976: # ---------------------------------------- Read new sheet or modified worksheet
977:
1.4 www 978: my $sheetone=initsheet();
1.10 www 979: if ($ENV{'form.unewfield'}) {
980: $r->print('<h2>Modified Workcopy</h2>');
981: $ENV{'form.unewformula'}=~s/\'/\"/g;
982: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
983: $ENV{'form.unewformula'}.'<br>');
984: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1.11 www 985: $ENV{'form.usymb'},
1.10 www 986: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
987: &setfilename($sheetone,$r->filename);
988: $r->filename=~/\.(\w+)/;
989: &settype($sheetone,$1);
1.11 www 990: } else {
991: &readsheet($sheetone,$r->filename);
992: }
1.14 www 993:
994: # --------------------------------------------- See if all import rows uptodate
995:
1.11 www 996: if (tie(%parmhash,'GDBM_File',
997: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
998: $csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
999: if ($csec eq '-1') {
1000: $r->print('<h3><font color=red>'.
1001: "User '$uname' at domain '$udom' not a student in this course</font></h3>");
1002: }
1003: &updaterows($sheetone);
1004: untie(%parmhash);
1.10 www 1005: } else {
1.11 www 1006: $r->print('<h3><font color=red>'.
1007: 'Could not initialize import fields (not in a course)</font></h3>');
1008: }
1.14 www 1009:
1010: # ------------------------------------------------ Write the modified worksheet
1011:
1.11 www 1012: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1013: $ENV{'form.usymb'});
1.14 www 1014:
1015: # ----------------------------------------------------- Print user, course, etc
1016: unless ($reroute) {
1.11 www 1017: $r->print("<b>User '$uname' at domain '$udom' for '".
1018: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
1019: if ($csec) {
1020: $r->print(", group/section '$csec'");
1021: }
1022: $r->print("</b>\n");
1.14 www 1023: }
1024: # -------------------------------------------------------- Import and calculate
1025:
1.11 www 1026: if (&gettype($sheetone) eq 'assesscalc') {
1027: &rowaassess($sheetone,$ENV{'form.usymb'});
1.16 ! www 1028: } elsif (&gettype($sheetone) eq 'studentcalc') {
! 1029: &rowazstudent($sheetone);
1.10 www 1030: }
1.6 www 1031: &calcsheet($sheetone);
1.14 www 1032:
1033: # ------------------------------------------------------- Print or export sheet
1034: unless ($reroute) {
1.6 www 1035: $r->print(&outsheet($sheetone));
1.8 www 1036:
1.10 www 1037: $r->print('</form></body></html>');
1.14 www 1038: } else {
1039: $r->print(&exportrow($sheetone));
1040: }
1041: # ------------------------------------------------------------------------ Done
1.7 www 1042: } else {
1043: # ----------------------------- Not in a course, or not allowed to modify parms
1044: $ENV{'user.error.msg'}=
1045: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1046: return HTTP_NOT_ACCEPTABLE;
1047: }
1.3 www 1048: return OK;
1.1 www 1049: }
1050:
1051: 1;
1052: __END__
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
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