Annotation of loncom/interface/lonspreadsheet.pm, revision 1.17
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.17 ! www 5: # 12/08,12/09,12/11,12/12,12/15,12/16,12/18 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=();
1.16 www 263: my $pattern='';
264: if ($sheettype eq 'assesscalc') {
265: $pattern='A';
266: } else {
267: $pattern='[A-Z]';
268: }
1.1 www 269: map {
270: if ($f{$_}) {
1.16 www 271: if ($_=~/^$pattern/) {
1.6 www 272: unless ($f{$_}=~/^\!/) {
273: $t{$_}=$c{$_};
274: }
275: } else {
276: $t{$_}=$f{$_};
1.7 www 277: $t{$_}=~s/\.\.+/\,/g;
278: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 279: }
1.1 www 280: }
281: } keys %f;
1.17 ! www 282: $t{'A0'}=$f{'A0'};
! 283: $t{'A0'}=~s/\.\.+/\,/g;
! 284: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.1 www 285: }
286:
1.4 www 287: sub calc {
1.1 www 288: %v=();
1.4 www 289: &sett();
1.1 www 290: my $notfinished=1;
291: my $depth=0;
292: while ($notfinished) {
293: $notfinished=0;
294: map {
295: my $old=$v{$_};
1.4 www 296: $v{$_}=eval($t{$_});
1.1 www 297: if ($@) {
298: %v=();
299: return $@;
300: }
301: if ($v{$_} ne $old) { $notfinished=1; }
302: } keys %t;
303: $depth++;
304: if ($depth>100) {
305: %v=();
306: return 'Maximum calculation depth exceeded';
307: }
308: }
309: return '';
310: }
311:
1.16 www 312: sub outrowassess {
1.6 www 313: my $n=shift;
314: my @cols=();
315: if ($n) {
316: $cols[0]=$rl{$f{'A'.$n}};
317: } else {
318: $cols[0]='<b><font size=+1>Export</font></b>';
319: }
320: map {
321: my $fm=$f{$_.$n};
322: $fm=~s/[\'\"]/\&\#34;/g;
323: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
324: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 325: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
326: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
327: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 328: return @cols;
329: }
330:
1.14 www 331: sub exportrowa {
332: my $rowa='';
333: map {
334: $rowa.=$v{$_.'0'}."','";
335: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
336: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
337: $rowa=~s/\'\,\'$//;
338: return $rowa;
339: }
340:
1.4 www 341: # ------------------------------------------- End of "Inside of the safe space"
342: ENDDEFS
343: $safeeval->reval($code);
344: return $safeeval;
345: }
346:
347: # ------------------------------------------------ Add or change formula values
348:
349: sub setformulas {
350: my ($safeeval,@f)=@_;
1.6 www 351: $safeeval->reval('%f='."('".join("','",@f)."');");
352: }
353:
354: # ------------------------------------------------ Add or change formula values
355:
356: sub setconstants {
357: my ($safeeval,@c)=@_;
358: $safeeval->reval('%c='."('".join("','",@c)."');");
359: }
360:
361: # ------------------------------------------------ Add or change formula values
362:
363: sub setrowlabels {
364: my ($safeeval,@rl)=@_;
365: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 366: }
367:
368: # ------------------------------------------------------- Calculate spreadsheet
369:
370: sub calcsheet {
371: my $safeeval=shift;
372: $safeeval->reval('&calc();');
373: }
374:
375: # ------------------------------------------------------------------ Get values
376:
377: sub getvalues {
378: my $safeeval=shift;
379: return $safeeval->reval('%v');
380: }
381:
382: # ---------------------------------------------------------------- Get formulas
383:
384: sub getformulas {
385: my $safeeval=shift;
386: return $safeeval->reval('%f');
387: }
388:
1.5 www 389: # -------------------------------------------------------------------- Set type
390:
391: sub settype {
392: my ($safeeval,$type)=@_;
1.11 www 393: $safeeval->reval('$sheettype="'.$type.'";');
1.5 www 394: }
395:
396: # -------------------------------------------------------------------- Get type
397:
398: sub gettype {
399: my $safeeval=shift;
400: return $safeeval->reval('$sheettype');
401: }
1.6 www 402: # ------------------------------------------------------------------ Set maxrow
403:
404: sub setmaxrow {
405: my ($safeeval,$row)=@_;
406: $safeeval->reval('$maxrow='.$row.';');
407: }
408:
409: # ------------------------------------------------------------------ Get maxrow
410:
411: sub getmaxrow {
412: my $safeeval=shift;
413: return $safeeval->reval('$maxrow');
414: }
1.5 www 415:
1.6 www 416: # ---------------------------------------------------------------- Set filename
1.5 www 417:
418: sub setfilename {
419: my ($safeeval,$fn)=@_;
1.11 www 420: $safeeval->reval('$filename="'.$fn.'";');
1.5 www 421: }
422:
1.6 www 423: # ---------------------------------------------------------------- Get filename
1.5 www 424:
425: sub getfilename {
426: my $safeeval=shift;
427: return $safeeval->reval('$filename');
428: }
1.14 www 429:
430: # ------------------------------------------------------------- Export of A-row
431:
432: sub exportrow {
433: my $safeeval=shift;
434: return $safeeval->reval('&exportrowa()');
435: }
436:
1.5 www 437: # ========================================================== End of Spreadsheet
438: # =============================================================================
439:
440:
1.6 www 441: # --------------------------------------------- Produce output row n from sheet
442:
443: sub rown {
444: my ($safeeval,$n)=@_;
1.9 www 445: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 446: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
447: my $showf=0;
1.16 www 448: my $proc;
449: if (&gettype($safeeval) eq 'assesscalc') {
450: $proc='&outrowassess';
451: } else {
452: $proc='&outrow';
453: }
1.6 www 454: map {
1.9 www 455: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 456: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
457: if ($showf==0) { $vl=$_; }
1.9 www 458: if ($showf<=1) { $bgcolor='#FFDDDD'; }
459: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.17 ! www 460: if (($showf>1) || ((!$n) && ($showf>0))) {
1.6 www 461: if ($vl eq '') {
1.9 www 462: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 463: }
464: $rowdata.=
1.10 www 465: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 466: '</a></td>';
467: } else {
1.9 www 468: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 469: }
470: $showf++;
1.16 www 471: } $safeeval->reval($proc.'('.$n.')');
1.6 www 472: return $rowdata.'</tr>';
473: }
474:
475: # ------------------------------------------------------------- Print out sheet
476:
477: sub outsheet {
478: my $safeeval=shift;
1.9 www 479: my $tabledata='<table border=2><tr><td colspan=2> </td>'.
480: '<td bgcolor=#FFDDDD><b>A Import</b></td>';
1.6 www 481: map {
482: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
1.9 www 483: } ('B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 484: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
485: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
486: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 487: $tabledata.='</tr>';
488: my $row;
489: my $maxrow=&getmaxrow($safeeval);
490: for ($row=0;$row<=$maxrow;$row++) {
491: $tabledata.=&rown($safeeval,$row);
492: }
493: $tabledata.='</table>';
494: }
495:
496:
1.5 www 497:
498: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 499:
1.5 www 500: sub readsheet {
1.8 www 501: my ($safeeval,$fn)=@_;
1.5 www 502: &setfilename($safeeval,$fn);
503: $fn=~/\.(\w+)/;
504: &settype($safeeval,$1);
1.4 www 505: my %f=();
1.10 www 506: unless ($spreadsheets{$fn}) {
507: $spreadsheets{$fn}='';
508: {
509: my $fh;
510: if ($fh=Apache::File->new($fn)) {
511: $spreadsheets{$fn}=join('',<$fh>);
512: }
513: }
1.3 www 514: }
515: {
1.10 www 516: my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
1.3 www 517: my $token;
518: while ($token=$parser->get_token) {
519: if ($token->[0] eq 'S') {
520: if ($token->[1] eq 'field') {
521: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
522: $parser->get_text('/field');
523: }
524: }
525: }
526: }
1.5 www 527: &setformulas($safeeval,%f);
1.3 www 528: }
529:
1.10 www 530: # ----------------------------------------------- Make a temp copy of the sheet
531:
532: sub tmpwrite {
1.11 www 533: my ($safeeval,$tmpdir,$symb)=@_;
1.10 www 534: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
535: $fn=~s/\W/\_/g;
536: $fn=$tmpdir.$fn.'.tmp';
537: my $fh;
538: if ($fh=Apache::File->new('>'.$fn)) {
539: print $fh join("\n",&getformulas($safeeval));
540: }
541: }
542:
543: # ---------------------------------------------------------- Read the temp copy
544:
545: sub tmpread {
1.11 www 546: my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
1.10 www 547: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
548: $fn=~s/\W/\_/g;
549: $fn=$tmpdir.$fn.'.tmp';
550: my $fh;
551: my %fo=();
552: if ($fh=Apache::File->new($fn)) {
553: my $name;
554: while ($name=<$fh>) {
555: chomp($name);
556: my $value=<$fh>;
557: chomp($value);
558: $fo{$name}=$value;
559: }
560: }
561: $fo{$nfield}=$nform;
562: &setformulas($safeeval,%fo);
563: }
564:
1.3 www 565: # --------------------------------------------------------------- Read metadata
566:
567: sub readmeta {
568: my $fn=shift;
569: unless ($fn=~/\.meta$/) { $fn.='meta'; }
570: my $content;
571: my %returnhash=();
572: {
573: my $fh=Apache::File->new($fn);
574: $content=join('',<$fh>);
575: }
576: my $parser=HTML::TokeParser->new(\$content);
577: my $token;
578: while ($token=$parser->get_token) {
579: if ($token->[0] eq 'S') {
580: my $entry=$token->[1];
581: if (($entry eq 'stores') || ($entry eq 'parameter')) {
582: my $unikey=$entry;
583: $unikey.='_'.$token->[2]->{'part'};
584: $unikey.='_'.$token->[2]->{'name'};
585: $returnhash{$unikey}=$token->[2]->{'display'};
586: }
587: }
588: }
589: return %returnhash;
590: }
591:
1.11 www 592: # ================================================================== Parameters
593: # -------------------------------------------- Figure out a cascading parameter
594:
595: sub parmval {
596: my ($what,$symb)=@_;
597:
598: unless ($symb) { return ''; }
599: my $result='';
600:
601: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
602: # ----------------------------------------------------- Cascading lookup scheme
1.12 www 603: my $rwhat=$what;
604: $what=~s/^parameter\_//;
605: $what=~s/\_/\./;
1.11 www 606:
607: my $symbparm=$symb.'.'.$what;
608: my $mapparm=$mapname.'___(all).'.$what;
609:
610: my $seclevel=
611: $ENV{'request.course.id'}.'.['.
612: $csec.'].'.$what;
613: my $seclevelr=
614: $ENV{'request.course.id'}.'.['.
615: $csec.'].'.$symbparm;
616: my $seclevelm=
617: $ENV{'request.course.id'}.'.['.
618: $csec.'].'.$mapparm;
619:
620: my $courselevel=
621: $ENV{'request.course.id'}.'.'.$what;
622: my $courselevelr=
623: $ENV{'request.course.id'}.'.'.$symbparm;
624: my $courselevelm=
625: $ENV{'request.course.id'}.'.'.$mapparm;
1.12 www 626:
1.11 www 627: # ---------------------------------------------------------- fourth, check user
628:
629: if ($uname) {
630:
631: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
632:
633: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
634:
635: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
636:
637: }
638:
639: # --------------------------------------------------------- third, check course
640:
641: if ($csec) {
642:
643: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
644:
645: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
646:
647: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
648:
649: }
650:
651: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
652:
653: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
654:
655: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
656:
657: # ----------------------------------------------------- second, check map parms
658:
659: my $thisparm=$parmhash{$symbparm};
660: if ($thisparm) { return $thisparm; }
661:
662: # -------------------------------------------------------- first, check default
663:
1.12 www 664: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
1.11 www 665:
666: }
667:
668:
1.5 www 669: # ----------------------------------------------------------------- Update rows
670:
671: sub updaterows {
672: my $safeeval=shift;
673: my %bighash;
674: # -------------------------------------------------------------------- Tie hash
675: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
676: &GDBM_READER,0640)) {
677: # --------------------------------------------------------- Get all assessments
678:
679: my %allkeys=();
680: my %allassess=();
681:
682: my $stype=&gettype($safeeval);
683:
684: map {
685: if ($_=~/^src\_(\d+)\.(\d+)$/) {
686: my $mapid=$1;
687: my $resid=$2;
688: my $id=$mapid.'.'.$resid;
689: my $srcf=$bighash{$_};
690: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
691: my $symb=
692: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
693: '___'.$resid.'___'.
694: &Apache::lonnet::declutter($srcf);
695: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 696:
1.6 www 697: if ($stype eq 'assesscalc') {
1.5 www 698: map {
1.11 www 699: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
1.5 www 700: my $key=$_;
701: my $display=
702: &Apache::lonnet::metadata($srcf,$key.'.display');
703: unless ($display) {
704: $display=
705: &Apache::lonnet::metadata($srcf,$key.'.name');
706: }
707: $allkeys{$key}=$display;
708: }
709: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
710: }
711: }
712: }
713: } keys %bighash;
714: untie(%bighash);
715:
716: #
1.11 www 717: # %allkeys has a list of storage and parameter displays by unikey
1.5 www 718: # %allassess has a list of all resource displays by symb
719: #
720: # -------------------- Find discrepancies between the course row table and this
721: #
722: my %f=&getformulas($safeeval);
1.6 www 723: my $changed=0;
724:
725: my %current=();
726: if ($stype eq 'assesscalc') {
727: %current=%allkeys;
728: } elsif ($stype eq 'studentcalc') {
729: %current=%allassess;
730: }
731:
732: my $maxrow=0;
733: my %existing=();
734:
735: # ----------------------------------------------------------- Now obsolete rows
1.5 www 736: map {
1.6 www 737: if ($_=~/^A(\d+)/) {
738: $maxrow=($1>$maxrow)?$1:$maxrow;
739: $existing{$f{$_}}=1;
1.17 ! www 740: unless ((defined($current{$f{$_}})) || (!$1)) {
1.6 www 741: $f{$_}='!!! Obsolete';
742: $changed=1;
1.5 www 743: }
744: }
745: } keys %f;
1.6 www 746:
747: # -------------------------------------------------------- New and unknown keys
748:
749: map {
750: unless ($existing{$_}) {
751: $changed=1;
752: $maxrow++;
753: $f{'A'.$maxrow}=$_;
754: }
755: } keys %current;
756:
757: if ($changed) { &setformulas($safeeval,%f); }
758:
759: &setmaxrow($safeeval,$maxrow);
760: &setrowlabels($safeeval,%current);
1.5 www 761:
762: } else {
763: return 'Could not access course data';
764: }
765: }
1.3 www 766:
1.16 www 767: # --------------------------------------------------- Load data for one student
768:
769: sub rowazstudent {
770: my $safeeval=shift;
771: my %c=();
772: my %f=&getformulas($safeeval);
773: map {
1.17 ! www 774: if ($_=~/^A(\d+)/) {
! 775: my $row=$1;
1.16 www 776: unless ($f{$_}=~/^\!/) {
1.17 ! www 777: my @assessdata=split(/\,/,
! 778: &Apache::lonnet::ssi(
1.16 www 779: '/res/msu/korte/junk.assesscalc',('utarget' => 'export',
780: 'uname' => $uname,
781: 'udom' => $udom,
1.17 ! www 782: 'usymb' => $f{$_})));
! 783: my $index=0;
! 784: map {
! 785: $c{$_.$row}=$assessdata[$index];
! 786: print $_.':'.$c{$_.$row}.'<br>';
! 787: $index++;
! 788: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
! 789: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
! 790:
1.16 www 791: }
792: }
793: } keys %f;
794:
795: &setconstants($safeeval,%c);
796: }
797:
1.6 www 798: # ------------------------------------------------ Load data for one assessment
799:
800: sub rowaassess {
1.11 www 801: my ($safeeval,$symb)=@_;
1.6 www 802: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
803: my $namespace;
804: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
1.11 www 805:
806: # ----------------------------------------------------------- Get stored values
807: my $answer=&Apache::lonnet::reply(
1.15 www 808: "restore:$udom:$uname:".
809: &Apache::lonnet::escape($namespace).":".
810: &Apache::lonnet::escape($symb),$uhome);
1.6 www 811: my %returnhash=();
812: map {
813: my ($name,$value)=split(/\=/,$_);
1.11 www 814: $returnhash{&Apache::lonnet::unescape($name)}=
815: &Apache::lonnet::unescape($value);
1.6 www 816: } split(/\&/,$answer);
817: my $version;
818: for ($version=1;$version<=$returnhash{'version'};$version++) {
819: map {
820: $returnhash{$_}=$returnhash{$version.':'.$_};
821: } split(/\:/,$returnhash{$version.':keys'});
822: }
1.11 www 823: # ----------------------------- returnhash now has all stores for this resource
824:
825: # ---------------------------- initialize coursedata and userdata for this user
826: %courseopt=();
827: %useropt=();
828: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
829: unless ($uhome eq 'no_host') {
830: # -------------------------------------------------------------- Get coursedata
1.13 www 831: unless
832: ((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
1.11 www 833: my $reply=&Apache::lonnet::reply('dump:'.
834: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
835: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
836: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
837: if ($reply!~/^error\:/) {
838: $courserdatas{$ENV{'request.course.id'}}=$reply;
1.13 www 839: $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
1.11 www 840: }
841: }
842: map {
843: my ($name,$value)=split(/\=/,$_);
844: $courseopt{&Apache::lonnet::unescape($name)}=
845: &Apache::lonnet::unescape($value);
846: } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
847: # --------------------------------------------------- Get userdata (if present)
1.13 www 848: unless
849: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
1.11 www 850: my $reply=
851: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
852: if ($reply!~/^error\:/) {
853: $userrdatas{$uname.'___'.$udom}=$reply;
1.13 www 854: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
1.11 www 855: }
856: }
857: map {
858: my ($name,$value)=split(/\=/,$_);
859: $useropt{&Apache::lonnet::unescape($name)}=
1.15 www 860: &Apache::lonnet::unescape($value);
1.11 www 861: } split(/\&/,$userrdatas{$uname.'___'.$udom});
862: }
863: # -- now courseopt, useropt initialized for this user and course (used parmval)
1.6 www 864:
865: my %c=();
866: my %f=&getformulas($safeeval);
867: map {
868: if ($_=~/^A/) {
869: unless ($f{$_}=~/^\!/) {
1.11 www 870: if ($f{$_}=~/^parameter/) {
871: $c{$_}=&parmval($f{$_},$symb);
872: } else {
1.15 www 873: my $key=$f{$_};
874: $key=~s/^stores\_/resource\./;
875: $key=~s/\_/\./;
876: $c{$_}=$returnhash{$key};
1.11 www 877: }
878: }
1.6 www 879: }
880: } keys %f;
1.11 www 881:
1.6 www 882: &setconstants($safeeval,%c);
883: }
884:
1.10 www 885: # --------------------------------------------------------- Various form fields
886:
887: sub textfield {
888: my ($title,$name,$value)=@_;
889: return "\n<p><b>$title:</b><br>".
890: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
891: }
892:
893: sub hiddenfield {
894: my ($name,$value)=@_;
895: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
896: }
897:
898: sub selectbox {
899: my ($title,$name,$value,%options)=@_;
900: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
901: map {
902: $selout.='<option value="'.$_.'"';
903: if ($_ eq $value) { $selout.=' selected'; }
904: $selout.='>'.$options{$_}.'</option>';
905: } sort keys %options;
906: return $selout.'</select>';
907: }
908:
1.12 www 909: # ================================================================ Main handler
1.3 www 910:
911: sub handler {
1.7 www 912: my $r=shift;
913:
1.11 www 914: $uname='';
915: $udom='';
916: $csec='';
917:
1.7 www 918: if ($r->header_only) {
919: $r->content_type('text/html');
920: $r->send_http_header;
921: return OK;
922: }
1.3 www 923:
1.7 www 924: # ----------------------------------------------------- Needs to be in a course
1.3 www 925:
1.7 www 926: if (($ENV{'request.course.fn'}) ||
927: ($ENV{'request.state'} eq 'construct')) {
1.10 www 928:
929: # --------------------------- Get query string for limited number of parameters
1.17 ! www 930:
1.10 www 931: map {
932: my ($name, $value) = split(/=/,$_);
933: $value =~ tr/+/ /;
934: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.11 www 935: if (($name eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
1.10 www 936: unless ($ENV{'form.'.$name}) {
937: $ENV{'form.'.$name}=$value;
938: }
939: }
940: } (split(/&/,$ENV{'QUERY_STRING'}));
941:
942: # ------------------------------------------- Nothing there? Must be login user
943:
944: unless ($ENV{'form.uname'}) {
1.11 www 945: $uname=$ENV{'user.name'};
946: $udom=$ENV{'user.domain'};
947: } else {
948: $uname=$ENV{'form.uname'};
949: $udom=$ENV{'form.udom'};
1.10 www 950: }
1.14 www 951: # ----------------------------------------------------------- Change of target?
952:
1.16 www 953: my $reroute=($ENV{'form.utarget'} eq 'export');
1.14 www 954:
1.10 www 955: # ------------------------------------------------------------------- Open page
956:
1.7 www 957: $r->content_type('text/html');
1.11 www 958: $r->header_out('Cache-control','no-cache');
959: $r->header_out('Pragma','no-cache');
1.7 www 960: $r->send_http_header;
1.3 www 961:
1.14 www 962: # --------------------------------------------------------------- Screen output
963:
964: unless ($reroute) {
1.10 www 965: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
966: $r->print(<<ENDSCRIPT);
967: <script language="JavaScript">
968:
969: function celledit(cn,cf) {
970: var cnf=prompt(cn,cf);
971: if (cnf!=null) {
972: document.sheet.unewfield.value=cn;
973: document.sheet.unewformula.value=cnf;
974: document.sheet.submit();
975: }
976: }
977:
978: </script>
979: ENDSCRIPT
980: $r->print('</head><body bgcolor="#FFFFFF">'.
981: '<form action="'.$r->uri.'" name=sheet method=post>'.
982: &hiddenfield('uname',$ENV{'form.uname'}).
983: &hiddenfield('udom',$ENV{'form.udom'}).
984: &hiddenfield('usymb',$ENV{'form.usymb'}).
985: &hiddenfield('unewfield','').
986: &hiddenfield('unewformula',''));
1.14 www 987: }
988:
989: # ---------------------------------------- Read new sheet or modified worksheet
990:
1.4 www 991: my $sheetone=initsheet();
1.10 www 992: if ($ENV{'form.unewfield'}) {
993: $r->print('<h2>Modified Workcopy</h2>');
994: $ENV{'form.unewformula'}=~s/\'/\"/g;
995: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
996: $ENV{'form.unewformula'}.'<br>');
1.17 ! www 997: &setfilename($sheetone,$r->filename);
! 998: $r->filename=~/\.(\w+)/;
! 999: &settype($sheetone,$1);
1.10 www 1000: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1.11 www 1001: $ENV{'form.usymb'},
1.10 www 1002: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
1.11 www 1003: } else {
1004: &readsheet($sheetone,$r->filename);
1005: }
1.14 www 1006:
1007: # --------------------------------------------- See if all import rows uptodate
1008:
1.11 www 1009: if (tie(%parmhash,'GDBM_File',
1010: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
1011: $csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
1012: if ($csec eq '-1') {
1013: $r->print('<h3><font color=red>'.
1014: "User '$uname' at domain '$udom' not a student in this course</font></h3>");
1015: }
1016: &updaterows($sheetone);
1017: untie(%parmhash);
1.10 www 1018: } else {
1.11 www 1019: $r->print('<h3><font color=red>'.
1020: 'Could not initialize import fields (not in a course)</font></h3>');
1021: }
1.14 www 1022:
1023: # ------------------------------------------------ Write the modified worksheet
1024:
1.11 www 1025: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
1026: $ENV{'form.usymb'});
1.14 www 1027:
1028: # ----------------------------------------------------- Print user, course, etc
1029: unless ($reroute) {
1.11 www 1030: $r->print("<b>User '$uname' at domain '$udom' for '".
1031: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
1032: if ($csec) {
1033: $r->print(", group/section '$csec'");
1034: }
1035: $r->print("</b>\n");
1.14 www 1036: }
1037: # -------------------------------------------------------- Import and calculate
1038:
1.11 www 1039: if (&gettype($sheetone) eq 'assesscalc') {
1040: &rowaassess($sheetone,$ENV{'form.usymb'});
1.16 www 1041: } elsif (&gettype($sheetone) eq 'studentcalc') {
1042: &rowazstudent($sheetone);
1.10 www 1043: }
1.6 www 1044: &calcsheet($sheetone);
1.14 www 1045:
1046: # ------------------------------------------------------- Print or export sheet
1047: unless ($reroute) {
1.6 www 1048: $r->print(&outsheet($sheetone));
1.8 www 1049:
1.10 www 1050: $r->print('</form></body></html>');
1.14 www 1051: } else {
1052: $r->print(&exportrow($sheetone));
1053: }
1054: # ------------------------------------------------------------------------ Done
1.7 www 1055: } else {
1056: # ----------------------------- Not in a course, or not allowed to modify parms
1057: $ENV{'user.error.msg'}=
1058: $r->uri.":opa:0:0:Cannot modify spreadsheet";
1059: return HTTP_NOT_ACCEPTABLE;
1060: }
1.3 www 1061: return OK;
1.1 www 1062: }
1063:
1064: 1;
1065: __END__
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
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