Annotation of loncom/interface/lonspreadsheet.pm, revision 1.18
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.17 www 5: # 12/08,12/09,12/11,12/12,12/15,12/16,12/18 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;
1.17 www 282: $t{'A0'}=$f{'A0'};
283: $t{'A0'}=~s/\.\.+/\,/g;
284: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.1 www 285: }
286:
1.4 www 287: sub calc {
1.1 www 288: %v=();
1.4 www 289: &sett();
1.1 www 290: my $notfinished=1;
291: my $depth=0;
292: while ($notfinished) {
293: $notfinished=0;
294: map {
295: my $old=$v{$_};
1.4 www 296: $v{$_}=eval($t{$_});
1.1 www 297: if ($@) {
298: %v=();
299: return $@;
300: }
301: if ($v{$_} ne $old) { $notfinished=1; }
302: } keys %t;
303: $depth++;
304: if ($depth>100) {
305: %v=();
306: return 'Maximum calculation depth exceeded';
307: }
308: }
309: return '';
310: }
311:
1.16 www 312: sub outrowassess {
1.6 www 313: my $n=shift;
314: my @cols=();
315: if ($n) {
316: $cols[0]=$rl{$f{'A'.$n}};
317: } else {
318: $cols[0]='<b><font size=+1>Export</font></b>';
319: }
320: map {
321: my $fm=$f{$_.$n};
322: $fm=~s/[\'\"]/\&\#34;/g;
323: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
324: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 325: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
326: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
327: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 328: return @cols;
329: }
330:
1.18 ! www 331: sub outrow {
! 332: my $n=shift;
! 333: my @cols=();
! 334: if ($n) {
! 335: $cols[0]=$rl{$f{'A'.$n}}.' stuff';
! 336: } else {
! 337: $cols[0]='<b><font size=+1>Export</font></b>';
! 338: }
! 339: map {
! 340: my $fm=$f{$_.$n};
! 341: $fm=~s/[\'\"]/\&\#34;/g;
! 342: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
! 343: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
! 344: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
! 345: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
! 346: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
! 347: return @cols;
! 348: }
! 349:
1.14 www 350: sub exportrowa {
351: my $rowa='';
352: map {
1.18 ! www 353: $rowa.=$v{$_.'0'}."___;___";
1.14 www 354: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
355: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.18 ! www 356: $rowa=~s/\_\_\_\;\_\_\_$//;
1.14 www 357: return $rowa;
358: }
359:
1.4 www 360: # ------------------------------------------- End of "Inside of the safe space"
361: ENDDEFS
362: $safeeval->reval($code);
363: return $safeeval;
364: }
365:
366: # ------------------------------------------------ Add or change formula values
367:
368: sub setformulas {
369: my ($safeeval,@f)=@_;
1.6 www 370: $safeeval->reval('%f='."('".join("','",@f)."');");
371: }
372:
373: # ------------------------------------------------ Add or change formula values
374:
375: sub setconstants {
376: my ($safeeval,@c)=@_;
377: $safeeval->reval('%c='."('".join("','",@c)."');");
378: }
379:
380: # ------------------------------------------------ Add or change formula values
381:
382: sub setrowlabels {
383: my ($safeeval,@rl)=@_;
384: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 385: }
386:
387: # ------------------------------------------------------- Calculate spreadsheet
388:
389: sub calcsheet {
390: my $safeeval=shift;
391: $safeeval->reval('&calc();');
392: }
393:
394: # ------------------------------------------------------------------ Get values
395:
396: sub getvalues {
397: my $safeeval=shift;
398: return $safeeval->reval('%v');
399: }
400:
401: # ---------------------------------------------------------------- Get formulas
402:
403: sub getformulas {
404: my $safeeval=shift;
405: return $safeeval->reval('%f');
406: }
407:
1.5 www 408: # -------------------------------------------------------------------- Set type
409:
410: sub settype {
411: my ($safeeval,$type)=@_;
1.11 www 412: $safeeval->reval('$sheettype="'.$type.'";');
1.5 www 413: }
414:
415: # -------------------------------------------------------------------- Get type
416:
417: sub gettype {
418: my $safeeval=shift;
419: return $safeeval->reval('$sheettype');
420: }
1.6 www 421: # ------------------------------------------------------------------ Set maxrow
422:
423: sub setmaxrow {
424: my ($safeeval,$row)=@_;
425: $safeeval->reval('$maxrow='.$row.';');
426: }
427:
428: # ------------------------------------------------------------------ Get maxrow
429:
430: sub getmaxrow {
431: my $safeeval=shift;
432: return $safeeval->reval('$maxrow');
433: }
1.5 www 434:
1.6 www 435: # ---------------------------------------------------------------- Set filename
1.5 www 436:
437: sub setfilename {
438: my ($safeeval,$fn)=@_;
1.11 www 439: $safeeval->reval('$filename="'.$fn.'";');
1.5 www 440: }
441:
1.6 www 442: # ---------------------------------------------------------------- Get filename
1.5 www 443:
444: sub getfilename {
445: my $safeeval=shift;
446: return $safeeval->reval('$filename');
447: }
1.14 www 448:
449: # ------------------------------------------------------------- Export of A-row
450:
451: sub exportrow {
452: my $safeeval=shift;
453: return $safeeval->reval('&exportrowa()');
454: }
455:
1.5 www 456: # ========================================================== End of Spreadsheet
457: # =============================================================================
458:
459:
1.6 www 460: # --------------------------------------------- Produce output row n from sheet
461:
462: sub rown {
463: my ($safeeval,$n)=@_;
1.9 www 464: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 465: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
466: my $showf=0;
1.16 www 467: my $proc;
1.18 ! www 468: my $maxred;
1.16 www 469: if (&gettype($safeeval) eq 'assesscalc') {
470: $proc='&outrowassess';
1.18 ! www 471: $maxred=1;
1.16 www 472: } else {
473: $proc='&outrow';
1.18 ! www 474: $maxred=26;
1.16 www 475: }
1.6 www 476: map {
1.9 www 477: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 478: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
479: if ($showf==0) { $vl=$_; }
1.18 ! www 480: if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
1.9 www 481: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.18 ! www 482: if (($showf>$maxred) || ((!$n) && ($showf>0))) {
1.6 www 483: if ($vl eq '') {
1.9 www 484: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 485: }
486: $rowdata.=
1.10 www 487: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 488: '</a></td>';
489: } else {
1.9 www 490: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 491: }
492: $showf++;
1.16 www 493: } $safeeval->reval($proc.'('.$n.')');
1.6 www 494: return $rowdata.'</tr>';
495: }
496:
497: # ------------------------------------------------------------- Print out sheet
498:
499: sub outsheet {
500: my $safeeval=shift;
1.18 ! www 501: my $maxred;
! 502: my $realm;
! 503: if (&gettype($safeeval) eq 'assesscalc') {
! 504: $maxred=1;
! 505: $realm='Assessment';
! 506: } elsif (&gettype($safeeval) eq 'studentcalc') {
! 507: $maxred=26;
! 508: $realm='User';
! 509: } else {
! 510: $maxred=26;
! 511: $realm='Course';
! 512: }
! 513: my $maxyellow=52-$maxred;
! 514: my $tabledata='<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
! 515: $realm.'</font></th>'.
! 516: '<td bgcolor=#FFDDDD colspan='.$maxred.
! 517: '><b><font size=+1>Import</font></b></td>'.
! 518: '<td colspan='.$maxyellow.
! 519: '><b><font size=+1>Calculations</font></b></td></tr><tr>';
! 520: my $showf=0;
1.6 www 521: map {
1.18 ! www 522: $showf++;
! 523: if ($showf<=$maxred) {
! 524: $tabledata.='<td bgcolor="#FFDDDD">';
! 525: } else {
! 526: $tabledata.='<td>';
! 527: }
! 528: $tabledata.="<b><font size=+1>$_</font></b></td>";
! 529: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 530: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
531: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
532: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 533: $tabledata.='</tr>';
534: my $row;
535: my $maxrow=&getmaxrow($safeeval);
536: for ($row=0;$row<=$maxrow;$row++) {
537: $tabledata.=&rown($safeeval,$row);
538: }
539: $tabledata.='</table>';
540: }
541:
542:
1.5 www 543:
544: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 545:
1.5 www 546: sub readsheet {
1.8 www 547: my ($safeeval,$fn)=@_;
1.5 www 548: &setfilename($safeeval,$fn);
549: $fn=~/\.(\w+)/;
550: &settype($safeeval,$1);
1.4 www 551: my %f=();
1.10 www 552: unless ($spreadsheets{$fn}) {
553: $spreadsheets{$fn}='';
554: {
555: my $fh;
556: if ($fh=Apache::File->new($fn)) {
557: $spreadsheets{$fn}=join('',<$fh>);
558: }
559: }
1.3 www 560: }
561: {
1.10 www 562: my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
1.3 www 563: my $token;
564: while ($token=$parser->get_token) {
565: if ($token->[0] eq 'S') {
566: if ($token->[1] eq 'field') {
567: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
568: $parser->get_text('/field');
569: }
570: }
571: }
572: }
1.5 www 573: &setformulas($safeeval,%f);
1.3 www 574: }
575:
1.10 www 576: # ----------------------------------------------- Make a temp copy of the sheet
577:
578: sub tmpwrite {
1.11 www 579: my ($safeeval,$tmpdir,$symb)=@_;
1.10 www 580: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
581: $fn=~s/\W/\_/g;
582: $fn=$tmpdir.$fn.'.tmp';
583: my $fh;
584: if ($fh=Apache::File->new('>'.$fn)) {
585: print $fh join("\n",&getformulas($safeeval));
586: }
587: }
588:
589: # ---------------------------------------------------------- Read the temp copy
590:
591: sub tmpread {
1.11 www 592: my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
1.10 www 593: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
594: $fn=~s/\W/\_/g;
595: $fn=$tmpdir.$fn.'.tmp';
596: my $fh;
597: my %fo=();
598: if ($fh=Apache::File->new($fn)) {
599: my $name;
600: while ($name=<$fh>) {
601: chomp($name);
602: my $value=<$fh>;
603: chomp($value);
604: $fo{$name}=$value;
605: }
606: }
607: $fo{$nfield}=$nform;
608: &setformulas($safeeval,%fo);
609: }
610:
1.3 www 611: # --------------------------------------------------------------- Read metadata
612:
613: sub readmeta {
614: my $fn=shift;
615: unless ($fn=~/\.meta$/) { $fn.='meta'; }
616: my $content;
617: my %returnhash=();
618: {
619: my $fh=Apache::File->new($fn);
620: $content=join('',<$fh>);
621: }
622: my $parser=HTML::TokeParser->new(\$content);
623: my $token;
624: while ($token=$parser->get_token) {
625: if ($token->[0] eq 'S') {
626: my $entry=$token->[1];
627: if (($entry eq 'stores') || ($entry eq 'parameter')) {
628: my $unikey=$entry;
629: $unikey.='_'.$token->[2]->{'part'};
630: $unikey.='_'.$token->[2]->{'name'};
631: $returnhash{$unikey}=$token->[2]->{'display'};
632: }
633: }
634: }
635: return %returnhash;
636: }
637:
1.11 www 638: # ================================================================== Parameters
639: # -------------------------------------------- Figure out a cascading parameter
640:
641: sub parmval {
642: my ($what,$symb)=@_;
643:
644: unless ($symb) { return ''; }
645: my $result='';
646:
647: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
648: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 649: my $rwhat=$what;
650: $what=~s/^parameter\_//;
651: $what=~s/\_/\./;
1.11 www 652:
653: my $symbparm=$symb.'.'.$what;
654: my $mapparm=$mapname.'___(all).'.$what;
655:
656: my $seclevel=
657: $ENV{'request.course.id'}.'.['.
658: $csec.'].'.$what;
659: my $seclevelr=
660: $ENV{'request.course.id'}.'.['.
661: $csec.'].'.$symbparm;
662: my $seclevelm=
663: $ENV{'request.course.id'}.'.['.
664: $csec.'].'.$mapparm;
665:
666: my $courselevel=
667: $ENV{'request.course.id'}.'.'.$what;
668: my $courselevelr=
669: $ENV{'request.course.id'}.'.'.$symbparm;
670: my $courselevelm=
671: $ENV{'request.course.id'}.'.'.$mapparm;
1.12 www 672:
1.11 www 673: # ---------------------------------------------------------- fourth, check user
674:
675: if ($uname) {
676:
677: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
678:
679: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
680:
681: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
682:
683: }
684:
685: # --------------------------------------------------------- third, check course
686:
687: if ($csec) {
688:
689: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
690:
691: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
692:
693: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
694:
695: }
696:
697: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
698:
699: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
700:
701: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
702:
703: # ----------------------------------------------------- second, check map parms
704:
705: my $thisparm=$parmhash{$symbparm};
706: if ($thisparm) { return $thisparm; }
707:
708: # -------------------------------------------------------- first, check default
709:
1.12 www 710: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 711:
712: }
713:
714:
1.5 www 715: # ----------------------------------------------------------------- Update rows
716:
717: sub updaterows {
718: my $safeeval=shift;
719: my %bighash;
720: # -------------------------------------------------------------------- Tie hash
721: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
722: &GDBM_READER,0640)) {
723: # --------------------------------------------------------- Get all assessments
724:
725: my %allkeys=();
726: my %allassess=();
727:
728: my $stype=&gettype($safeeval);
729:
730: map {
731: if ($_=~/^src\_(\d+)\.(\d+)$/) {
732: my $mapid=$1;
733: my $resid=$2;
734: my $id=$mapid.'.'.$resid;
735: my $srcf=$bighash{$_};
736: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
737: my $symb=
738: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
739: '___'.$resid.'___'.
740: &Apache::lonnet::declutter($srcf);
741: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 742:
1.6 www 743: if ($stype eq 'assesscalc') {
1.5 www 744: map {
1.11 www 745: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 746: my $key=$_;
747: my $display=
748: &Apache::lonnet::metadata($srcf,$key.'.display');
749: unless ($display) {
750: $display=
751: &Apache::lonnet::metadata($srcf,$key.'.name');
752: }
753: $allkeys{$key}=$display;
754: }
755: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
756: }
757: }
758: }
759: } keys %bighash;
760: untie(%bighash);
761:
762: #
1.11 www 763: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 764: # %allassess has a list of all resource displays by symb
765: #
766: # -------------------- Find discrepancies between the course row table and this
767: #
768: my %f=&getformulas($safeeval);
1.6 www 769: my $changed=0;
770:
771: my %current=();
772: if ($stype eq 'assesscalc') {
773: %current=%allkeys;
774: } elsif ($stype eq 'studentcalc') {
775: %current=%allassess;
776: }
777:
778: my $maxrow=0;
779: my %existing=();
780:
781: # ----------------------------------------------------------- Now obsolete rows
1.5 www 782: map {
1.6 www 783: if ($_=~/^A(\d+)/) {
784: $maxrow=($1>$maxrow)?$1:$maxrow;
785: $existing{$f{$_}}=1;
1.17 www 786: unless ((defined($current{$f{$_}})) || (!$1)) {
1.6 www 787: $f{$_}='!!! Obsolete';
788: $changed=1;
1.5 www 789: }
790: }
791: } keys %f;
1.6 www 792:
793: # -------------------------------------------------------- New and unknown keys
794:
795: map {
796: unless ($existing{$_}) {
797: $changed=1;
798: $maxrow++;
799: $f{'A'.$maxrow}=$_;
800: }
801: } keys %current;
802:
803: if ($changed) { &setformulas($safeeval,%f); }
804:
805: &setmaxrow($safeeval,$maxrow);
806: &setrowlabels($safeeval,%current);
1.5 www 807:
808: } else {
809: return 'Could not access course data';
810: }
811: }
1.3 www 812:
1.16 www 813: # --------------------------------------------------- Load data for one student
814:
815: sub rowazstudent {
816: my $safeeval=shift;
817: my %c=();
818: my %f=&getformulas($safeeval);
819: map {
1.17 www 820: if ($_=~/^A(\d+)/) {
821: my $row=$1;
1.16 www 822: unless ($f{$_}=~/^\!/) {
1.18 ! www 823: my @assessdata=split(/\_\_\_\;\_\_\_/,
1.17 www 824: &Apache::lonnet::ssi(
1.16 www 825: '/res/msu/korte/junk.assesscalc',('utarget' => 'export',
826: 'uname' => $uname,
827: 'udom' => $udom,
1.17 www 828: 'usymb' => $f{$_})));
829: my $index=0;
830: map {
1.18 ! www 831: if ($assessdata[$index]) {
! 832: $c{$_.$row}=$assessdata[$index];
! 833: unless ($_ eq 'A') {
! 834: $f{$_.$row}='import';
! 835: }
! 836: }
1.17 www 837: $index++;
838: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
839: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.16 www 840: }
841: }
842: } keys %f;
1.18 ! www 843: &setformulas($safeeval,%f);
1.16 www 844: &setconstants($safeeval,%c);
845: }
846:
1.6 www 847: # ------------------------------------------------ Load data for one assessment
848:
849: sub rowaassess {
1.11 www 850: my ($safeeval,$symb)=@_;
1.6 www 851: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
852: my $namespace;
853: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
1.11 www 854:
855: # ----------------------------------------------------------- Get stored values
856: my $answer=&Apache::lonnet::reply(
1.15 www 857: "restore:$udom:$uname:".
858: &Apache::lonnet::escape($namespace).":".
859: &Apache::lonnet::escape($symb),$uhome);
1.6 www 860: my %returnhash=();
861: map {
862: my ($name,$value)=split(/\=/,$_);
1.11 www 863: $returnhash{&Apache::lonnet::unescape($name)}=
864: &Apache::lonnet::unescape($value);
1.6 www 865: } split(/\&/,$answer);
866: my $version;
867: for ($version=1;$version<=$returnhash{'version'};$version++) {
868: map {
869: $returnhash{$_}=$returnhash{$version.':'.$_};
870: } split(/\:/,$returnhash{$version.':keys'});
871: }
1.11 www 872: # ----------------------------- returnhash now has all stores for this resource
873:
874: # ---------------------------- initialize coursedata and userdata for this user
875: %courseopt=();
876: %useropt=();
877: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
878: unless ($uhome eq 'no_host') {
879: # -------------------------------------------------------------- Get coursedata
1.13 www 880: unless
881: ((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
1.11 www 882: my $reply=&Apache::lonnet::reply('dump:'.
883: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
884: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
885: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
886: if ($reply!~/^error\:/) {
887: $courserdatas{$ENV{'request.course.id'}}=$reply;
1.13 www 888: $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
1.11 www 889: }
890: }
891: map {
892: my ($name,$value)=split(/\=/,$_);
893: $courseopt{&Apache::lonnet::unescape($name)}=
894: &Apache::lonnet::unescape($value);
895: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
896: # --------------------------------------------------- Get userdata (if present)
1.13 www 897: unless
898: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
1.11 www 899: my $reply=
900: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
901: if ($reply!~/^error\:/) {
902: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 903: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 904: }
905: }
906: map {
907: my ($name,$value)=split(/\=/,$_);
908: $useropt{&Apache::lonnet::unescape($name)}=
1.15 www 909: &Apache::lonnet::unescape($value);
1.11 www 910: } split(/\&/,$userrdatas{$uname.'___'.$udom});
911: }
912: # -- now courseopt, useropt initialized for this user and course (used parmval)
1.6 www 913:
914: my %c=();
915: my %f=&getformulas($safeeval);
916: map {
917: if ($_=~/^A/) {
918: unless ($f{$_}=~/^\!/) {
1.11 www 919: if ($f{$_}=~/^parameter/) {
920: $c{$_}=&parmval($f{$_},$symb);
921: } else {
1.15 www 922: my $key=$f{$_};
923: $key=~s/^stores\_/resource\./;
924: $key=~s/\_/\./;
925: $c{$_}=$returnhash{$key};
1.11 www 926: }
927: }
1.6 www 928: }
929: } keys %f;
1.11 www 930:
1.6 www 931: &setconstants($safeeval,%c);
932: }
933:
1.10 www 934: # --------------------------------------------------------- Various form fields
935:
936: sub textfield {
937: my ($title,$name,$value)=@_;
938: return "\n<p><b>$title:</b><br>".
939: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
940: }
941:
942: sub hiddenfield {
943: my ($name,$value)=@_;
944: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
945: }
946:
947: sub selectbox {
948: my ($title,$name,$value,%options)=@_;
949: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
950: map {
951: $selout.='<option value="'.$_.'"';
952: if ($_ eq $value) { $selout.=' selected'; }
953: $selout.='>'.$options{$_}.'</option>';
954: } sort keys %options;
955: return $selout.'</select>';
956: }
957:
1.12 www 958: # ================================================================ Main handler
1.3 www 959:
960: sub handler {
1.7 www 961: my $r=shift;
962:
1.11 www 963: $uname='';
964: $udom='';
965: $csec='';
966:
1.7 www 967: if ($r->header_only) {
968: $r->content_type('text/html');
969: $r->send_http_header;
970: return OK;
971: }
1.3 www 972:
1.7 www 973: # ----------------------------------------------------- Needs to be in a course
1.3 www 974:
1.7 www 975: if (($ENV{'request.course.fn'}) ||
976: ($ENV{'request.state'} eq 'construct')) {
1.10 www 977:
978: # --------------------------- Get query string for limited number of parameters
1.17 www 979:
1.10 www 980: map {
981: my ($name, $value) = split(/=/,$_);
982: $value =~ tr/+/ /;
983: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.11 www 984: if (($name eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
1.10 www 985: unless ($ENV{'form.'.$name}) {
986: $ENV{'form.'.$name}=$value;
987: }
988: }
989: } (split(/&/,$ENV{'QUERY_STRING'}));
990:
991: # ------------------------------------------- Nothing there? Must be login user
992:
993: unless ($ENV{'form.uname'}) {
1.11 www 994: $uname=$ENV{'user.name'};
995: $udom=$ENV{'user.domain'};
996: } else {
997: $uname=$ENV{'form.uname'};
998: $udom=$ENV{'form.udom'};
1.10 www 999: }
1.14 www 1000: # ----------------------------------------------------------- Change of target?
1001:
1.16 www 1002: my $reroute=($ENV{'form.utarget'} eq 'export');
1.14 www 1003:
1.10 www 1004: # ------------------------------------------------------------------- Open page
1005:
1.7 www 1006: $r->content_type('text/html');
1.11 www 1007: $r->header_out('Cache-control','no-cache');
1008: $r->header_out('Pragma','no-cache');
1.7 www 1009: $r->send_http_header;
1.3 www 1010:
1.14 www 1011: # --------------------------------------------------------------- Screen output
1012:
1013: unless ($reroute) {
1.10 www 1014: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
1015: $r->print(<<ENDSCRIPT);
1016: <script language="JavaScript">
1017:
1018: function celledit(cn,cf) {
1019: var cnf=prompt(cn,cf);
1020: if (cnf!=null) {
1021: document.sheet.unewfield.value=cn;
1022: document.sheet.unewformula.value=cnf;
1023: document.sheet.submit();
1024: }
1025: }
1026:
1027: </script>
1028: ENDSCRIPT
1029: $r->print('</head><body bgcolor="#FFFFFF">'.
1030: '<form action="'.$r->uri.'" name=sheet method=post>'.
1031: &hiddenfield('uname',$ENV{'form.uname'}).
1032: &hiddenfield('udom',$ENV{'form.udom'}).
1033: &hiddenfield('usymb',$ENV{'form.usymb'}).
1034: &hiddenfield('unewfield','').
1035: &hiddenfield('unewformula',''));
1.14 www 1036: }
1037:
1038: # ---------------------------------------- Read new sheet or modified worksheet
1039:
1.4 www 1040: my $sheetone=initsheet();
1.10 www 1041: if ($ENV{'form.unewfield'}) {
1042: $r->print('<h2>Modified Workcopy</h2>');
1043: $ENV{'form.unewformula'}=~s/\'/\"/g;
1044: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
1045: $ENV{'form.unewformula'}.'<br>');
1.17 www 1046: &setfilename($sheetone,$r->filename);
1047: $r->filename=~/\.(\w+)/;
1048: &settype($sheetone,$1);
1.10 www 1049: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1.11 www 1050: $ENV{'form.usymb'},
1.10 www 1051: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
1.11 www 1052: } else {
1053: &readsheet($sheetone,$r->filename);
1054: }
1.14 www 1055:
1056: # --------------------------------------------- See if all import rows uptodate
1057:
1.11 www 1058: if (tie(%parmhash,'GDBM_File',
1059: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
1060: $csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
1061: if ($csec eq '-1') {
1062: $r->print('<h3><font color=red>'.
1063: "User '$uname' at domain '$udom' not a student in this course</font></h3>");
1064: }
1065: &updaterows($sheetone);
1066: untie(%parmhash);
1.10 www 1067: } else {
1.11 www 1068: $r->print('<h3><font color=red>'.
1069: 'Could not initialize import fields (not in a course)</font></h3>');
1070: }
1.14 www 1071:
1072: # ------------------------------------------------ Write the modified worksheet
1073:
1.11 www 1074: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1075: $ENV{'form.usymb'});
1.14 www 1076:
1077: # ----------------------------------------------------- Print user, course, etc
1078: unless ($reroute) {
1.11 www 1079: $r->print("<b>User '$uname' at domain '$udom' for '".
1080: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
1081: if ($csec) {
1082: $r->print(", group/section '$csec'");
1083: }
1084: $r->print("</b>\n");
1.14 www 1085: }
1086: # -------------------------------------------------------- Import and calculate
1087:
1.11 www 1088: if (&gettype($sheetone) eq 'assesscalc') {
1089: &rowaassess($sheetone,$ENV{'form.usymb'});
1.16 www 1090: } elsif (&gettype($sheetone) eq 'studentcalc') {
1091: &rowazstudent($sheetone);
1.10 www 1092: }
1.18 ! www 1093: my $calcoutput=&calcsheet($sheetone);
! 1094: unless ($reroute) {
! 1095: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
! 1096: }
1.14 www 1097:
1098: # ------------------------------------------------------- Print or export sheet
1099: unless ($reroute) {
1.6 www 1100: $r->print(&outsheet($sheetone));
1.8 www 1101:
1.10 www 1102: $r->print('</form></body></html>');
1.14 www 1103: } else {
1.18 ! www 1104: $r->print(&exportrow($sheetone));
1.14 www 1105: }
1106: # ------------------------------------------------------------------------ Done
1.7 www 1107: } else {
1108: # ----------------------------- Not in a course, or not allowed to modify parms
1109: $ENV{'user.error.msg'}=
1110: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1111: return HTTP_NOT_ACCEPTABLE;
1112: }
1.3 www 1113: return OK;
1.1 www 1114: }
1115:
1116: 1;
1117: __END__
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
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