Annotation of loncom/interface/lonspreadsheet.pm, revision 1.15
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,
! 5: # 12/08,12/09,12/11,12/12 Gerd Kortemeyer
1.1 www 6:
7: package Apache::lonspreadsheet;
8:
9: use strict;
10: use Safe;
1.3 www 11: use Safe::Hole;
1.1 www 12: use Opcode;
13: use Apache::lonnet;
1.7 www 14: use Apache::Constants qw(:common :http);
1.3 www 15: use HTML::TokeParser;
1.6 www 16: use GDBM_File;
1.3 www 17:
1.11 www 18: #
19: # These cache hashes need to be independent of user, resource and course
20: # (user and course are in the keys)
21: #
22: use vars qw(%spreadsheets %courserdatas %userrdatas);
23: #
24: # These global hashes are dependent on user, course and resource,
25: # and need to be initialized every time when a sheet is calculated
26: #
27: my %courseopt;
28: my %useropt;
29: my %parmhash;
30: my $csec;
31: my $uname;
32: my $udom;
33:
1.5 www 34: # =============================================================================
35: # ===================================== Implements an instance of a spreadsheet
1.4 www 36:
37: sub initsheet {
38: my $safeeval = new Safe;
39: my $safehole = new Safe::Hole;
40: $safeeval->permit("entereval");
41: $safeeval->permit(":base_math");
42: $safeeval->permit("sort");
43: $safeeval->deny(":base_io");
44: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
45: my $code=<<'ENDDEFS';
46: # ---------------------------------------------------- Inside of the safe space
47:
1.3 www 48: #
49: # f: formulas
1.4 www 50: # t: intermediate format (variable references expanded)
51: # v: output values
1.6 www 52: # c: preloaded constants (A-column)
53: # rl: row label
1.3 www 54:
1.4 www 55: %v=();
56: %t=();
57: %f=();
1.6 www 58: %c=();
59: %rl=();
60:
61: $maxrow=0;
1.5 www 62: $sheettype='';
63: $filename='';
1.1 www 64:
65: sub mask {
66: my ($lower,$upper)=@_;
67:
1.7 www 68: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 69: my $la=$1;
70: my $ld=$2;
71:
1.7 www 72: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 73: my $ua=$1;
74: my $ud=$2;
75: my $alpha='';
76: my $num='';
77:
78: if (($la eq '*') || ($ua eq '*')) {
1.7 www 79: $alpha='[A-Za-z]';
1.1 www 80: } else {
1.7 www 81: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
82: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
83: $alpha='['.$la.'-'.$ua.']';
84: } else {
85: $alpha='['.$la.'-Za-'.$ua.']';
86: }
1.1 www 87: }
88:
89: if (($ld eq '*') || ($ud eq '*')) {
90: $num='\d+';
91: } else {
92: if (length($ld)!=length($ud)) {
93: $num.='(';
94: map {
95: $num.='['.$_.'-9]';
96: } ($ld=~m/\d/g);
97: if (length($ud)-length($ld)>1) {
98: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
99: }
100: $num.='|';
101: map {
102: $num.='[0-'.$_.']';
103: } ($ud=~m/\d/g);
104: $num.=')';
105: } else {
106: my @lda=($ld=~m/\d/g);
107: my @uda=($ud=~m/\d/g);
1.7 www 108: my $i; $j=0; $notdone=1;
109: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
1.1 www 110: if ($lda[$i]==$uda[$i]) {
111: $num.=$lda[$i];
112: $j=$i;
1.7 www 113: } else {
114: $notdone=0;
1.1 www 115: }
116: }
117: if ($j<$#lda-1) {
118: $num.='('.$lda[$j+1];
119: for ($i=$j+2;$i<=$#lda;$i++) {
120: $num.='['.$lda[$i].'-9]';
121: }
122: if ($uda[$j+1]-$lda[$j+1]>1) {
123: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
124: ($#lda-$j-1).'}';
125: }
126: $num.='|'.$uda[$j+1];
127: for ($i=$j+2;$i<=$#uda;$i++) {
128: $num.='[0-'.$uda[$i].']';
129: }
130: $num.=')';
131: } else {
1.7 www 132: if ($lda[$#lda]!=$uda[$#uda]) {
133: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
134: }
1.1 www 135: }
136: }
137: }
1.4 www 138: return '^'.$alpha.$num."\$";
1.1 www 139: }
140:
141: sub NUM {
142: my $mask=mask(@_);
143: my $num=0;
144: map {
145: $num++;
146: } grep /$mask/,keys %v;
147: return $num;
148: }
149:
150: sub BIN {
151: my ($low,$high,$lower,$upper)=@_;
152: my $mask=mask($lower,$upper);
153: my $num=0;
154: map {
155: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
156: $num++;
157: }
158: } grep /$mask/,keys %v;
159: return $num;
160: }
161:
162:
163: sub SUM {
164: my $mask=mask(@_);
165: my $sum=0;
166: map {
167: $sum+=$v{$_};
168: } grep /$mask/,keys %v;
169: return $sum;
170: }
171:
172: sub MEAN {
173: my $mask=mask(@_);
174: my $sum=0; my $num=0;
175: map {
176: $sum+=$v{$_};
177: $num++;
178: } grep /$mask/,keys %v;
179: if ($num) {
180: return $sum/$num;
181: } else {
182: return undef;
183: }
184: }
185:
186: sub STDDEV {
187: my $mask=mask(@_);
188: my $sum=0; my $num=0;
189: map {
190: $sum+=$v{$_};
191: $num++;
192: } grep /$mask/,keys %v;
193: unless ($num>1) { return undef; }
194: my $mean=$sum/$num;
195: $sum=0;
196: map {
197: $sum+=($v{$_}-$mean)**2;
198: } grep /$mask/,keys %v;
199: return sqrt($sum/($num-1));
200: }
201:
202: sub PROD {
203: my $mask=mask(@_);
204: my $prod=1;
205: map {
206: $prod*=$v{$_};
207: } grep /$mask/,keys %v;
208: return $prod;
209: }
210:
211: sub MAX {
212: my $mask=mask(@_);
213: my $max='-';
214: map {
215: unless ($max) { $max=$v{$_}; }
216: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
217: } grep /$mask/,keys %v;
218: return $max;
219: }
220:
221: sub MIN {
222: my $mask=mask(@_);
223: my $min='-';
224: map {
225: unless ($max) { $max=$v{$_}; }
226: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
227: } grep /$mask/,keys %v;
228: return $min;
229: }
230:
231: sub SUMMAX {
232: my ($num,$lower,$upper)=@_;
233: my $mask=mask($lower,$upper);
234: my @inside=();
235: map {
236: $inside[$#inside+1]=$v{$_};
237: } grep /$mask/,keys %v;
238: @inside=sort(@inside);
239: my $sum=0; my $i;
240: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
241: $sum+=$inside[$i];
242: }
243: return $sum;
244: }
245:
246: sub SUMMIN {
247: my ($num,$lower,$upper)=@_;
248: my $mask=mask($lower,$upper);
249: my @inside=();
250: map {
251: $inside[$#inside+1]=$v{$_};
252: } grep /$mask/,keys %v;
253: @inside=sort(@inside);
254: my $sum=0; my $i;
255: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
256: $sum+=$inside[$i];
257: }
258: return $sum;
259: }
260:
261: sub sett {
262: %t=();
263: map {
264: if ($f{$_}) {
1.6 www 265: if ($_=~/^A/) {
266: unless ($f{$_}=~/^\!/) {
267: $t{$_}=$c{$_};
268: }
269: } else {
270: $t{$_}=$f{$_};
1.7 www 271: $t{$_}=~s/\.\.+/\,/g;
272: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 273: }
1.1 www 274: }
275: } keys %f;
276: }
277:
1.4 www 278: sub calc {
1.1 www 279: %v=();
1.4 www 280: &sett();
1.1 www 281: my $notfinished=1;
282: my $depth=0;
283: while ($notfinished) {
284: $notfinished=0;
285: map {
286: my $old=$v{$_};
1.4 www 287: $v{$_}=eval($t{$_});
1.1 www 288: if ($@) {
289: %v=();
290: return $@;
291: }
292: if ($v{$_} ne $old) { $notfinished=1; }
293: } keys %t;
294: $depth++;
295: if ($depth>100) {
296: %v=();
297: return 'Maximum calculation depth exceeded';
298: }
299: }
300: return '';
301: }
302:
1.6 www 303: sub outrow {
304: my $n=shift;
305: my @cols=();
306: if ($n) {
307: $cols[0]=$rl{$f{'A'.$n}};
308: } else {
309: $cols[0]='<b><font size=+1>Export</font></b>';
310: }
311: map {
312: my $fm=$f{$_.$n};
313: $fm=~s/[\'\"]/\&\#34;/g;
314: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
315: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 316: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
317: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
318: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 319: return @cols;
320: }
321:
1.14 www 322: sub exportrowa {
323: my $rowa='';
324: map {
325: $rowa.=$v{$_.'0'}."','";
326: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
327: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
328: $rowa=~s/\'\,\'$//;
329: return $rowa;
330: }
331:
1.4 www 332: # ------------------------------------------- End of "Inside of the safe space"
333: ENDDEFS
334: $safeeval->reval($code);
335: return $safeeval;
336: }
337:
338: # ------------------------------------------------ Add or change formula values
339:
340: sub setformulas {
341: my ($safeeval,@f)=@_;
1.6 www 342: $safeeval->reval('%f='."('".join("','",@f)."');");
343: }
344:
345: # ------------------------------------------------ Add or change formula values
346:
347: sub setconstants {
348: my ($safeeval,@c)=@_;
349: $safeeval->reval('%c='."('".join("','",@c)."');");
350: }
351:
352: # ------------------------------------------------ Add or change formula values
353:
354: sub setrowlabels {
355: my ($safeeval,@rl)=@_;
356: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 357: }
358:
359: # ------------------------------------------------------- Calculate spreadsheet
360:
361: sub calcsheet {
362: my $safeeval=shift;
363: $safeeval->reval('&calc();');
364: }
365:
366: # ------------------------------------------------------------------ Get values
367:
368: sub getvalues {
369: my $safeeval=shift;
370: return $safeeval->reval('%v');
371: }
372:
373: # ---------------------------------------------------------------- Get formulas
374:
375: sub getformulas {
376: my $safeeval=shift;
377: return $safeeval->reval('%f');
378: }
379:
1.5 www 380: # -------------------------------------------------------------------- Set type
381:
382: sub settype {
383: my ($safeeval,$type)=@_;
1.11 www 384: $safeeval->reval('$sheettype="'.$type.'";');
1.5 www 385: }
386:
387: # -------------------------------------------------------------------- Get type
388:
389: sub gettype {
390: my $safeeval=shift;
391: return $safeeval->reval('$sheettype');
392: }
1.6 www 393: # ------------------------------------------------------------------ Set maxrow
394:
395: sub setmaxrow {
396: my ($safeeval,$row)=@_;
397: $safeeval->reval('$maxrow='.$row.';');
398: }
399:
400: # ------------------------------------------------------------------ Get maxrow
401:
402: sub getmaxrow {
403: my $safeeval=shift;
404: return $safeeval->reval('$maxrow');
405: }
1.5 www 406:
1.6 www 407: # ---------------------------------------------------------------- Set filename
1.5 www 408:
409: sub setfilename {
410: my ($safeeval,$fn)=@_;
1.11 www 411: $safeeval->reval('$filename="'.$fn.'";');
1.5 www 412: }
413:
1.6 www 414: # ---------------------------------------------------------------- Get filename
1.5 www 415:
416: sub getfilename {
417: my $safeeval=shift;
418: return $safeeval->reval('$filename');
419: }
1.14 www 420:
421: # ------------------------------------------------------------- Export of A-row
422:
423: sub exportrow {
424: my $safeeval=shift;
425: return $safeeval->reval('&exportrowa()');
426: }
427:
1.5 www 428: # ========================================================== End of Spreadsheet
429: # =============================================================================
430:
431:
1.6 www 432: # --------------------------------------------- Produce output row n from sheet
433:
434: sub rown {
435: my ($safeeval,$n)=@_;
1.9 www 436: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 437: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
438: my $showf=0;
439: map {
1.9 www 440: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 441: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
442: if ($showf==0) { $vl=$_; }
1.9 www 443: if ($showf<=1) { $bgcolor='#FFDDDD'; }
444: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.6 www 445: if ($showf>1) {
446: if ($vl eq '') {
1.9 www 447: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 448: }
449: $rowdata.=
1.10 www 450: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 451: '</a></td>';
452: } else {
1.9 www 453: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 454: }
455: $showf++;
456: } $safeeval->reval('&outrow('.$n.')');
457: return $rowdata.'</tr>';
458: }
459:
460: # ------------------------------------------------------------- Print out sheet
461:
462: sub outsheet {
463: my $safeeval=shift;
1.9 www 464: my $tabledata='<table border=2><tr><td colspan=2> </td>'.
465: '<td bgcolor=#FFDDDD><b>A Import</b></td>';
1.6 www 466: map {
467: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
1.9 www 468: } ('B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 469: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
470: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
471: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 472: $tabledata.='</tr>';
473: my $row;
474: my $maxrow=&getmaxrow($safeeval);
475: for ($row=0;$row<=$maxrow;$row++) {
476: $tabledata.=&rown($safeeval,$row);
477: }
478: $tabledata.='</table>';
479: }
480:
481:
1.5 www 482:
483: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 484:
1.5 www 485: sub readsheet {
1.8 www 486: my ($safeeval,$fn)=@_;
1.5 www 487: &setfilename($safeeval,$fn);
488: $fn=~/\.(\w+)/;
489: &settype($safeeval,$1);
1.4 www 490: my %f=();
1.10 www 491: unless ($spreadsheets{$fn}) {
492: $spreadsheets{$fn}='';
493: {
494: my $fh;
495: if ($fh=Apache::File->new($fn)) {
496: $spreadsheets{$fn}=join('',<$fh>);
497: }
498: }
1.3 www 499: }
500: {
1.10 www 501: my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
1.3 www 502: my $token;
503: while ($token=$parser->get_token) {
504: if ($token->[0] eq 'S') {
505: if ($token->[1] eq 'field') {
506: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
507: $parser->get_text('/field');
508: }
509: }
510: }
511: }
1.5 www 512: &setformulas($safeeval,%f);
1.3 www 513: }
514:
1.10 www 515: # ----------------------------------------------- Make a temp copy of the sheet
516:
517: sub tmpwrite {
1.11 www 518: my ($safeeval,$tmpdir,$symb)=@_;
1.10 www 519: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
520: $fn=~s/\W/\_/g;
521: $fn=$tmpdir.$fn.'.tmp';
522: my $fh;
523: if ($fh=Apache::File->new('>'.$fn)) {
524: print $fh join("\n",&getformulas($safeeval));
525: }
526: }
527:
528: # ---------------------------------------------------------- Read the temp copy
529:
530: sub tmpread {
1.11 www 531: my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
1.10 www 532: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
533: $fn=~s/\W/\_/g;
534: $fn=$tmpdir.$fn.'.tmp';
535: my $fh;
536: my %fo=();
537: if ($fh=Apache::File->new($fn)) {
538: my $name;
539: while ($name=<$fh>) {
540: chomp($name);
541: my $value=<$fh>;
542: chomp($value);
543: $fo{$name}=$value;
544: }
545: }
546: $fo{$nfield}=$nform;
547: &setformulas($safeeval,%fo);
548: }
549:
1.3 www 550: # --------------------------------------------------------------- Read metadata
551:
552: sub readmeta {
553: my $fn=shift;
554: unless ($fn=~/\.meta$/) { $fn.='meta'; }
555: my $content;
556: my %returnhash=();
557: {
558: my $fh=Apache::File->new($fn);
559: $content=join('',<$fh>);
560: }
561: my $parser=HTML::TokeParser->new(\$content);
562: my $token;
563: while ($token=$parser->get_token) {
564: if ($token->[0] eq 'S') {
565: my $entry=$token->[1];
566: if (($entry eq 'stores') || ($entry eq 'parameter')) {
567: my $unikey=$entry;
568: $unikey.='_'.$token->[2]->{'part'};
569: $unikey.='_'.$token->[2]->{'name'};
570: $returnhash{$unikey}=$token->[2]->{'display'};
571: }
572: }
573: }
574: return %returnhash;
575: }
576:
1.11 www 577: # ================================================================== Parameters
578: # -------------------------------------------- Figure out a cascading parameter
579:
580: sub parmval {
581: my ($what,$symb)=@_;
582:
583: unless ($symb) { return ''; }
584: my $result='';
585:
586: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
587: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 588: my $rwhat=$what;
589: $what=~s/^parameter\_//;
590: $what=~s/\_/\./;
1.11 www 591:
592: my $symbparm=$symb.'.'.$what;
593: my $mapparm=$mapname.'___(all).'.$what;
594:
595: my $seclevel=
596: $ENV{'request.course.id'}.'.['.
597: $csec.'].'.$what;
598: my $seclevelr=
599: $ENV{'request.course.id'}.'.['.
600: $csec.'].'.$symbparm;
601: my $seclevelm=
602: $ENV{'request.course.id'}.'.['.
603: $csec.'].'.$mapparm;
604:
605: my $courselevel=
606: $ENV{'request.course.id'}.'.'.$what;
607: my $courselevelr=
608: $ENV{'request.course.id'}.'.'.$symbparm;
609: my $courselevelm=
610: $ENV{'request.course.id'}.'.'.$mapparm;
1.12 www 611:
1.11 www 612: # ---------------------------------------------------------- fourth, check user
613:
614: if ($uname) {
615:
616: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
617:
618: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
619:
620: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
621:
622: }
623:
624: # --------------------------------------------------------- third, check course
625:
626: if ($csec) {
627:
628: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
629:
630: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
631:
632: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
633:
634: }
635:
636: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
637:
638: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
639:
640: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
641:
642: # ----------------------------------------------------- second, check map parms
643:
644: my $thisparm=$parmhash{$symbparm};
645: if ($thisparm) { return $thisparm; }
646:
647: # -------------------------------------------------------- first, check default
648:
1.12 www 649: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 650:
651: }
652:
653:
1.5 www 654: # ----------------------------------------------------------------- Update rows
655:
656: sub updaterows {
657: my $safeeval=shift;
658: my %bighash;
659: # -------------------------------------------------------------------- Tie hash
660: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
661: &GDBM_READER,0640)) {
662: # --------------------------------------------------------- Get all assessments
663:
664: my %allkeys=();
665: my %allassess=();
666:
667: my $stype=&gettype($safeeval);
668:
669: map {
670: if ($_=~/^src\_(\d+)\.(\d+)$/) {
671: my $mapid=$1;
672: my $resid=$2;
673: my $id=$mapid.'.'.$resid;
674: my $srcf=$bighash{$_};
675: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
676: my $symb=
677: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
678: '___'.$resid.'___'.
679: &Apache::lonnet::declutter($srcf);
680: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 681:
1.6 www 682: if ($stype eq 'assesscalc') {
1.5 www 683: map {
1.11 www 684: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 685: my $key=$_;
686: my $display=
687: &Apache::lonnet::metadata($srcf,$key.'.display');
688: unless ($display) {
689: $display=
690: &Apache::lonnet::metadata($srcf,$key.'.name');
691: }
692: $allkeys{$key}=$display;
693: }
694: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
695: }
696: }
697: }
698: } keys %bighash;
699: untie(%bighash);
700:
701: #
1.11 www 702: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 703: # %allassess has a list of all resource displays by symb
704: #
705: # -------------------- Find discrepancies between the course row table and this
706: #
707: my %f=&getformulas($safeeval);
1.6 www 708: my $changed=0;
709:
710: my %current=();
711: if ($stype eq 'assesscalc') {
712: %current=%allkeys;
713: } elsif ($stype eq 'studentcalc') {
714: %current=%allassess;
715: }
716:
717: my $maxrow=0;
718: my %existing=();
719:
720: # ----------------------------------------------------------- Now obsolete rows
1.5 www 721: map {
1.6 www 722: if ($_=~/^A(\d+)/) {
723: $maxrow=($1>$maxrow)?$1:$maxrow;
724: $existing{$f{$_}}=1;
725: unless (defined($current{$f{$_}})) {
726: $f{$_}='!!! Obsolete';
727: $changed=1;
1.5 www 728: }
729: }
730: } keys %f;
1.6 www 731:
732: # -------------------------------------------------------- New and unknown keys
733:
734: map {
735: unless ($existing{$_}) {
736: $changed=1;
737: $maxrow++;
738: $f{'A'.$maxrow}=$_;
739: }
740: } keys %current;
741:
742: if ($changed) { &setformulas($safeeval,%f); }
743:
744: &setmaxrow($safeeval,$maxrow);
745: &setrowlabels($safeeval,%current);
1.5 www 746:
747: } else {
748: return 'Could not access course data';
749: }
750: }
1.3 www 751:
1.6 www 752: # ------------------------------------------------ Load data for one assessment
753:
754: sub rowaassess {
1.11 www 755: my ($safeeval,$symb)=@_;
1.6 www 756: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
757: my $namespace;
758: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
1.11 www 759:
760: # ----------------------------------------------------------- Get stored values
761: my $answer=&Apache::lonnet::reply(
1.15 ! www 762: "restore:$udom:$uname:".
! 763: &Apache::lonnet::escape($namespace).":".
! 764: &Apache::lonnet::escape($symb),$uhome);
1.6 www 765: my %returnhash=();
766: map {
767: my ($name,$value)=split(/\=/,$_);
1.11 www 768: $returnhash{&Apache::lonnet::unescape($name)}=
769: &Apache::lonnet::unescape($value);
1.6 www 770: } split(/\&/,$answer);
771: my $version;
772: for ($version=1;$version<=$returnhash{'version'};$version++) {
773: map {
774: $returnhash{$_}=$returnhash{$version.':'.$_};
775: } split(/\:/,$returnhash{$version.':keys'});
776: }
1.11 www 777: # ----------------------------- returnhash now has all stores for this resource
778:
779: # ---------------------------- initialize coursedata and userdata for this user
780: %courseopt=();
781: %useropt=();
782: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
783: unless ($uhome eq 'no_host') {
784: # -------------------------------------------------------------- Get coursedata
1.13 www 785: unless
786: ((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
1.11 www 787: my $reply=&Apache::lonnet::reply('dump:'.
788: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
789: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
790: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
791: if ($reply!~/^error\:/) {
792: $courserdatas{$ENV{'request.course.id'}}=$reply;
1.13 www 793: $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
1.11 www 794: }
795: }
796: map {
797: my ($name,$value)=split(/\=/,$_);
798: $courseopt{&Apache::lonnet::unescape($name)}=
799: &Apache::lonnet::unescape($value);
800: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
801: # --------------------------------------------------- Get userdata (if present)
1.13 www 802: unless
803: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
1.11 www 804: my $reply=
805: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
806: if ($reply!~/^error\:/) {
807: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 808: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 809: }
810: }
811: map {
812: my ($name,$value)=split(/\=/,$_);
813: $useropt{&Apache::lonnet::unescape($name)}=
1.15 ! www 814: &Apache::lonnet::unescape($value);
1.11 www 815: } split(/\&/,$userrdatas{$uname.'___'.$udom});
816: }
817: # -- now courseopt, useropt initialized for this user and course (used parmval)
1.6 www 818:
819: my %c=();
820: my %f=&getformulas($safeeval);
821: map {
822: if ($_=~/^A/) {
823: unless ($f{$_}=~/^\!/) {
1.11 www 824: if ($f{$_}=~/^parameter/) {
825: $c{$_}=&parmval($f{$_},$symb);
826: } else {
1.15 ! www 827: my $key=$f{$_};
! 828: $key=~s/^stores\_/resource\./;
! 829: $key=~s/\_/\./;
! 830: $c{$_}=$returnhash{$key};
1.11 www 831: }
832: }
1.6 www 833: }
834: } keys %f;
1.11 www 835:
1.6 www 836: &setconstants($safeeval,%c);
837: }
838:
1.10 www 839: # --------------------------------------------------------- Various form fields
840:
841: sub textfield {
842: my ($title,$name,$value)=@_;
843: return "\n<p><b>$title:</b><br>".
844: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
845: }
846:
847: sub hiddenfield {
848: my ($name,$value)=@_;
849: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
850: }
851:
852: sub selectbox {
853: my ($title,$name,$value,%options)=@_;
854: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
855: map {
856: $selout.='<option value="'.$_.'"';
857: if ($_ eq $value) { $selout.=' selected'; }
858: $selout.='>'.$options{$_}.'</option>';
859: } sort keys %options;
860: return $selout.'</select>';
861: }
862:
1.12 www 863: # ================================================================ Main handler
1.3 www 864:
865: sub handler {
1.7 www 866: my $r=shift;
867:
1.11 www 868: $uname='';
869: $udom='';
870: $csec='';
871:
1.7 www 872: if ($r->header_only) {
873: $r->content_type('text/html');
874: $r->send_http_header;
875: return OK;
876: }
1.3 www 877:
1.7 www 878: # ----------------------------------------------------- Needs to be in a course
1.3 www 879:
1.7 www 880: if (($ENV{'request.course.fn'}) ||
881: ($ENV{'request.state'} eq 'construct')) {
1.10 www 882:
883: # --------------------------- Get query string for limited number of parameters
884: map {
885: my ($name, $value) = split(/=/,$_);
886: $value =~ tr/+/ /;
887: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.11 www 888: if (($name eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
1.10 www 889: unless ($ENV{'form.'.$name}) {
890: $ENV{'form.'.$name}=$value;
891: }
892: }
893: } (split(/&/,$ENV{'QUERY_STRING'}));
894:
895: # ------------------------------------------- Nothing there? Must be login user
896:
897: unless ($ENV{'form.uname'}) {
1.11 www 898: $uname=$ENV{'user.name'};
899: $udom=$ENV{'user.domain'};
900: } else {
901: $uname=$ENV{'form.uname'};
902: $udom=$ENV{'form.udom'};
1.10 www 903: }
1.14 www 904: # ----------------------------------------------------------- Change of target?
905:
906: my $reroute=($ENV{'utarget'} eq 'export');
907:
1.10 www 908: # ------------------------------------------------------------------- Open page
909:
1.7 www 910: $r->content_type('text/html');
1.11 www 911: $r->header_out('Cache-control','no-cache');
912: $r->header_out('Pragma','no-cache');
1.7 www 913: $r->send_http_header;
1.3 www 914:
1.14 www 915: # --------------------------------------------------------------- Screen output
916:
917: unless ($reroute) {
1.10 www 918: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
919: $r->print(<<ENDSCRIPT);
920: <script language="JavaScript">
921:
922: function celledit(cn,cf) {
923: var cnf=prompt(cn,cf);
924: if (cnf!=null) {
925: document.sheet.unewfield.value=cn;
926: document.sheet.unewformula.value=cnf;
927: document.sheet.submit();
928: }
929: }
930:
931: </script>
932: ENDSCRIPT
933: $r->print('</head><body bgcolor="#FFFFFF">'.
934: '<form action="'.$r->uri.'" name=sheet method=post>'.
935: &hiddenfield('uname',$ENV{'form.uname'}).
936: &hiddenfield('udom',$ENV{'form.udom'}).
937: &hiddenfield('usymb',$ENV{'form.usymb'}).
938: &hiddenfield('unewfield','').
939: &hiddenfield('unewformula',''));
1.14 www 940: }
941:
942: # ---------------------------------------- Read new sheet or modified worksheet
943:
1.4 www 944: my $sheetone=initsheet();
1.10 www 945: if ($ENV{'form.unewfield'}) {
946: $r->print('<h2>Modified Workcopy</h2>');
947: $ENV{'form.unewformula'}=~s/\'/\"/g;
948: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
949: $ENV{'form.unewformula'}.'<br>');
950: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1.11 www 951: $ENV{'form.usymb'},
1.10 www 952: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
953: &setfilename($sheetone,$r->filename);
954: $r->filename=~/\.(\w+)/;
955: &settype($sheetone,$1);
1.11 www 956: } else {
957: &readsheet($sheetone,$r->filename);
958: }
1.14 www 959:
960: # --------------------------------------------- See if all import rows uptodate
961:
1.11 www 962: if (tie(%parmhash,'GDBM_File',
963: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
964: $csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
965: if ($csec eq '-1') {
966: $r->print('<h3><font color=red>'.
967: "User '$uname' at domain '$udom' not a student in this course</font></h3>");
968: }
969: &updaterows($sheetone);
970: untie(%parmhash);
1.10 www 971: } else {
1.11 www 972: $r->print('<h3><font color=red>'.
973: 'Could not initialize import fields (not in a course)</font></h3>');
974: }
1.14 www 975:
976: # ------------------------------------------------ Write the modified worksheet
977:
1.11 www 978: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
979: $ENV{'form.usymb'});
1.14 www 980:
981: # ----------------------------------------------------- Print user, course, etc
982: unless ($reroute) {
1.11 www 983: $r->print("<b>User '$uname' at domain '$udom' for '".
984: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
985: if ($csec) {
986: $r->print(", group/section '$csec'");
987: }
988: $r->print("</b>\n");
1.14 www 989: }
990: # -------------------------------------------------------- Import and calculate
991:
1.11 www 992: if (&gettype($sheetone) eq 'assesscalc') {
993: &rowaassess($sheetone,$ENV{'form.usymb'});
1.10 www 994: }
1.6 www 995: &calcsheet($sheetone);
1.14 www 996:
997: # ------------------------------------------------------- Print or export sheet
998: unless ($reroute) {
1.6 www 999: $r->print(&outsheet($sheetone));
1.8 www 1000:
1.10 www 1001: $r->print('</form></body></html>');
1.14 www 1002: } else {
1003: $r->print(&exportrow($sheetone));
1004: }
1005: # ------------------------------------------------------------------------ Done
1.7 www 1006: } else {
1007: # ----------------------------- Not in a course, or not allowed to modify parms
1008: $ENV{'user.error.msg'}=
1009: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1010: return HTTP_NOT_ACCEPTABLE;
1011: }
1.3 www 1012: return OK;
1.1 www 1013: }
1014:
1015: 1;
1016: __END__
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
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