Annotation of loncom/interface/lonspreadsheet.pm, revision 1.19
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.19 ! www 5: # 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19 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.19 ! www 15: use GDBM_File;
1.3 www 16: use HTML::TokeParser;
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:
1.19 ! www 544: # ------------------------------------- Read spreadsheet formulas from a course
1.3 www 545:
1.5 www 546: sub readsheet {
1.19 ! www 547: my ($safeeval,$fn,$r)=@_;
1.4 www 548: my %f=();
1.19 ! www 549: unless ($fn) {
! 550: my $sheetxml='';
1.10 www 551: {
552: my $fh;
1.19 ! www 553: if ($fh=Apache::File->new($r->dir_config('lonIncludes').
! 554: '/default.'.&gettype($safeeval))) {
! 555: $sheetxml=join('',<$fh>);
! 556: }
! 557: }
! 558: my $parser=HTML::TokeParser->new(\$sheetxml);
! 559: my $token;
! 560: while ($token=$parser->get_token) {
! 561: if ($token->[0] eq 'S') {
! 562: if ($token->[1] eq 'field') {
! 563: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
! 564: $parser->get_text('/field');
! 565: }
! 566: }
! 567: }
! 568: &setfilename($safeeval,'default_'.&gettype($safeeval));
! 569: } else {
! 570: &setfilename($safeeval,$fn);
! 571: unless ($spreadsheets{$fn}) {
! 572: $spreadsheets{$fn}='';
! 573: my $reply=&Apache::lonnet::reply('dump:'.
! 574: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
! 575: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':'.$fn,
! 576: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
! 577: unless ($reply=~/^error\:/) {
! 578: $spreadsheets{$fn}=$reply;
! 579: }
1.10 www 580: }
1.19 ! www 581: map {
! 582: my ($name,$value)=split(/\=/,$_);
! 583: $f{&Apache::lonnet::unescape($name)}=
! 584: &Apache::lonnet::unescape($value);
! 585: } split(/\&/,$spreadsheets{$fn});
1.3 www 586: }
1.5 www 587: &setformulas($safeeval,%f);
1.3 www 588: }
589:
1.19 ! www 590: # ------------------------------------------------------------ Save spreadsheet
! 591:
! 592: sub writesheet {
! 593: my $safeeval=shift;
! 594: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
! 595: my %f=&getformulas($safeeval);
! 596: my $sheetdata='';
! 597: map {
! 598: $sheetdata.=&Apache::lonnet::escape($_).'='.
! 599: &Apache::lonnet::escape($f{$_}).'&';
! 600: } keys %f;
! 601: $sheetdata=~s/\&$//;
! 602: my $reply=&Apache::lonnet::reply('put:'.
! 603: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
! 604: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':'.
! 605: &getfilename($safeeval).':'.
! 606: $sheetdata,
! 607: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
! 608: }
! 609: }
! 610:
1.10 www 611: # ----------------------------------------------- Make a temp copy of the sheet
612:
613: sub tmpwrite {
1.11 www 614: my ($safeeval,$tmpdir,$symb)=@_;
1.10 www 615: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
616: $fn=~s/\W/\_/g;
617: $fn=$tmpdir.$fn.'.tmp';
618: my $fh;
619: if ($fh=Apache::File->new('>'.$fn)) {
620: print $fh join("\n",&getformulas($safeeval));
621: }
622: }
623:
624: # ---------------------------------------------------------- Read the temp copy
625:
626: sub tmpread {
1.11 www 627: my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
1.10 www 628: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
629: $fn=~s/\W/\_/g;
630: $fn=$tmpdir.$fn.'.tmp';
631: my $fh;
632: my %fo=();
633: if ($fh=Apache::File->new($fn)) {
634: my $name;
635: while ($name=<$fh>) {
636: chomp($name);
637: my $value=<$fh>;
638: chomp($value);
639: $fo{$name}=$value;
640: }
641: }
642: $fo{$nfield}=$nform;
643: &setformulas($safeeval,%fo);
644: }
645:
1.3 www 646: # --------------------------------------------------------------- Read metadata
647:
648: sub readmeta {
649: my $fn=shift;
650: unless ($fn=~/\.meta$/) { $fn.='meta'; }
651: my $content;
652: my %returnhash=();
653: {
654: my $fh=Apache::File->new($fn);
655: $content=join('',<$fh>);
656: }
657: my $parser=HTML::TokeParser->new(\$content);
658: my $token;
659: while ($token=$parser->get_token) {
660: if ($token->[0] eq 'S') {
661: my $entry=$token->[1];
662: if (($entry eq 'stores') || ($entry eq 'parameter')) {
663: my $unikey=$entry;
664: $unikey.='_'.$token->[2]->{'part'};
665: $unikey.='_'.$token->[2]->{'name'};
666: $returnhash{$unikey}=$token->[2]->{'display'};
667: }
668: }
669: }
670: return %returnhash;
671: }
672:
1.11 www 673: # ================================================================== Parameters
674: # -------------------------------------------- Figure out a cascading parameter
675:
676: sub parmval {
677: my ($what,$symb)=@_;
678:
679: unless ($symb) { return ''; }
680: my $result='';
681:
682: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
683: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 684: my $rwhat=$what;
685: $what=~s/^parameter\_//;
686: $what=~s/\_/\./;
1.11 www 687:
688: my $symbparm=$symb.'.'.$what;
689: my $mapparm=$mapname.'___(all).'.$what;
690:
691: my $seclevel=
692: $ENV{'request.course.id'}.'.['.
693: $csec.'].'.$what;
694: my $seclevelr=
695: $ENV{'request.course.id'}.'.['.
696: $csec.'].'.$symbparm;
697: my $seclevelm=
698: $ENV{'request.course.id'}.'.['.
699: $csec.'].'.$mapparm;
700:
701: my $courselevel=
702: $ENV{'request.course.id'}.'.'.$what;
703: my $courselevelr=
704: $ENV{'request.course.id'}.'.'.$symbparm;
705: my $courselevelm=
706: $ENV{'request.course.id'}.'.'.$mapparm;
1.12 www 707:
1.11 www 708: # ---------------------------------------------------------- fourth, check user
709:
710: if ($uname) {
711:
712: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
713:
714: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
715:
716: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
717:
718: }
719:
720: # --------------------------------------------------------- third, check course
721:
722: if ($csec) {
723:
724: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
725:
726: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
727:
728: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
729:
730: }
731:
732: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
733:
734: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
735:
736: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
737:
738: # ----------------------------------------------------- second, check map parms
739:
740: my $thisparm=$parmhash{$symbparm};
741: if ($thisparm) { return $thisparm; }
742:
743: # -------------------------------------------------------- first, check default
744:
1.12 www 745: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 746:
747: }
748:
749:
1.5 www 750: # ----------------------------------------------------------------- Update rows
751:
752: sub updaterows {
753: my $safeeval=shift;
754: my %bighash;
755: # -------------------------------------------------------------------- Tie hash
756: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
757: &GDBM_READER,0640)) {
758: # --------------------------------------------------------- Get all assessments
759:
760: my %allkeys=();
761: my %allassess=();
762:
763: my $stype=&gettype($safeeval);
764:
765: map {
766: if ($_=~/^src\_(\d+)\.(\d+)$/) {
767: my $mapid=$1;
768: my $resid=$2;
769: my $id=$mapid.'.'.$resid;
770: my $srcf=$bighash{$_};
771: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
772: my $symb=
773: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
774: '___'.$resid.'___'.
775: &Apache::lonnet::declutter($srcf);
776: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 777:
1.6 www 778: if ($stype eq 'assesscalc') {
1.5 www 779: map {
1.11 www 780: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 781: my $key=$_;
782: my $display=
783: &Apache::lonnet::metadata($srcf,$key.'.display');
784: unless ($display) {
785: $display=
786: &Apache::lonnet::metadata($srcf,$key.'.name');
787: }
788: $allkeys{$key}=$display;
789: }
790: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
791: }
792: }
793: }
794: } keys %bighash;
795: untie(%bighash);
796:
797: #
1.11 www 798: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 799: # %allassess has a list of all resource displays by symb
800: #
801: # -------------------- Find discrepancies between the course row table and this
802: #
803: my %f=&getformulas($safeeval);
1.6 www 804: my $changed=0;
805:
806: my %current=();
807: if ($stype eq 'assesscalc') {
808: %current=%allkeys;
809: } elsif ($stype eq 'studentcalc') {
810: %current=%allassess;
811: }
812:
813: my $maxrow=0;
814: my %existing=();
815:
816: # ----------------------------------------------------------- Now obsolete rows
1.5 www 817: map {
1.6 www 818: if ($_=~/^A(\d+)/) {
819: $maxrow=($1>$maxrow)?$1:$maxrow;
820: $existing{$f{$_}}=1;
1.17 www 821: unless ((defined($current{$f{$_}})) || (!$1)) {
1.6 www 822: $f{$_}='!!! Obsolete';
823: $changed=1;
1.5 www 824: }
825: }
826: } keys %f;
1.6 www 827:
828: # -------------------------------------------------------- New and unknown keys
829:
830: map {
831: unless ($existing{$_}) {
832: $changed=1;
833: $maxrow++;
834: $f{'A'.$maxrow}=$_;
835: }
836: } keys %current;
837:
838: if ($changed) { &setformulas($safeeval,%f); }
839:
840: &setmaxrow($safeeval,$maxrow);
841: &setrowlabels($safeeval,%current);
1.5 www 842:
843: } else {
844: return 'Could not access course data';
845: }
846: }
1.3 www 847:
1.16 www 848: # --------------------------------------------------- Load data for one student
849:
850: sub rowazstudent {
851: my $safeeval=shift;
852: my %c=();
853: my %f=&getformulas($safeeval);
854: map {
1.17 www 855: if ($_=~/^A(\d+)/) {
856: my $row=$1;
1.16 www 857: unless ($f{$_}=~/^\!/) {
1.18 www 858: my @assessdata=split(/\_\_\_\;\_\_\_/,
1.17 www 859: &Apache::lonnet::ssi(
1.16 www 860: '/res/msu/korte/junk.assesscalc',('utarget' => 'export',
861: 'uname' => $uname,
862: 'udom' => $udom,
1.17 www 863: 'usymb' => $f{$_})));
864: my $index=0;
865: map {
1.18 www 866: if ($assessdata[$index]) {
867: $c{$_.$row}=$assessdata[$index];
868: unless ($_ eq 'A') {
869: $f{$_.$row}='import';
870: }
871: }
1.17 www 872: $index++;
873: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
874: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.16 www 875: }
876: }
877: } keys %f;
1.18 www 878: &setformulas($safeeval,%f);
1.16 www 879: &setconstants($safeeval,%c);
880: }
881:
1.6 www 882: # ------------------------------------------------ Load data for one assessment
883:
884: sub rowaassess {
1.11 www 885: my ($safeeval,$symb)=@_;
1.6 www 886: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
887: my $namespace;
888: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
1.11 www 889:
890: # ----------------------------------------------------------- Get stored values
891: my $answer=&Apache::lonnet::reply(
1.15 www 892: "restore:$udom:$uname:".
893: &Apache::lonnet::escape($namespace).":".
894: &Apache::lonnet::escape($symb),$uhome);
1.6 www 895: my %returnhash=();
896: map {
897: my ($name,$value)=split(/\=/,$_);
1.11 www 898: $returnhash{&Apache::lonnet::unescape($name)}=
899: &Apache::lonnet::unescape($value);
1.6 www 900: } split(/\&/,$answer);
901: my $version;
902: for ($version=1;$version<=$returnhash{'version'};$version++) {
903: map {
904: $returnhash{$_}=$returnhash{$version.':'.$_};
905: } split(/\:/,$returnhash{$version.':keys'});
906: }
1.11 www 907: # ----------------------------- returnhash now has all stores for this resource
908:
909: # ---------------------------- initialize coursedata and userdata for this user
910: %courseopt=();
911: %useropt=();
912: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
913: unless ($uhome eq 'no_host') {
914: # -------------------------------------------------------------- Get coursedata
1.13 www 915: unless
916: ((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
1.11 www 917: my $reply=&Apache::lonnet::reply('dump:'.
918: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
919: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
920: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
921: if ($reply!~/^error\:/) {
922: $courserdatas{$ENV{'request.course.id'}}=$reply;
1.13 www 923: $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
1.11 www 924: }
925: }
926: map {
927: my ($name,$value)=split(/\=/,$_);
928: $courseopt{&Apache::lonnet::unescape($name)}=
929: &Apache::lonnet::unescape($value);
930: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
931: # --------------------------------------------------- Get userdata (if present)
1.13 www 932: unless
933: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
1.11 www 934: my $reply=
935: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
936: if ($reply!~/^error\:/) {
937: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 938: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 939: }
940: }
941: map {
942: my ($name,$value)=split(/\=/,$_);
943: $useropt{&Apache::lonnet::unescape($name)}=
1.15 www 944: &Apache::lonnet::unescape($value);
1.11 www 945: } split(/\&/,$userrdatas{$uname.'___'.$udom});
946: }
947: # -- now courseopt, useropt initialized for this user and course (used parmval)
1.6 www 948:
949: my %c=();
950: my %f=&getformulas($safeeval);
951: map {
952: if ($_=~/^A/) {
953: unless ($f{$_}=~/^\!/) {
1.11 www 954: if ($f{$_}=~/^parameter/) {
955: $c{$_}=&parmval($f{$_},$symb);
956: } else {
1.15 www 957: my $key=$f{$_};
958: $key=~s/^stores\_/resource\./;
959: $key=~s/\_/\./;
960: $c{$_}=$returnhash{$key};
1.11 www 961: }
962: }
1.6 www 963: }
964: } keys %f;
1.11 www 965:
1.6 www 966: &setconstants($safeeval,%c);
967: }
968:
1.10 www 969: # --------------------------------------------------------- Various form fields
970:
971: sub textfield {
972: my ($title,$name,$value)=@_;
973: return "\n<p><b>$title:</b><br>".
974: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
975: }
976:
977: sub hiddenfield {
978: my ($name,$value)=@_;
979: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
980: }
981:
982: sub selectbox {
983: my ($title,$name,$value,%options)=@_;
984: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
985: map {
986: $selout.='<option value="'.$_.'"';
987: if ($_ eq $value) { $selout.=' selected'; }
988: $selout.='>'.$options{$_}.'</option>';
989: } sort keys %options;
990: return $selout.'</select>';
991: }
992:
1.12 www 993: # ================================================================ Main handler
1.3 www 994:
995: sub handler {
1.7 www 996: my $r=shift;
997:
1.11 www 998: $uname='';
999: $udom='';
1000: $csec='';
1001:
1.7 www 1002: if ($r->header_only) {
1003: $r->content_type('text/html');
1004: $r->send_http_header;
1005: return OK;
1006: }
1.3 www 1007:
1.7 www 1008: # ----------------------------------------------------- Needs to be in a course
1.3 www 1009:
1.7 www 1010: if (($ENV{'request.course.fn'}) ||
1011: ($ENV{'request.state'} eq 'construct')) {
1.10 www 1012:
1013: # --------------------------- Get query string for limited number of parameters
1.17 www 1014:
1.10 www 1015: map {
1016: my ($name, $value) = split(/=/,$_);
1017: $value =~ tr/+/ /;
1018: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.19 ! www 1019: if (($name eq 'uname') || ($name eq 'udom') ||
! 1020: ($name eq 'usymb') || ($name eq 'ufn')) {
1.10 www 1021: unless ($ENV{'form.'.$name}) {
1022: $ENV{'form.'.$name}=$value;
1023: }
1024: }
1025: } (split(/&/,$ENV{'QUERY_STRING'}));
1026:
1027: # ------------------------------------------- Nothing there? Must be login user
1028: unless ($ENV{'form.uname'}) {
1.11 www 1029: $uname=$ENV{'user.name'};
1030: $udom=$ENV{'user.domain'};
1031: } else {
1032: $uname=$ENV{'form.uname'};
1033: $udom=$ENV{'form.udom'};
1.10 www 1034: }
1.14 www 1035: # ----------------------------------------------------------- Change of target?
1036:
1.16 www 1037: my $reroute=($ENV{'form.utarget'} eq 'export');
1.14 www 1038:
1.10 www 1039: # ------------------------------------------------------------------- Open page
1040:
1.7 www 1041: $r->content_type('text/html');
1.11 www 1042: $r->header_out('Cache-control','no-cache');
1043: $r->header_out('Pragma','no-cache');
1.7 www 1044: $r->send_http_header;
1.3 www 1045:
1.14 www 1046: # --------------------------------------------------------------- Screen output
1047:
1048: unless ($reroute) {
1.10 www 1049: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
1050: $r->print(<<ENDSCRIPT);
1051: <script language="JavaScript">
1052:
1053: function celledit(cn,cf) {
1054: var cnf=prompt(cn,cf);
1055: if (cnf!=null) {
1056: document.sheet.unewfield.value=cn;
1057: document.sheet.unewformula.value=cnf;
1058: document.sheet.submit();
1059: }
1060: }
1061:
1062: </script>
1063: ENDSCRIPT
1064: $r->print('</head><body bgcolor="#FFFFFF">'.
1065: '<form action="'.$r->uri.'" name=sheet method=post>'.
1066: &hiddenfield('uname',$ENV{'form.uname'}).
1067: &hiddenfield('udom',$ENV{'form.udom'}).
1068: &hiddenfield('usymb',$ENV{'form.usymb'}).
1.19 ! www 1069: &hiddenfield('ufn',$ENV{'form.ufn'}).
1.10 www 1070: &hiddenfield('unewfield','').
1071: &hiddenfield('unewformula',''));
1.14 www 1072: }
1073:
1074: # ---------------------------------------- Read new sheet or modified worksheet
1075:
1.4 www 1076: my $sheetone=initsheet();
1.19 ! www 1077: $r->uri=~/\/(\w+)$/;
! 1078: &settype($sheetone,$1);
1.10 www 1079: if ($ENV{'form.unewfield'}) {
1080: $r->print('<h2>Modified Workcopy</h2>');
1081: $ENV{'form.unewformula'}=~s/\'/\"/g;
1082: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
1083: $ENV{'form.unewformula'}.'<br>');
1.19 ! www 1084: &setfilename($sheetone,$ENV{'form.ufn'});
1.10 www 1085: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1.11 www 1086: $ENV{'form.usymb'},
1.10 www 1087: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
1.11 www 1088: } else {
1.19 ! www 1089: &readsheet($sheetone,$ENV{'form.ufn'},$r);
1.11 www 1090: }
1.14 www 1091:
1092: # --------------------------------------------- See if all import rows uptodate
1093:
1.11 www 1094: if (tie(%parmhash,'GDBM_File',
1095: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
1096: $csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
1097: if ($csec eq '-1') {
1098: $r->print('<h3><font color=red>'.
1099: "User '$uname' at domain '$udom' not a student in this course</font></h3>");
1100: }
1101: &updaterows($sheetone);
1102: untie(%parmhash);
1.10 www 1103: } else {
1.11 www 1104: $r->print('<h3><font color=red>'.
1105: 'Could not initialize import fields (not in a course)</font></h3>');
1106: }
1.14 www 1107:
1108: # ------------------------------------------------ Write the modified worksheet
1109:
1.11 www 1110: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1111: $ENV{'form.usymb'});
1.14 www 1112:
1113: # ----------------------------------------------------- Print user, course, etc
1114: unless ($reroute) {
1.11 www 1115: $r->print("<b>User '$uname' at domain '$udom' for '".
1116: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
1117: if ($csec) {
1118: $r->print(", group/section '$csec'");
1119: }
1120: $r->print("</b>\n");
1.14 www 1121: }
1122: # -------------------------------------------------------- Import and calculate
1123:
1.11 www 1124: if (&gettype($sheetone) eq 'assesscalc') {
1125: &rowaassess($sheetone,$ENV{'form.usymb'});
1.16 www 1126: } elsif (&gettype($sheetone) eq 'studentcalc') {
1127: &rowazstudent($sheetone);
1.10 www 1128: }
1.18 www 1129: my $calcoutput=&calcsheet($sheetone);
1130: unless ($reroute) {
1131: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
1132: }
1.14 www 1133:
1134: # ------------------------------------------------------- Print or export sheet
1135: unless ($reroute) {
1.6 www 1136: $r->print(&outsheet($sheetone));
1.8 www 1137:
1.10 www 1138: $r->print('</form></body></html>');
1.14 www 1139: } else {
1.18 www 1140: $r->print(&exportrow($sheetone));
1.14 www 1141: }
1142: # ------------------------------------------------------------------------ Done
1.7 www 1143: } else {
1144: # ----------------------------- Not in a course, or not allowed to modify parms
1145: $ENV{'user.error.msg'}=
1146: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1147: return HTTP_NOT_ACCEPTABLE;
1148: }
1.3 www 1149: return OK;
1.1 www 1150: }
1151:
1152: 1;
1153: __END__
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
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