Annotation of loncom/interface/lonspreadsheet.pm, revision 1.35
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.23 www 5: # 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,
1.35 ! www 6: # 01/01/01,02/01,03/01,19/01,20/01 Gerd Kortemeyer
1.1 www 7:
8: package Apache::lonspreadsheet;
9:
10: use strict;
11: use Safe;
1.3 www 12: use Safe::Hole;
1.1 www 13: use Opcode;
14: use Apache::lonnet;
1.7 www 15: use Apache::Constants qw(:common :http);
1.19 www 16: use GDBM_File;
1.3 www 17: use HTML::TokeParser;
18:
1.11 www 19: #
20: # These cache hashes need to be independent of user, resource and course
1.27 www 21: # (user and course can/should be in the keys)
1.11 www 22: #
1.33 www 23:
24: my %spreadsheets;
25: my %courserdatas;
26: my %userrdatas;
27: my %defaultsheets;
1.35 ! www 28: my %updatedata;
1.27 www 29:
1.11 www 30: #
31: # These global hashes are dependent on user, course and resource,
32: # and need to be initialized every time when a sheet is calculated
33: #
34: my %courseopt;
35: my %useropt;
36: my %parmhash;
37:
1.28 www 38: # Stuff that only the screen handler can know
39:
40: my $includedir;
41: my $tmpdir;
42:
1.5 www 43: # =============================================================================
44: # ===================================== Implements an instance of a spreadsheet
1.4 www 45:
46: sub initsheet {
47: my $safeeval = new Safe;
48: my $safehole = new Safe::Hole;
49: $safeeval->permit("entereval");
50: $safeeval->permit(":base_math");
51: $safeeval->permit("sort");
52: $safeeval->deny(":base_io");
53: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
54: my $code=<<'ENDDEFS';
55: # ---------------------------------------------------- Inside of the safe space
56:
1.3 www 57: #
58: # f: formulas
1.4 www 59: # t: intermediate format (variable references expanded)
60: # v: output values
1.6 www 61: # c: preloaded constants (A-column)
62: # rl: row label
1.3 www 63:
1.4 www 64: %v=();
65: %t=();
66: %f=();
1.6 www 67: %c=();
68: %rl=();
69:
70: $maxrow=0;
1.5 www 71: $sheettype='';
1.27 www 72:
73: # filename/reference of the sheet
74:
1.5 www 75: $filename='';
1.1 www 76:
1.27 www 77: # user data
78: $uname='';
79: $uhome='';
80: $udom='';
81:
82: # course data
83:
84: $csec='';
85: $chome='';
86: $cnum='';
87: $cdom='';
1.28 www 88: $cid='';
1.29 www 89: $cfn='';
1.27 www 90:
91: # symb
92:
93: $usymb='';
94:
1.1 www 95: sub mask {
96: my ($lower,$upper)=@_;
97:
1.7 www 98: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 99: my $la=$1;
100: my $ld=$2;
101:
1.7 www 102: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 103: my $ua=$1;
104: my $ud=$2;
105: my $alpha='';
106: my $num='';
107:
108: if (($la eq '*') || ($ua eq '*')) {
1.7 www 109: $alpha='[A-Za-z]';
1.1 www 110: } else {
1.7 www 111: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
112: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
113: $alpha='['.$la.'-'.$ua.']';
114: } else {
115: $alpha='['.$la.'-Za-'.$ua.']';
116: }
1.1 www 117: }
118:
119: if (($ld eq '*') || ($ud eq '*')) {
120: $num='\d+';
121: } else {
122: if (length($ld)!=length($ud)) {
123: $num.='(';
124: map {
125: $num.='['.$_.'-9]';
126: } ($ld=~m/\d/g);
127: if (length($ud)-length($ld)>1) {
128: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
129: }
130: $num.='|';
131: map {
132: $num.='[0-'.$_.']';
133: } ($ud=~m/\d/g);
134: $num.=')';
135: } else {
136: my @lda=($ld=~m/\d/g);
137: my @uda=($ud=~m/\d/g);
1.7 www 138: my $i; $j=0; $notdone=1;
139: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
1.1 www 140: if ($lda[$i]==$uda[$i]) {
141: $num.=$lda[$i];
142: $j=$i;
1.7 www 143: } else {
144: $notdone=0;
1.1 www 145: }
146: }
147: if ($j<$#lda-1) {
148: $num.='('.$lda[$j+1];
149: for ($i=$j+2;$i<=$#lda;$i++) {
150: $num.='['.$lda[$i].'-9]';
151: }
152: if ($uda[$j+1]-$lda[$j+1]>1) {
153: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
154: ($#lda-$j-1).'}';
155: }
156: $num.='|'.$uda[$j+1];
157: for ($i=$j+2;$i<=$#uda;$i++) {
158: $num.='[0-'.$uda[$i].']';
159: }
160: $num.=')';
161: } else {
1.7 www 162: if ($lda[$#lda]!=$uda[$#uda]) {
163: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
164: }
1.1 www 165: }
166: }
167: }
1.4 www 168: return '^'.$alpha.$num."\$";
1.1 www 169: }
170:
171: sub NUM {
172: my $mask=mask(@_);
173: my $num=0;
174: map {
175: $num++;
176: } grep /$mask/,keys %v;
177: return $num;
178: }
179:
180: sub BIN {
181: my ($low,$high,$lower,$upper)=@_;
182: my $mask=mask($lower,$upper);
183: my $num=0;
184: map {
185: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
186: $num++;
187: }
188: } grep /$mask/,keys %v;
189: return $num;
190: }
191:
192:
193: sub SUM {
194: my $mask=mask(@_);
195: my $sum=0;
196: map {
197: $sum+=$v{$_};
198: } grep /$mask/,keys %v;
199: return $sum;
200: }
201:
202: sub MEAN {
203: my $mask=mask(@_);
204: my $sum=0; my $num=0;
205: map {
206: $sum+=$v{$_};
207: $num++;
208: } grep /$mask/,keys %v;
209: if ($num) {
210: return $sum/$num;
211: } else {
212: return undef;
213: }
214: }
215:
216: sub STDDEV {
217: my $mask=mask(@_);
218: my $sum=0; my $num=0;
219: map {
220: $sum+=$v{$_};
221: $num++;
222: } grep /$mask/,keys %v;
223: unless ($num>1) { return undef; }
224: my $mean=$sum/$num;
225: $sum=0;
226: map {
227: $sum+=($v{$_}-$mean)**2;
228: } grep /$mask/,keys %v;
229: return sqrt($sum/($num-1));
230: }
231:
232: sub PROD {
233: my $mask=mask(@_);
234: my $prod=1;
235: map {
236: $prod*=$v{$_};
237: } grep /$mask/,keys %v;
238: return $prod;
239: }
240:
241: sub MAX {
242: my $mask=mask(@_);
243: my $max='-';
244: map {
245: unless ($max) { $max=$v{$_}; }
246: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
247: } grep /$mask/,keys %v;
248: return $max;
249: }
250:
251: sub MIN {
252: my $mask=mask(@_);
253: my $min='-';
254: map {
255: unless ($max) { $max=$v{$_}; }
256: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
257: } grep /$mask/,keys %v;
258: return $min;
259: }
260:
261: sub SUMMAX {
262: my ($num,$lower,$upper)=@_;
263: my $mask=mask($lower,$upper);
264: my @inside=();
265: map {
266: $inside[$#inside+1]=$v{$_};
267: } grep /$mask/,keys %v;
268: @inside=sort(@inside);
269: my $sum=0; my $i;
270: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
271: $sum+=$inside[$i];
272: }
273: return $sum;
274: }
275:
276: sub SUMMIN {
277: my ($num,$lower,$upper)=@_;
278: my $mask=mask($lower,$upper);
279: my @inside=();
280: map {
281: $inside[$#inside+1]=$v{$_};
282: } grep /$mask/,keys %v;
283: @inside=sort(@inside);
284: my $sum=0; my $i;
285: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
286: $sum+=$inside[$i];
287: }
288: return $sum;
289: }
290:
291: sub sett {
292: %t=();
1.16 www 293: my $pattern='';
294: if ($sheettype eq 'assesscalc') {
295: $pattern='A';
296: } else {
297: $pattern='[A-Z]';
298: }
1.1 www 299: map {
1.20 www 300: if ($_=~/template\_(\w)/) {
301: my $col=$1;
302: unless ($col=~/^$pattern/) {
303: map {
304: if ($_=~/A(\d+)/) {
305: my $trow=$1;
306: if ($trow) {
307: my $lb=$col.$trow;
308: $t{$lb}=$f{'template_'.$col};
309: $t{$lb}=~s/\#/$trow/g;
310: $t{$lb}=~s/\.\.+/\,/g;
311: $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
312: }
313: }
314: } keys %f;
315: }
316: }
317: } keys %f;
318: map {
319: if (($f{$_}) && ($_!~/template\_/)) {
1.16 www 320: if ($_=~/^$pattern/) {
1.6 www 321: unless ($f{$_}=~/^\!/) {
322: $t{$_}=$c{$_};
323: }
324: } else {
325: $t{$_}=$f{$_};
1.7 www 326: $t{$_}=~s/\.\.+/\,/g;
327: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 328: }
1.1 www 329: }
330: } keys %f;
1.17 www 331: $t{'A0'}=$f{'A0'};
332: $t{'A0'}=~s/\.\.+/\,/g;
333: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.1 www 334: }
335:
1.4 www 336: sub calc {
1.1 www 337: %v=();
1.4 www 338: &sett();
1.1 www 339: my $notfinished=1;
340: my $depth=0;
341: while ($notfinished) {
342: $notfinished=0;
343: map {
344: my $old=$v{$_};
1.4 www 345: $v{$_}=eval($t{$_});
1.1 www 346: if ($@) {
347: %v=();
348: return $@;
349: }
350: if ($v{$_} ne $old) { $notfinished=1; }
351: } keys %t;
352: $depth++;
353: if ($depth>100) {
354: %v=();
355: return 'Maximum calculation depth exceeded';
356: }
357: }
358: return '';
359: }
360:
1.21 www 361: sub templaterow {
362: my @cols=();
363: $cols[0]='<b><font size=+1>Template</font></b>';
364: map {
365: my $fm=$f{'template_'.$_};
366: $fm=~s/[\'\"]/\&\#34;/g;
367: $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;
368: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
369: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
370: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
371: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
372: return @cols;
373: }
374:
1.16 www 375: sub outrowassess {
1.6 www 376: my $n=shift;
377: my @cols=();
378: if ($n) {
379: $cols[0]=$rl{$f{'A'.$n}};
380: } else {
381: $cols[0]='<b><font size=+1>Export</font></b>';
382: }
383: map {
384: my $fm=$f{$_.$n};
385: $fm=~s/[\'\"]/\&\#34;/g;
386: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
387: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 388: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
389: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
390: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 391: return @cols;
392: }
393:
1.18 www 394: sub outrow {
395: my $n=shift;
396: my @cols=();
397: if ($n) {
1.21 www 398: $cols[0]=$rl{$f{'A'.$n}};
1.18 www 399: } else {
400: $cols[0]='<b><font size=+1>Export</font></b>';
401: }
402: map {
403: my $fm=$f{$_.$n};
404: $fm=~s/[\'\"]/\&\#34;/g;
405: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
406: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
407: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
408: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
409: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
410: return @cols;
411: }
412:
1.14 www 413: sub exportrowa {
1.28 www 414: my @exportarray=();
1.14 www 415: map {
1.28 www 416: $exportarray[$#exportarray+1]=$v{$_.'0'};
1.14 www 417: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
418: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.28 www 419: return @exportarray;
1.14 www 420: }
421:
1.4 www 422: # ------------------------------------------- End of "Inside of the safe space"
423: ENDDEFS
424: $safeeval->reval($code);
425: return $safeeval;
426: }
427:
428: # ------------------------------------------------ Add or change formula values
429:
430: sub setformulas {
1.34 www 431: my ($safeeval,%f)=@_;
432: %{$safeeval->varglob('f')}=%f;
1.6 www 433: }
434:
435: # ------------------------------------------------ Add or change formula values
436:
437: sub setconstants {
1.34 www 438: my ($safeeval,%c)=@_;
439: %{$safeeval->varglob('c')}=%c;
1.6 www 440: }
441:
442: # ------------------------------------------------ Add or change formula values
443:
444: sub setrowlabels {
1.34 www 445: my ($safeeval,%rl)=@_;
446: %{$safeeval->varglob('rl')}=%rl;
1.4 www 447: }
448:
449: # ------------------------------------------------------- Calculate spreadsheet
450:
451: sub calcsheet {
452: my $safeeval=shift;
453: $safeeval->reval('&calc();');
454: }
455:
456: # ------------------------------------------------------------------ Get values
457:
458: sub getvalues {
459: my $safeeval=shift;
460: return $safeeval->reval('%v');
461: }
462:
463: # ---------------------------------------------------------------- Get formulas
464:
465: sub getformulas {
466: my $safeeval=shift;
1.34 www 467: return %{$safeeval->varglob('f')};
1.4 www 468: }
469:
1.5 www 470: # -------------------------------------------------------------------- Get type
471:
472: sub gettype {
473: my $safeeval=shift;
474: return $safeeval->reval('$sheettype');
475: }
1.27 www 476:
1.6 www 477: # ------------------------------------------------------------------ Set maxrow
478:
479: sub setmaxrow {
480: my ($safeeval,$row)=@_;
481: $safeeval->reval('$maxrow='.$row.';');
482: }
483:
484: # ------------------------------------------------------------------ Get maxrow
485:
486: sub getmaxrow {
487: my $safeeval=shift;
488: return $safeeval->reval('$maxrow');
489: }
1.5 www 490:
1.6 www 491: # ---------------------------------------------------------------- Set filename
1.5 www 492:
493: sub setfilename {
494: my ($safeeval,$fn)=@_;
1.11 www 495: $safeeval->reval('$filename="'.$fn.'";');
1.5 www 496: }
497:
1.6 www 498: # ---------------------------------------------------------------- Get filename
1.5 www 499:
500: sub getfilename {
501: my $safeeval=shift;
502: return $safeeval->reval('$filename');
503: }
1.29 www 504:
1.28 www 505: # --------------------------------------------------------------- Get course ID
506:
507: sub getcid {
508: my $safeeval=shift;
509: return $safeeval->reval('$cid');
510: }
1.14 www 511:
1.29 www 512: # --------------------------------------------------------- Get course filename
513:
514: sub getcfn {
515: my $safeeval=shift;
516: return $safeeval->reval('$cfn');
517: }
518:
1.27 www 519: # ----------------------------------------------------------- Get course number
520:
521: sub getcnum {
522: my $safeeval=shift;
523: return $safeeval->reval('$cnum');
524: }
525:
526: # ------------------------------------------------------------- Get course home
527:
528: sub getchome {
529: my $safeeval=shift;
530: return $safeeval->reval('$chome');
531: }
532:
533: # ----------------------------------------------------------- Get course domain
534:
535: sub getcdom {
536: my $safeeval=shift;
537: return $safeeval->reval('$cdom');
538: }
539:
540: # ---------------------------------------------------------- Get course section
541:
542: sub getcsec {
543: my $safeeval=shift;
544: return $safeeval->reval('$csec');
545: }
546:
547: # --------------------------------------------------------------- Get user name
548:
549: sub getuname {
550: my $safeeval=shift;
551: return $safeeval->reval('$uname');
552: }
553:
554: # ------------------------------------------------------------- Get user domain
555:
556: sub getudom {
557: my $safeeval=shift;
558: return $safeeval->reval('$udom');
559: }
560:
561: # --------------------------------------------------------------- Get user home
562:
563: sub getuhome {
564: my $safeeval=shift;
565: return $safeeval->reval('$uhome');
566: }
567:
568: # -------------------------------------------------------------------- Get symb
569:
570: sub getusymb {
571: my $safeeval=shift;
572: return $safeeval->reval('$usymb');
573: }
574:
1.14 www 575: # ------------------------------------------------------------- Export of A-row
576:
1.28 www 577: sub exportdata {
1.14 www 578: my $safeeval=shift;
579: return $safeeval->reval('&exportrowa()');
580: }
581:
1.5 www 582: # ========================================================== End of Spreadsheet
583: # =============================================================================
584:
1.27 www 585: #
586: # Procedures for screen output
587: #
1.6 www 588: # --------------------------------------------- Produce output row n from sheet
589:
590: sub rown {
591: my ($safeeval,$n)=@_;
1.21 www 592: my $defaultbg;
1.24 www 593: my $rowdata='';
1.21 www 594: unless ($n eq '-') {
595: $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
596: } else {
597: $defaultbg='#E0FF';
598: }
1.24 www 599: if ((($n-1)/25)==int(($n-1)/25)) {
600: my $what='Student';
601: if (&gettype($safeeval) eq 'assesscalc') {
602: $what='Item';
603: } elsif (&gettype($safeeval) eq 'studentcalc') {
604: $what='Assessment';
605: }
606: $rowdata.="</table>\n<br><table border=2>".
607: '<tr><td> <td>'.$what.'</td>';
608: map {
609: $rowdata.='<td>'.$_.'</td>';
610: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
611: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
612: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
613: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
614: $rowdata.='</tr>';
615: }
616: $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
1.6 www 617: my $showf=0;
1.16 www 618: my $proc;
1.18 www 619: my $maxred;
1.16 www 620: if (&gettype($safeeval) eq 'assesscalc') {
621: $proc='&outrowassess';
1.18 www 622: $maxred=1;
1.16 www 623: } else {
624: $proc='&outrow';
1.18 www 625: $maxred=26;
1.16 www 626: }
1.21 www 627: if ($n eq '-') { $proc='&templaterow'; $n=-1; }
1.6 www 628: map {
1.9 www 629: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 630: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
631: if ($showf==0) { $vl=$_; }
1.18 www 632: if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
1.9 www 633: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.18 www 634: if (($showf>$maxred) || ((!$n) && ($showf>0))) {
1.6 www 635: if ($vl eq '') {
1.9 www 636: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 637: }
638: $rowdata.=
1.10 www 639: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 640: '</a></td>';
641: } else {
1.9 www 642: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 643: }
644: $showf++;
1.16 www 645: } $safeeval->reval($proc.'('.$n.')');
1.6 www 646: return $rowdata.'</tr>';
647: }
648:
649: # ------------------------------------------------------------- Print out sheet
650:
651: sub outsheet {
1.24 www 652: my ($r,$safeeval)=@_;
1.18 www 653: my $maxred;
654: my $realm;
655: if (&gettype($safeeval) eq 'assesscalc') {
656: $maxred=1;
657: $realm='Assessment';
658: } elsif (&gettype($safeeval) eq 'studentcalc') {
659: $maxred=26;
660: $realm='User';
661: } else {
662: $maxred=26;
663: $realm='Course';
664: }
665: my $maxyellow=52-$maxred;
1.24 www 666: my $tabledata=
667: '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
1.18 www 668: $realm.'</font></th>'.
669: '<td bgcolor=#FFDDDD colspan='.$maxred.
670: '><b><font size=+1>Import</font></b></td>'.
671: '<td colspan='.$maxyellow.
672: '><b><font size=+1>Calculations</font></b></td></tr><tr>';
673: my $showf=0;
1.6 www 674: map {
1.18 www 675: $showf++;
676: if ($showf<=$maxred) {
677: $tabledata.='<td bgcolor="#FFDDDD">';
678: } else {
679: $tabledata.='<td>';
680: }
681: $tabledata.="<b><font size=+1>$_</font></b></td>";
682: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 683: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
684: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
685: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 686: $tabledata.='</tr>';
687: my $row;
688: my $maxrow=&getmaxrow($safeeval);
1.21 www 689: $tabledata.=&rown($safeeval,'-');
1.24 www 690: $r->print($tabledata);
1.6 www 691: for ($row=0;$row<=$maxrow;$row++) {
1.24 www 692: $r->print(&rown($safeeval,$row));
1.6 www 693: }
1.24 www 694: $r->print('</table>');
1.6 www 695: }
696:
1.27 www 697: #
698: # -------------------------------------- Read spreadsheet formulas for a course
699: #
700:
701: sub readsheet {
702: my ($safeeval,$fn)=@_;
703: my $stype=&gettype($safeeval);
704: my $cnum=&getcnum($safeeval);
1.28 www 705: my $cdom=&getcdom($safeeval);
706: my $chome=&getchome($safeeval);
1.27 www 707:
708: # --------- There is no filename. Look for defaults in course and global, cache
709:
710: unless($fn) {
1.28 www 711: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
712: $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.
713: ':environment:spreadsheet_default_'.$stype,
714: $chome);
1.27 www 715: unless (($fn) && ($fn!~/^error\:/)) {
716: $fn='default_'.$stype;
717: }
1.28 www 718: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
1.27 www 719: }
720: }
721:
722: # ---------------------------------------------------------- fn now has a value
723:
724: &setfilename($safeeval,$fn);
725:
726: # ------------------------------------------------------ see if sheet is cached
727: my $fstring='';
1.28 www 728: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
729: &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));
1.27 www 730: } else {
1.6 www 731:
1.27 www 732: # ---------------------------------------------------- Not cached, need to read
1.5 www 733:
1.27 www 734: my %f=();
1.3 www 735:
1.27 www 736: if ($fn=~/^default\_/) {
1.19 www 737: my $sheetxml='';
1.10 www 738: {
739: my $fh;
1.28 www 740: if ($fh=Apache::File->new($includedir.
1.19 www 741: '/default.'.&gettype($safeeval))) {
742: $sheetxml=join('',<$fh>);
743: }
744: }
1.27 www 745: my $parser=HTML::TokeParser->new(\$sheetxml);
746: my $token;
747: while ($token=$parser->get_token) {
1.19 www 748: if ($token->[0] eq 'S') {
749: if ($token->[1] eq 'field') {
750: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
751: $parser->get_text('/field');
752: }
1.20 www 753: if ($token->[1] eq 'template') {
754: $f{'template_'.$token->[2]->{'col'}}=
755: $parser->get_text('/template');
756: }
1.19 www 757: }
1.27 www 758: }
759: } else {
1.28 www 760: my $sheet='';
761: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,
762: $chome);
1.19 www 763: unless ($reply=~/^error\:/) {
1.27 www 764: $sheet=$reply;
765: }
766: map {
767: my ($name,$value)=split(/\=/,$_);
768: $f{&Apache::lonnet::unescape($name)}=
769: &Apache::lonnet::unescape($value);
770: } split(/\&/,$sheet);
1.10 www 771: }
1.27 www 772: # --------------------------------------------------------------- Cache and set
1.28 www 773: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
1.27 www 774: &setformulas($safeeval,%f);
1.3 www 775: }
776: }
777:
1.28 www 778: # -------------------------------------------------------- Make new spreadsheet
779:
780: sub makenewsheet {
781: my ($uname,$udom,$stype,$usymb)=@_;
782: my $safeeval=initsheet();
783: $safeeval->reval(
1.29 www 784: '$uname="'.$uname.
785: '";$udom="'.$udom.
786: '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).
787: '";$sheettype="'.$stype.
788: '";$usymb="'.$usymb.
1.30 www 789: '";$csec="'.&Apache::lonnet::usection($udom,$uname,
790: $ENV{'request.course.id'}).
1.29 www 791: '";$cid="'.$ENV{'request.course.id'}.
792: '";$cfn="'.$ENV{'request.course.fn'}.
793: '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
794: '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
795: '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');
1.28 www 796: return $safeeval;
797: }
798:
1.19 www 799: # ------------------------------------------------------------ Save spreadsheet
800:
801: sub writesheet {
1.28 www 802: my ($safeeval,$makedef)=@_;
803: my $cid=&getcid($safeeval);
804: if (&Apache::lonnet::allowed('opa',$cid)) {
1.19 www 805: my %f=&getformulas($safeeval);
1.28 www 806: my $stype=&gettype($safeeval);
807: my $cnum=&getcnum($safeeval);
808: my $cdom=&getcdom($safeeval);
809: my $chome=&getchome($safeeval);
810: my $fn=&getfilename($safeeval);
811:
812: # ------------------------------------------------------------- Cache new sheet
813: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
814: # ----------------------------------------------------------------- Write sheet
1.19 www 815: my $sheetdata='';
816: map {
817: $sheetdata.=&Apache::lonnet::escape($_).'='.
818: &Apache::lonnet::escape($f{$_}).'&';
819: } keys %f;
820: $sheetdata=~s/\&$//;
1.28 www 821: my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
822: $sheetdata,$chome);
1.22 www 823: if ($reply eq 'ok') {
1.28 www 824: $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
1.30 www 825: $stype.'_spreadsheets:'.
1.28 www 826: &Apache::lonnet::escape($fn).'='.$ENV{'user.name'},
827: $chome);
828: if ($reply eq 'ok') {
829: if ($makedef) {
830: return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
831: ':environment:spreadsheet_default_'.$stype.'='.
832: &Apache::lonnet::escape($fn),
833: $chome);
834: } else {
835: return $reply;
836: }
837: } else {
838: return $reply;
839: }
1.22 www 840: } else {
841: return $reply;
842: }
843: }
844: return 'unauthorized';
1.19 www 845: }
846:
1.10 www 847: # ----------------------------------------------- Make a temp copy of the sheet
1.28 www 848: # "Modified workcopy" - interactive only
849: #
1.10 www 850:
851: sub tmpwrite {
1.28 www 852: my $safeeval=shift;
853: my $fn=$ENV{'user.name'}.'_'.
854: $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
855: &getfilename($safeeval);
1.10 www 856: $fn=~s/\W/\_/g;
857: $fn=$tmpdir.$fn.'.tmp';
858: my $fh;
859: if ($fh=Apache::File->new('>'.$fn)) {
860: print $fh join("\n",&getformulas($safeeval));
861: }
862: }
863:
864: # ---------------------------------------------------------- Read the temp copy
865:
866: sub tmpread {
1.28 www 867: my ($safeeval,$nfield,$nform)=@_;
868: my $fn=$ENV{'user.name'}.'_'.
869: $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
870: &getfilename($safeeval);
1.10 www 871: $fn=~s/\W/\_/g;
872: $fn=$tmpdir.$fn.'.tmp';
873: my $fh;
874: my %fo=();
875: if ($fh=Apache::File->new($fn)) {
876: my $name;
877: while ($name=<$fh>) {
878: chomp($name);
879: my $value=<$fh>;
880: chomp($value);
881: $fo{$name}=$value;
882: }
883: }
1.22 www 884: if ($nfield) { $fo{$nfield}=$nform; }
1.10 www 885: &setformulas($safeeval,%fo);
886: }
887:
1.11 www 888: # ================================================================== Parameters
889: # -------------------------------------------- Figure out a cascading parameter
1.28 www 890: #
1.29 www 891: # For this function to work
892: #
893: # * parmhash needs to be tied
894: # * courseopt and useropt need to be initialized for this user and course
895: #
1.11 www 896:
897: sub parmval {
1.28 www 898: my ($what,$safeeval)=@_;
899: my $cid=&getcid($safeeval);
900: my $csec=&getcsec($safeeval);
901: my $uname=&getuname($safeeval);
902: my $udom=&getudom($safeeval);
903: my $symb=&getusymb($safeeval);
1.11 www 904:
905: unless ($symb) { return ''; }
906: my $result='';
907:
908: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
909: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 910: my $rwhat=$what;
911: $what=~s/^parameter\_//;
912: $what=~s/\_/\./;
1.11 www 913:
914: my $symbparm=$symb.'.'.$what;
915: my $mapparm=$mapname.'___(all).'.$what;
1.29 www 916: my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
1.11 www 917:
918: my $seclevel=
1.28 www 919: $usercourseprefix.'.['.
1.11 www 920: $csec.'].'.$what;
921: my $seclevelr=
1.28 www 922: $usercourseprefix.'.['.
1.11 www 923: $csec.'].'.$symbparm;
924: my $seclevelm=
1.28 www 925: $usercourseprefix.'.['.
1.11 www 926: $csec.'].'.$mapparm;
927:
928: my $courselevel=
1.28 www 929: $usercourseprefix.'.'.$what;
1.11 www 930: my $courselevelr=
1.28 www 931: $usercourseprefix.'.'.$symbparm;
1.11 www 932: my $courselevelm=
1.28 www 933: $usercourseprefix.'.'.$mapparm;
1.12 www 934:
1.11 www 935: # ---------------------------------------------------------- fourth, check user
936:
937: if ($uname) {
938:
939: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
940:
941: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
942:
943: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
944:
945: }
946:
947: # --------------------------------------------------------- third, check course
948:
949: if ($csec) {
950:
951: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
952:
953: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
954:
955: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
956:
957: }
958:
959: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
960:
961: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
962:
963: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
964:
965: # ----------------------------------------------------- second, check map parms
966:
967: my $thisparm=$parmhash{$symbparm};
968: if ($thisparm) { return $thisparm; }
969:
970: # -------------------------------------------------------- first, check default
971:
1.12 www 972: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 973:
974: }
975:
1.23 www 976: # ---------------------------------------------- Update rows for course listing
1.11 www 977:
1.28 www 978: sub updateclasssheet {
1.23 www 979: my $safeeval=shift;
1.28 www 980: my $cnum=&getcnum($safeeval);
981: my $cdom=&getcdom($safeeval);
982: my $cid=&getcid($safeeval);
983: my $chome=&getchome($safeeval);
984:
985: # ---------------------------------------------- Read class list and row labels
986:
1.23 www 987: my $classlst=&Apache::lonnet::reply
1.28 www 988: ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
1.23 www 989: my %currentlist=();
990: my $now=time;
991: unless ($classlst=~/^error\:/) {
992: map {
993: my ($name,$value)=split(/\=/,$_);
1.24 www 994: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
1.23 www 995: my $active=1;
996: if (($end) && ($now>$end)) { $active=0; }
997: if ($active) {
1.24 www 998: my $rowlabel='';
999: $name=&Apache::lonnet::unescape($name);
1.28 www 1000: my ($sname,$sdom)=split(/\:/,$name);
1001: my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
1002: if ($ssec==-1) {
1.24 www 1003: $rowlabel='<font color=red>Data not available: '.$name.
1004: '</font>';
1005: } else {
1.28 www 1006: my %reply=&Apache::lonnet::idrget($sdom,$sname);
1007: my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
1.24 www 1008: ':environment:firstname&middlename&lastname&generation',
1.28 www 1009: &Apache::lonnet::homeserver($sname,$sdom));
1010: $rowlabel=$ssec.' '.$reply{$sname}.'<br>';
1.24 www 1011: map {
1012: $rowlabel.=&Apache::lonnet::unescape($_).' ';
1013: } split(/\&/,$reply);
1014: }
1015: $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
1.23 www 1016: }
1017: } split(/\&/,$classlst);
1018: #
1019: # -------------------- Find discrepancies between the course row table and this
1020: #
1021: my %f=&getformulas($safeeval);
1022: my $changed=0;
1023:
1024: my $maxrow=0;
1025: my %existing=();
1026:
1027: # ----------------------------------------------------------- Now obsolete rows
1028: map {
1029: if ($_=~/^A(\d+)/) {
1030: $maxrow=($1>$maxrow)?$1:$maxrow;
1031: $existing{$f{$_}}=1;
1032: unless ((defined($currentlist{$f{$_}})) || (!$1)) {
1033: $f{$_}='!!! Obsolete';
1034: $changed=1;
1035: }
1036: }
1037: } keys %f;
1038:
1039: # -------------------------------------------------------- New and unknown keys
1040:
1041: map {
1042: unless ($existing{$_}) {
1043: $changed=1;
1044: $maxrow++;
1045: $f{'A'.$maxrow}=$_;
1046: }
1.24 www 1047: } sort keys %currentlist;
1.23 www 1048:
1049: if ($changed) { &setformulas($safeeval,%f); }
1050:
1051: &setmaxrow($safeeval,$maxrow);
1052: &setrowlabels($safeeval,%currentlist);
1053:
1054: } else {
1055: return 'Could not access course data';
1056: }
1057: }
1.5 www 1058:
1.28 www 1059: # ----------------------------------- Update rows for student and assess sheets
1060:
1061: sub updatestudentassesssheet {
1.5 www 1062: my $safeeval=shift;
1063: my %bighash;
1.35 ! www 1064: my $stype=&gettype($safeeval);
! 1065: my %current=();
! 1066: unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
1.5 www 1067: # -------------------------------------------------------------------- Tie hash
1068: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
1069: &GDBM_READER,0640)) {
1070: # --------------------------------------------------------- Get all assessments
1071:
1072: my %allkeys=();
1073: my %allassess=();
1074:
1075: map {
1076: if ($_=~/^src\_(\d+)\.(\d+)$/) {
1077: my $mapid=$1;
1078: my $resid=$2;
1079: my $id=$mapid.'.'.$resid;
1080: my $srcf=$bighash{$_};
1081: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1082: my $symb=
1083: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1084: '___'.$resid.'___'.
1085: &Apache::lonnet::declutter($srcf);
1086: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 1087:
1.6 www 1088: if ($stype eq 'assesscalc') {
1.5 www 1089: map {
1.11 www 1090: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 1091: my $key=$_;
1092: my $display=
1093: &Apache::lonnet::metadata($srcf,$key.'.display');
1094: unless ($display) {
1095: $display=
1096: &Apache::lonnet::metadata($srcf,$key.'.name');
1097: }
1098: $allkeys{$key}=$display;
1099: }
1100: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
1101: }
1102: }
1103: }
1104: } keys %bighash;
1105: untie(%bighash);
1106:
1107: #
1.11 www 1108: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 1109: # %allassess has a list of all resource displays by symb
1110: #
1.6 www 1111:
1112: if ($stype eq 'assesscalc') {
1113: %current=%allkeys;
1114: } elsif ($stype eq 'studentcalc') {
1115: %current=%allassess;
1116: }
1.35 ! www 1117: $updatedata{$ENV{'request.course.fn'}.'_'.$stype}=
! 1118: join('___;___',%current);
! 1119: undef %allkeys;
! 1120: undef %allassess;
! 1121: } else {
! 1122: return 'Could not access course data';
! 1123: }
! 1124: # ------------------------------------------------------ Get current from cache
! 1125: } else {
! 1126: %current=split(/\_\_\_\;\_\_\_/,
! 1127: $updatedata{$ENV{'request.course.fn'}.'_'.$stype});
! 1128: }
! 1129: # -------------------- Find discrepancies between the course row table and this
! 1130: #
! 1131: my %f=&getformulas($safeeval);
! 1132: my $changed=0;
1.6 www 1133:
1134: my $maxrow=0;
1135: my %existing=();
1136:
1137: # ----------------------------------------------------------- Now obsolete rows
1.5 www 1138: map {
1.6 www 1139: if ($_=~/^A(\d+)/) {
1140: $maxrow=($1>$maxrow)?$1:$maxrow;
1141: $existing{$f{$_}}=1;
1.17 www 1142: unless ((defined($current{$f{$_}})) || (!$1)) {
1.6 www 1143: $f{$_}='!!! Obsolete';
1144: $changed=1;
1.5 www 1145: }
1146: }
1147: } keys %f;
1.6 www 1148:
1149: # -------------------------------------------------------- New and unknown keys
1150:
1151: map {
1152: unless ($existing{$_}) {
1153: $changed=1;
1154: $maxrow++;
1155: $f{'A'.$maxrow}=$_;
1156: }
1157: } keys %current;
1.35 ! www 1158:
1.6 www 1159: if ($changed) { &setformulas($safeeval,%f); }
1160:
1161: &setmaxrow($safeeval,$maxrow);
1162: &setrowlabels($safeeval,%current);
1.35 ! www 1163:
! 1164: undef %current;
! 1165: undef %existing;
1.5 www 1166: }
1.3 www 1167:
1.24 www 1168: # ------------------------------------------------ Load data for one assessment
1.16 www 1169:
1.29 www 1170: sub loadstudent {
1.16 www 1171: my $safeeval=shift;
1172: my %c=();
1173: my %f=&getformulas($safeeval);
1174: map {
1.17 www 1175: if ($_=~/^A(\d+)/) {
1176: my $row=$1;
1.16 www 1177: unless ($f{$_}=~/^\!/) {
1.30 www 1178: my @assessdata=&exportsheet(&getuname($safeeval),
1179: &getudom($safeeval),
1180: 'assesscalc',$f{$_});
1.17 www 1181: my $index=0;
1.30 www 1182: map {
1183: if ($assessdata[$index]) {
1184: $c{$_.$row}=$assessdata[$index];
1185: unless ($_ eq 'A') {
1186: $f{$_.$row}='import';
1187: }
1188: }
1189: $index++;
1190: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1191: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.16 www 1192: }
1193: }
1194: } keys %f;
1.18 www 1195: &setformulas($safeeval,%f);
1.16 www 1196: &setconstants($safeeval,%c);
1197: }
1198:
1.24 www 1199: # --------------------------------------------------- Load data for one student
1200:
1.30 www 1201: sub loadcourse {
1.24 www 1202: my $safeeval=shift;
1203: my %c=();
1204: my %f=&getformulas($safeeval);
1205: map {
1206: if ($_=~/^A(\d+)/) {
1207: my $row=$1;
1.30 www 1208: unless (($f{$_}=~/^\!/)
1.32 www 1209: || ($row>200))
1.30 www 1210: {
1211: my @studentdata=&exportsheet(&getuname($safeeval),
1212: &getudom($safeeval),
1213: 'studentcalc');
1.32 www 1214: undef %userrdatas;
1.24 www 1215: my $index=0;
1.30 www 1216: map {
1217: if ($studentdata[$index]) {
1218: $c{$_.$row}=$studentdata[$index];
1219: unless ($_ eq 'A') {
1220: $f{$_.$row}='import';
1221: }
1222: }
1223: $index++;
1224: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1225: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
1.24 www 1226: }
1227: }
1228: } keys %f;
1229: &setformulas($safeeval,%f);
1230: &setconstants($safeeval,%c);
1231: }
1232:
1.6 www 1233: # ------------------------------------------------ Load data for one assessment
1234:
1.29 www 1235: sub loadassessment {
1236: my $safeeval=shift;
1237:
1238: my $uhome=&getuhome($safeeval);
1239: my $uname=&getuname($safeeval);
1240: my $udom=&getudom($safeeval);
1241: my $symb=&getusymb($safeeval);
1242: my $cid=&getcid($safeeval);
1243: my $cnum=&getcnum($safeeval);
1244: my $cdom=&getcdom($safeeval);
1245: my $chome=&getchome($safeeval);
1246:
1.6 www 1247: my $namespace;
1.29 www 1248: unless ($namespace=$cid) { return ''; }
1.11 www 1249:
1250: # ----------------------------------------------------------- Get stored values
1251: my $answer=&Apache::lonnet::reply(
1.15 www 1252: "restore:$udom:$uname:".
1253: &Apache::lonnet::escape($namespace).":".
1254: &Apache::lonnet::escape($symb),$uhome);
1.6 www 1255: my %returnhash=();
1256: map {
1257: my ($name,$value)=split(/\=/,$_);
1.11 www 1258: $returnhash{&Apache::lonnet::unescape($name)}=
1259: &Apache::lonnet::unescape($value);
1.6 www 1260: } split(/\&/,$answer);
1261: my $version;
1262: for ($version=1;$version<=$returnhash{'version'};$version++) {
1263: map {
1264: $returnhash{$_}=$returnhash{$version.':'.$_};
1265: } split(/\:/,$returnhash{$version.':keys'});
1266: }
1.11 www 1267: # ----------------------------- returnhash now has all stores for this resource
1268:
1269: # ---------------------------- initialize coursedata and userdata for this user
1.31 www 1270: undef %courseopt;
1271: undef %useropt;
1.29 www 1272:
1273: my $userprefix=$uname.'_'.$udom.'_';
1274:
1.11 www 1275: unless ($uhome eq 'no_host') {
1276: # -------------------------------------------------------------- Get coursedata
1.13 www 1277: unless
1.32 www 1278: ((time-$courserdatas{$cid.'.last_cache'})<240) {
1.29 www 1279: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
1280: ':resourcedata',$chome);
1.11 www 1281: if ($reply!~/^error\:/) {
1.29 www 1282: $courserdatas{$cid}=$reply;
1283: $courserdatas{$cid.'.last_cache'}=time;
1.11 www 1284: }
1285: }
1286: map {
1287: my ($name,$value)=split(/\=/,$_);
1.29 www 1288: $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
1.11 www 1289: &Apache::lonnet::unescape($value);
1290: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
1291: # --------------------------------------------------- Get userdata (if present)
1.13 www 1292: unless
1.32 www 1293: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
1.11 www 1294: my $reply=
1295: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
1296: if ($reply!~/^error\:/) {
1297: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 1298: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 1299: }
1300: }
1301: map {
1302: my ($name,$value)=split(/\=/,$_);
1.29 www 1303: $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
1.15 www 1304: &Apache::lonnet::unescape($value);
1.11 www 1305: } split(/\&/,$userrdatas{$uname.'___'.$udom});
1.29 www 1306: }
1307:
1308: # ----------------- now courseopt, useropt initialized for this user and course
1309: # (used by parmval)
1310:
1311: my %c=();
1.6 www 1312:
1.29 www 1313: if (tie(%parmhash,'GDBM_File',
1314: &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
1.6 www 1315: my %f=&getformulas($safeeval);
1316: map {
1317: if ($_=~/^A/) {
1318: unless ($f{$_}=~/^\!/) {
1.11 www 1319: if ($f{$_}=~/^parameter/) {
1.28 www 1320: $c{$_}=&parmval($f{$_},$safeeval);
1.11 www 1321: } else {
1.15 www 1322: my $key=$f{$_};
1323: $key=~s/^stores\_/resource\./;
1324: $key=~s/\_/\./;
1325: $c{$_}=$returnhash{$key};
1.11 www 1326: }
1327: }
1.6 www 1328: }
1329: } keys %f;
1.29 www 1330: untie(%parmhash);
1331: }
1332: &setconstants($safeeval,%c);
1.6 www 1333: }
1334:
1.10 www 1335: # --------------------------------------------------------- Various form fields
1336:
1337: sub textfield {
1338: my ($title,$name,$value)=@_;
1339: return "\n<p><b>$title:</b><br>".
1340: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
1341: }
1342:
1343: sub hiddenfield {
1344: my ($name,$value)=@_;
1345: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
1346: }
1347:
1348: sub selectbox {
1349: my ($title,$name,$value,%options)=@_;
1350: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
1351: map {
1352: $selout.='<option value="'.$_.'"';
1353: if ($_ eq $value) { $selout.=' selected'; }
1354: $selout.='>'.$options{$_}.'</option>';
1355: } sort keys %options;
1356: return $selout.'</select>';
1357: }
1358:
1.28 www 1359: # =============================================== Update information in a sheet
1360: #
1361: # Add new users or assessments, etc.
1362: #
1363:
1364: sub updatesheet {
1365: my $safeeval=shift;
1366: my $stype=&gettype($safeeval);
1367: if ($stype eq 'classcalc') {
1368: return &updateclasssheet($safeeval);
1369: } else {
1370: return &updatestudentassesssheet($safeeval);
1371: }
1372: }
1373:
1374: # =================================================== Load the rows for a sheet
1375: #
1376: # Import the data for rows
1377: #
1378:
1379: sub loadrows() {
1380: my $safeeval=shift;
1381: my $stype=&gettype($safeeval);
1382: if ($stype eq 'classcalc') {
1.29 www 1383: &loadcourse($safeeval);
1.28 www 1384: } elsif ($stype eq 'studentcalc') {
1.29 www 1385: &loadstudent($safeeval);
1.28 www 1386: } else {
1.29 www 1387: &loadassessment($safeeval);
1.28 www 1388: }
1389: }
1390:
1391: # ============================================================== Export handler
1392: #
1393: # Non-interactive call from with program
1394: #
1395:
1396: sub exportsheet {
1397: my ($uname,$udom,$stype,$usymb,$fn)=@_;
1.29 www 1398: my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
1.28 www 1399: &readsheet($thissheet,$fn);
1400: &updatesheet($thissheet);
1401: &loadrows($thissheet);
1402: &calcsheet($thissheet);
1.31 www 1403: my @returnthis=&exportdata($thissheet);
1404: undef $thissheet;
1405: return @returnthis;
1.28 www 1406: }
1407:
1.12 www 1408: # ================================================================ Main handler
1.28 www 1409: #
1410: # Interactive call to screen
1411: #
1412: #
1413:
1.3 www 1414:
1415: sub handler {
1.7 www 1416: my $r=shift;
1417:
1.28 www 1418: if ($r->header_only) {
1.7 www 1419: $r->content_type('text/html');
1420: $r->send_http_header;
1421: return OK;
1.28 www 1422: }
1423:
1424: # ---------------------------------------------------- Global directory configs
1425:
1.29 www 1426: $includedir=$r->dir_config('lonIncludes');
1.28 www 1427: $tmpdir=$r->dir_config('lonDaemons').'/tmp/';
1.3 www 1428:
1.7 www 1429: # ----------------------------------------------------- Needs to be in a course
1.3 www 1430:
1.29 www 1431: if ($ENV{'request.course.fn'}) {
1.10 www 1432:
1433: # --------------------------- Get query string for limited number of parameters
1.17 www 1434:
1.10 www 1435: map {
1436: my ($name, $value) = split(/=/,$_);
1437: $value =~ tr/+/ /;
1438: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.19 www 1439: if (($name eq 'uname') || ($name eq 'udom') ||
1440: ($name eq 'usymb') || ($name eq 'ufn')) {
1.10 www 1441: unless ($ENV{'form.'.$name}) {
1442: $ENV{'form.'.$name}=$value;
1443: }
1444: }
1445: } (split(/&/,$ENV{'QUERY_STRING'}));
1446:
1447: # ------------------------------------------- Nothing there? Must be login user
1.29 www 1448:
1449: my $aname;
1450: my $adom;
1451:
1.10 www 1452: unless ($ENV{'form.uname'}) {
1.29 www 1453: $aname=$ENV{'user.name'};
1454: $adom=$ENV{'user.domain'};
1.11 www 1455: } else {
1.29 www 1456: $aname=$ENV{'form.uname'};
1457: $adom=$ENV{'form.udom'};
1.10 www 1458: }
1.14 www 1459:
1.10 www 1460: # ------------------------------------------------------------------- Open page
1461:
1.7 www 1462: $r->content_type('text/html');
1.11 www 1463: $r->header_out('Cache-control','no-cache');
1464: $r->header_out('Pragma','no-cache');
1.7 www 1465: $r->send_http_header;
1.3 www 1466:
1.14 www 1467: # --------------------------------------------------------------- Screen output
1468:
1.10 www 1469: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
1470: $r->print(<<ENDSCRIPT);
1471: <script language="JavaScript">
1472:
1473: function celledit(cn,cf) {
1474: var cnf=prompt(cn,cf);
1475: if (cnf!=null) {
1476: document.sheet.unewfield.value=cn;
1477: document.sheet.unewformula.value=cnf;
1478: document.sheet.submit();
1479: }
1480: }
1481:
1482: </script>
1483: ENDSCRIPT
1484: $r->print('</head><body bgcolor="#FFFFFF">'.
1.21 www 1485: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
1486: '<h1>LON-CAPA Spreadsheet</h1>'.
1.10 www 1487: '<form action="'.$r->uri.'" name=sheet method=post>'.
1488: &hiddenfield('uname',$ENV{'form.uname'}).
1489: &hiddenfield('udom',$ENV{'form.udom'}).
1490: &hiddenfield('usymb',$ENV{'form.usymb'}).
1491: &hiddenfield('unewfield','').
1492: &hiddenfield('unewformula',''));
1.29 www 1493:
1494: # ---------------------- Make sure that this gets out, even if user hits "stop"
1495:
1.24 www 1496: $r->rflush();
1.29 www 1497:
1.14 www 1498: # ---------------------------------------- Read new sheet or modified worksheet
1499:
1.19 www 1500: $r->uri=~/\/(\w+)$/;
1.14 www 1501:
1.29 www 1502: my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
1503:
1.30 www 1504: # ------------------------ If a new formula had been entered, go from work copy
1505:
1506: if ($ENV{'form.unewfield'}) {
1507: $r->print('<h2>Modified Workcopy</h2>');
1508: $ENV{'form.unewformula'}=~s/\'/\"/g;
1509: $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
1510: $ENV{'form.unewformula'}.'<p>');
1511: &setfilename($asheet,$ENV{'form.ufn'});
1512: &tmpread($asheet,
1513: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
1514:
1515: } elsif ($ENV{'form.saveas'}) {
1516: &setfilename($asheet,$ENV{'form.ufn'});
1517: &tmpread($asheet);
1518: } else {
1519: &readsheet($asheet,$ENV{'form.ufn'});
1520: }
1521:
1522: # -------------------------------------------------- Print out user information
1523:
1524: unless (&gettype($asheet) eq 'classcalc') {
1525: $r->print('<p><b>User:</b> '.&getuname($asheet).
1526: '<br><b>Domain:</b> '.&getudom($asheet));
1527: if (&getcsec($asheet) eq '-1') {
1528: $r->print('<h3><font color=red>'.
1529: 'Not a student in this course</font></h3>');
1530: } else {
1531: $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));
1532: }
1533: }
1534:
1535: # ---------------------------------------------------------------- Course title
1536:
1537: $r->print('<h1>'.
1538: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');
1539:
1540:
1.22 www 1541: # ---------------------------------------------------- See if something to save
1.30 www 1542:
1543: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
1544: my $fname='';
1545: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
1546: $fname=~s/\W/\_/g;
1547: if ($fname eq 'default') { $fname='course_default'; }
1548: $fname.='_'.&gettype($asheet);
1549: &setfilename($asheet,$fname);
1550: $ENV{'form.ufn'}=$fname;
1551: $r->print('<p>Saving spreadsheet: '.
1552: &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
1553: }
1554: }
1555:
1.14 www 1556: # ------------------------------------------------ Write the modified worksheet
1557:
1.30 www 1558: $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');
1559:
1560: &tmpwrite($asheet);
1561:
1562: # ----------------------------------------------------------------- Save dialog
1563:
1564:
1565: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
1566: my $fname=$ENV{'form.ufn'};
1567: $fname=~s/\_[^\_]+$//;
1568: if ($fname eq 'default') { $fname='course_default'; }
1569: $r->print('<input type=submit name=saveas value="Save as ...">'.
1570: '<input type=text size=20 name=newfn value="'.$fname.
1571: '"> (make default: <input type=checkbox name="makedefufn">)<p>');
1572: }
1573:
1574: $r->print(&hiddenfield('ufn',&getfilename($asheet)));
1575:
1576:
1577: # ----------------------------------------------------- Update sheet, load rows
1.14 www 1578:
1.29 www 1579: &updatesheet($asheet);
1580: &loadrows($asheet);
1.14 www 1581:
1582:
1.29 www 1583: my $calcoutput=&calcsheet($asheet);
1584: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
1.8 www 1585:
1.29 www 1586: &outsheet($r,$asheet);
1.10 www 1587: $r->print('</form></body></html>');
1.29 www 1588:
1.33 www 1589: # --------------------------------- We know this leaks, so terminate this child
1590:
1591: $r->child_terminate();
1.29 www 1592:
1.14 www 1593: # ------------------------------------------------------------------------ Done
1.7 www 1594: } else {
1595: # ----------------------------- Not in a course, or not allowed to modify parms
1596: $ENV{'user.error.msg'}=
1597: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1598: return HTTP_NOT_ACCEPTABLE;
1599: }
1.3 www 1600: return OK;
1.28 www 1601:
1.1 www 1602: }
1603:
1604: 1;
1605: __END__
1606:
1607:
1608:
1609:
1610:
1611:
1612:
1613:
1614:
1615:
1616:
1617:
1618:
1619:
1620:
1621:
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