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