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