Annotation of loncom/interface/lonspreadsheet.pm, revision 1.10
1.1 www 1: # The LearningOnline Network with CAPA
2: # Spreadsheet/Grades Display Handler
3: #
1.10 ! www 4: # 11/11,11/15,11/27,12/04,12/05,12/06,12/07,12/08,12/09 Gerd Kortemeyer
1.1 www 5:
6: package Apache::lonspreadsheet;
7:
8: use strict;
1.10 ! www 9: use vars qw(%spreadsheets);
1.1 www 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.5 www 18: # =============================================================================
19: # ===================================== Implements an instance of a spreadsheet
1.4 www 20:
21: sub initsheet {
22: my $safeeval = new Safe;
23: my $safehole = new Safe::Hole;
24: $safeeval->permit("entereval");
25: $safeeval->permit(":base_math");
26: $safeeval->permit("sort");
27: $safeeval->deny(":base_io");
28: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
29: my $code=<<'ENDDEFS';
30: # ---------------------------------------------------- Inside of the safe space
31:
1.3 www 32: #
33: # f: formulas
1.4 www 34: # t: intermediate format (variable references expanded)
35: # v: output values
1.6 www 36: # c: preloaded constants (A-column)
37: # rl: row label
1.3 www 38:
1.4 www 39: %v=();
40: %t=();
41: %f=();
1.6 www 42: %c=();
43: %rl=();
44:
45: $maxrow=0;
1.5 www 46: $sheettype='';
47: $filename='';
1.1 www 48:
49: sub mask {
50: my ($lower,$upper)=@_;
51:
1.7 www 52: $lower=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 53: my $la=$1;
54: my $ld=$2;
55:
1.7 www 56: $upper=~/([A-Za-z]|\*)(\d+|\*)/;
1.1 www 57: my $ua=$1;
58: my $ud=$2;
59: my $alpha='';
60: my $num='';
61:
62: if (($la eq '*') || ($ua eq '*')) {
1.7 www 63: $alpha='[A-Za-z]';
1.1 www 64: } else {
1.7 www 65: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
66: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
67: $alpha='['.$la.'-'.$ua.']';
68: } else {
69: $alpha='['.$la.'-Za-'.$ua.']';
70: }
1.1 www 71: }
72:
73: if (($ld eq '*') || ($ud eq '*')) {
74: $num='\d+';
75: } else {
76: if (length($ld)!=length($ud)) {
77: $num.='(';
78: map {
79: $num.='['.$_.'-9]';
80: } ($ld=~m/\d/g);
81: if (length($ud)-length($ld)>1) {
82: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
83: }
84: $num.='|';
85: map {
86: $num.='[0-'.$_.']';
87: } ($ud=~m/\d/g);
88: $num.=')';
89: } else {
90: my @lda=($ld=~m/\d/g);
91: my @uda=($ud=~m/\d/g);
1.7 www 92: my $i; $j=0; $notdone=1;
93: for ($i=0;($i<=$#lda)&&($notdone);$i++) {
1.1 www 94: if ($lda[$i]==$uda[$i]) {
95: $num.=$lda[$i];
96: $j=$i;
1.7 www 97: } else {
98: $notdone=0;
1.1 www 99: }
100: }
101: if ($j<$#lda-1) {
102: $num.='('.$lda[$j+1];
103: for ($i=$j+2;$i<=$#lda;$i++) {
104: $num.='['.$lda[$i].'-9]';
105: }
106: if ($uda[$j+1]-$lda[$j+1]>1) {
107: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
108: ($#lda-$j-1).'}';
109: }
110: $num.='|'.$uda[$j+1];
111: for ($i=$j+2;$i<=$#uda;$i++) {
112: $num.='[0-'.$uda[$i].']';
113: }
114: $num.=')';
115: } else {
1.7 www 116: if ($lda[$#lda]!=$uda[$#uda]) {
117: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
118: }
1.1 www 119: }
120: }
121: }
1.4 www 122: return '^'.$alpha.$num."\$";
1.1 www 123: }
124:
125: sub NUM {
126: my $mask=mask(@_);
127: my $num=0;
128: map {
129: $num++;
130: } grep /$mask/,keys %v;
131: return $num;
132: }
133:
134: sub BIN {
135: my ($low,$high,$lower,$upper)=@_;
136: my $mask=mask($lower,$upper);
137: my $num=0;
138: map {
139: if (($v{$_}>=$low) && ($v{$_}<=$high)) {
140: $num++;
141: }
142: } grep /$mask/,keys %v;
143: return $num;
144: }
145:
146:
147: sub SUM {
148: my $mask=mask(@_);
149: my $sum=0;
150: map {
151: $sum+=$v{$_};
152: } grep /$mask/,keys %v;
153: return $sum;
154: }
155:
156: sub MEAN {
157: my $mask=mask(@_);
158: my $sum=0; my $num=0;
159: map {
160: $sum+=$v{$_};
161: $num++;
162: } grep /$mask/,keys %v;
163: if ($num) {
164: return $sum/$num;
165: } else {
166: return undef;
167: }
168: }
169:
170: sub STDDEV {
171: my $mask=mask(@_);
172: my $sum=0; my $num=0;
173: map {
174: $sum+=$v{$_};
175: $num++;
176: } grep /$mask/,keys %v;
177: unless ($num>1) { return undef; }
178: my $mean=$sum/$num;
179: $sum=0;
180: map {
181: $sum+=($v{$_}-$mean)**2;
182: } grep /$mask/,keys %v;
183: return sqrt($sum/($num-1));
184: }
185:
186: sub PROD {
187: my $mask=mask(@_);
188: my $prod=1;
189: map {
190: $prod*=$v{$_};
191: } grep /$mask/,keys %v;
192: return $prod;
193: }
194:
195: sub MAX {
196: my $mask=mask(@_);
197: my $max='-';
198: map {
199: unless ($max) { $max=$v{$_}; }
200: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
201: } grep /$mask/,keys %v;
202: return $max;
203: }
204:
205: sub MIN {
206: my $mask=mask(@_);
207: my $min='-';
208: map {
209: unless ($max) { $max=$v{$_}; }
210: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
211: } grep /$mask/,keys %v;
212: return $min;
213: }
214:
215: sub SUMMAX {
216: my ($num,$lower,$upper)=@_;
217: my $mask=mask($lower,$upper);
218: my @inside=();
219: map {
220: $inside[$#inside+1]=$v{$_};
221: } grep /$mask/,keys %v;
222: @inside=sort(@inside);
223: my $sum=0; my $i;
224: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
225: $sum+=$inside[$i];
226: }
227: return $sum;
228: }
229:
230: sub SUMMIN {
231: my ($num,$lower,$upper)=@_;
232: my $mask=mask($lower,$upper);
233: my @inside=();
234: map {
235: $inside[$#inside+1]=$v{$_};
236: } grep /$mask/,keys %v;
237: @inside=sort(@inside);
238: my $sum=0; my $i;
239: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
240: $sum+=$inside[$i];
241: }
242: return $sum;
243: }
244:
245: sub sett {
246: %t=();
247: map {
248: if ($f{$_}) {
1.6 www 249: if ($_=~/^A/) {
250: unless ($f{$_}=~/^\!/) {
251: $t{$_}=$c{$_};
252: }
253: } else {
254: $t{$_}=$f{$_};
1.7 www 255: $t{$_}=~s/\.\.+/\,/g;
256: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
1.6 www 257: }
1.1 www 258: }
259: } keys %f;
260: }
261:
1.4 www 262: sub calc {
1.1 www 263: %v=();
1.4 www 264: &sett();
1.1 www 265: my $notfinished=1;
266: my $depth=0;
267: while ($notfinished) {
268: $notfinished=0;
269: map {
270: my $old=$v{$_};
1.4 www 271: $v{$_}=eval($t{$_});
1.1 www 272: if ($@) {
273: %v=();
274: return $@;
275: }
276: if ($v{$_} ne $old) { $notfinished=1; }
277: } keys %t;
278: $depth++;
279: if ($depth>100) {
280: %v=();
281: return 'Maximum calculation depth exceeded';
282: }
283: }
284: return '';
285: }
286:
1.6 www 287: sub outrow {
288: my $n=shift;
289: my @cols=();
290: if ($n) {
291: $cols[0]=$rl{$f{'A'.$n}};
292: } else {
293: $cols[0]='<b><font size=+1>Export</font></b>';
294: }
295: map {
296: my $fm=$f{$_.$n};
297: $fm=~s/[\'\"]/\&\#34;/g;
298: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
299: } ('A','B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 300: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
301: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
302: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 303: return @cols;
304: }
305:
1.4 www 306: # ------------------------------------------- End of "Inside of the safe space"
307: ENDDEFS
308: $safeeval->reval($code);
309: return $safeeval;
310: }
311:
312: # ------------------------------------------------ Add or change formula values
313:
314: sub setformulas {
315: my ($safeeval,@f)=@_;
1.6 www 316: $safeeval->reval('%f='."('".join("','",@f)."');");
317: }
318:
319: # ------------------------------------------------ Add or change formula values
320:
321: sub setconstants {
322: my ($safeeval,@c)=@_;
323: $safeeval->reval('%c='."('".join("','",@c)."');");
324: }
325:
326: # ------------------------------------------------ Add or change formula values
327:
328: sub setrowlabels {
329: my ($safeeval,@rl)=@_;
330: $safeeval->reval('%rl='."('".join("','",@rl)."');");
1.4 www 331: }
332:
333: # ------------------------------------------------------- Calculate spreadsheet
334:
335: sub calcsheet {
336: my $safeeval=shift;
337: $safeeval->reval('&calc();');
338: }
339:
340: # ------------------------------------------------------------------ Get values
341:
342: sub getvalues {
343: my $safeeval=shift;
344: return $safeeval->reval('%v');
345: }
346:
347: # ---------------------------------------------------------------- Get formulas
348:
349: sub getformulas {
350: my $safeeval=shift;
351: return $safeeval->reval('%f');
352: }
353:
1.5 www 354: # -------------------------------------------------------------------- Set type
355:
356: sub settype {
357: my ($safeeval,$type)=@_;
358: $safeeval->reval('$sheettype='.$type.';');
359: }
360:
361: # -------------------------------------------------------------------- Get type
362:
363: sub gettype {
364: my $safeeval=shift;
365: return $safeeval->reval('$sheettype');
366: }
1.6 www 367: # ------------------------------------------------------------------ Set maxrow
368:
369: sub setmaxrow {
370: my ($safeeval,$row)=@_;
371: $safeeval->reval('$maxrow='.$row.';');
372: }
373:
374: # ------------------------------------------------------------------ Get maxrow
375:
376: sub getmaxrow {
377: my $safeeval=shift;
378: return $safeeval->reval('$maxrow');
379: }
1.5 www 380:
1.6 www 381: # ---------------------------------------------------------------- Set filename
1.5 www 382:
383: sub setfilename {
384: my ($safeeval,$fn)=@_;
385: $safeeval->reval('$filename='.$fn.';');
386: }
387:
1.6 www 388: # ---------------------------------------------------------------- Get filename
1.5 www 389:
390: sub getfilename {
391: my $safeeval=shift;
392: return $safeeval->reval('$filename');
393: }
394:
395: # ========================================================== End of Spreadsheet
396: # =============================================================================
397:
398:
1.6 www 399: # --------------------------------------------- Produce output row n from sheet
400:
401: sub rown {
402: my ($safeeval,$n)=@_;
1.9 www 403: my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
1.6 www 404: my $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
405: my $showf=0;
406: map {
1.9 www 407: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
1.6 www 408: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
409: if ($showf==0) { $vl=$_; }
1.9 www 410: if ($showf<=1) { $bgcolor='#FFDDDD'; }
411: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
1.6 www 412: if ($showf>1) {
413: if ($vl eq '') {
1.9 www 414: $vl='<font size=+2 color='.$bgcolor.'>#</font>';
1.6 www 415: }
416: $rowdata.=
1.10 ! www 417: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
1.6 www 418: '</a></td>';
419: } else {
1.9 www 420: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
1.6 www 421: }
422: $showf++;
423: } $safeeval->reval('&outrow('.$n.')');
424: return $rowdata.'</tr>';
425: }
426:
427: # ------------------------------------------------------------- Print out sheet
428:
429: sub outsheet {
430: my $safeeval=shift;
1.9 www 431: my $tabledata='<table border=2><tr><td colspan=2> </td>'.
432: '<td bgcolor=#FFDDDD><b>A Import</b></td>';
1.6 www 433: map {
434: $tabledata.="<td><b><font size=+1>$_</font></b></td>";
1.9 www 435: } ('B','C','D','E','F','G','H','I','J','K','L','M',
1.7 www 436: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
437: 'a','b','c','d','e','f','g','h','i','j','k','l','m',
438: 'n','o','p','q','r','s','t','u','v','w','x','y','z');
1.6 www 439: $tabledata.='</tr>';
440: my $row;
441: my $maxrow=&getmaxrow($safeeval);
442: for ($row=0;$row<=$maxrow;$row++) {
443: $tabledata.=&rown($safeeval,$row);
444: }
445: $tabledata.='</table>';
446: }
447:
448:
1.5 www 449:
450: # --------------------------------------- Read spreadsheet formulas from a file
1.3 www 451:
1.5 www 452: sub readsheet {
1.8 www 453: my ($safeeval,$fn)=@_;
1.5 www 454: &setfilename($safeeval,$fn);
455: $fn=~/\.(\w+)/;
456: &settype($safeeval,$1);
1.4 www 457: my %f=();
1.10 ! www 458: unless ($spreadsheets{$fn}) {
! 459: $spreadsheets{$fn}='';
! 460: {
! 461: my $fh;
! 462: if ($fh=Apache::File->new($fn)) {
! 463: $spreadsheets{$fn}=join('',<$fh>);
! 464: }
! 465: }
1.3 www 466: }
467: {
1.10 ! www 468: my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
1.3 www 469: my $token;
470: while ($token=$parser->get_token) {
471: if ($token->[0] eq 'S') {
472: if ($token->[1] eq 'field') {
473: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
474: $parser->get_text('/field');
475: }
476: }
477: }
478: }
1.5 www 479: &setformulas($safeeval,%f);
1.3 www 480: }
481:
1.10 ! www 482: # ----------------------------------------------- Make a temp copy of the sheet
! 483:
! 484: sub tmpwrite {
! 485: my ($safeeval,$tmpdir,$uname,$udom,$symb)=@_;
! 486: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
! 487: $fn=~s/\W/\_/g;
! 488: $fn=$tmpdir.$fn.'.tmp';
! 489: my $fh;
! 490: if ($fh=Apache::File->new('>'.$fn)) {
! 491: print $fh join("\n",&getformulas($safeeval));
! 492: }
! 493: }
! 494:
! 495: # ---------------------------------------------------------- Read the temp copy
! 496:
! 497: sub tmpread {
! 498: my ($safeeval,$tmpdir,$uname,$udom,$symb,$nfield,$nform)=@_;
! 499: my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
! 500: $fn=~s/\W/\_/g;
! 501: $fn=$tmpdir.$fn.'.tmp';
! 502: my $fh;
! 503: my %fo=();
! 504: if ($fh=Apache::File->new($fn)) {
! 505: my $name;
! 506: while ($name=<$fh>) {
! 507: chomp($name);
! 508: my $value=<$fh>;
! 509: chomp($value);
! 510: $fo{$name}=$value;
! 511: }
! 512: }
! 513: $fo{$nfield}=$nform;
! 514: &setformulas($safeeval,%fo);
! 515: }
! 516:
1.3 www 517: # --------------------------------------------------------------- Read metadata
518:
519: sub readmeta {
520: my $fn=shift;
521: unless ($fn=~/\.meta$/) { $fn.='meta'; }
522: my $content;
523: my %returnhash=();
524: {
525: my $fh=Apache::File->new($fn);
526: $content=join('',<$fh>);
527: }
528: my $parser=HTML::TokeParser->new(\$content);
529: my $token;
530: while ($token=$parser->get_token) {
531: if ($token->[0] eq 'S') {
532: my $entry=$token->[1];
533: if (($entry eq 'stores') || ($entry eq 'parameter')) {
534: my $unikey=$entry;
535: $unikey.='_'.$token->[2]->{'part'};
536: $unikey.='_'.$token->[2]->{'name'};
537: $returnhash{$unikey}=$token->[2]->{'display'};
538: }
539: }
540: }
541: return %returnhash;
542: }
543:
1.5 www 544: # ----------------------------------------------------------------- Update rows
545:
546: sub updaterows {
547: my $safeeval=shift;
548: my %bighash;
549: # -------------------------------------------------------------------- Tie hash
550: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
551: &GDBM_READER,0640)) {
552: # --------------------------------------------------------- Get all assessments
553:
554: my %allkeys=();
555: my %allassess=();
556:
557: my $stype=&gettype($safeeval);
558:
559: map {
560: if ($_=~/^src\_(\d+)\.(\d+)$/) {
561: my $mapid=$1;
562: my $resid=$2;
563: my $id=$mapid.'.'.$resid;
564: my $srcf=$bighash{$_};
565: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
566: my $symb=
567: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
568: '___'.$resid.'___'.
569: &Apache::lonnet::declutter($srcf);
570: $allassess{$symb}=$bighash{'title_'.$id};
1.8 www 571:
1.6 www 572: if ($stype eq 'assesscalc') {
1.5 www 573: map {
574: if ($_=~/^stores\_(.*)/) {
575: my $key=$_;
576: my $display=
577: &Apache::lonnet::metadata($srcf,$key.'.display');
578: unless ($display) {
579: $display=
580: &Apache::lonnet::metadata($srcf,$key.'.name');
581: }
1.8 www 582:
583:
1.5 www 584: $allkeys{$key}=$display;
585: }
586: } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
587: }
588: }
589: }
590: } keys %bighash;
591: untie(%bighash);
592:
593: #
594: # %allkeys has a list of storage displays by unikey
595: # %allassess has a list of all resource displays by symb
596: #
597: # -------------------- Find discrepancies between the course row table and this
598: #
599: my %f=&getformulas($safeeval);
1.6 www 600: my $changed=0;
601:
602: my %current=();
603: if ($stype eq 'assesscalc') {
604: %current=%allkeys;
605: } elsif ($stype eq 'studentcalc') {
606: %current=%allassess;
607: }
608:
609: my $maxrow=0;
610: my %existing=();
611:
612: # ----------------------------------------------------------- Now obsolete rows
1.5 www 613: map {
1.6 www 614: if ($_=~/^A(\d+)/) {
615: $maxrow=($1>$maxrow)?$1:$maxrow;
616: $existing{$f{$_}}=1;
617: unless (defined($current{$f{$_}})) {
618: $f{$_}='!!! Obsolete';
619: $changed=1;
1.5 www 620: }
621: }
622: } keys %f;
1.6 www 623:
624: # -------------------------------------------------------- New and unknown keys
625:
626: map {
627: unless ($existing{$_}) {
628: $changed=1;
629: $maxrow++;
630: $f{'A'.$maxrow}=$_;
631: }
632: } keys %current;
633:
634: if ($changed) { &setformulas($safeeval,%f); }
635:
636: &setmaxrow($safeeval,$maxrow);
637: &setrowlabels($safeeval,%current);
1.5 www 638:
639: } else {
640: return 'Could not access course data';
641: }
642: }
1.3 www 643:
1.6 www 644: # ------------------------------------------------ Load data for one assessment
645:
646: sub rowaassess {
647: my ($safeeval,$uname,$udom,$symb)=@_;
648: my $uhome=&Apache::lonnet::homeserver($uname,$udom);
649: my $namespace;
650: unless ($namespace=$ENV{'request.course.id'}) { return ''; }
651: my $answer=reply("restore:$udom:$uname:$namespace:$symb",$uhome);
652: my %returnhash=();
653: map {
654: my ($name,$value)=split(/\=/,$_);
655: $returnhash{&unescape($name)}=&unescape($value);
656: } split(/\&/,$answer);
657: my $version;
658: for ($version=1;$version<=$returnhash{'version'};$version++) {
659: map {
660: $returnhash{$_}=$returnhash{$version.':'.$_};
661: } split(/\:/,$returnhash{$version.':keys'});
662: }
663:
664: my %c=();
665: my %f=&getformulas($safeeval);
666: map {
667: if ($_=~/^A/) {
668: unless ($f{$_}=~/^\!/) {
669: $c{$_}=$returnhash{$f{$_}};
670: }
671: }
672: } keys %f;
673: &setconstants($safeeval,%c);
674: }
675:
1.10 ! www 676: # --------------------------------------------------------- Various form fields
! 677:
! 678: sub textfield {
! 679: my ($title,$name,$value)=@_;
! 680: return "\n<p><b>$title:</b><br>".
! 681: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
! 682: }
! 683:
! 684: sub hiddenfield {
! 685: my ($name,$value)=@_;
! 686: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
! 687: }
! 688:
! 689: sub selectbox {
! 690: my ($title,$name,$value,%options)=@_;
! 691: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
! 692: map {
! 693: $selout.='<option value="'.$_.'"';
! 694: if ($_ eq $value) { $selout.=' selected'; }
! 695: $selout.='>'.$options{$_}.'</option>';
! 696: } sort keys %options;
! 697: return $selout.'</select>';
! 698: }
! 699:
! 700: # ---------------------------------------------------------------- Main handler
1.3 www 701:
702: sub handler {
1.7 www 703: my $r=shift;
704:
705: if ($r->header_only) {
706: $r->content_type('text/html');
707: $r->send_http_header;
708: return OK;
709: }
1.3 www 710:
1.7 www 711: # ----------------------------------------------------- Needs to be in a course
1.3 www 712:
1.7 www 713: if (($ENV{'request.course.fn'}) ||
714: ($ENV{'request.state'} eq 'construct')) {
1.10 ! www 715:
! 716: # --------------------------- Get query string for limited number of parameters
! 717: map {
! 718: my ($name, $value) = split(/=/,$_);
! 719: $value =~ tr/+/ /;
! 720: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
! 721: if (($name='uname') || ($name='udom') || ($name='usymb')) {
! 722: unless ($ENV{'form.'.$name}) {
! 723: $ENV{'form.'.$name}=$value;
! 724: }
! 725: }
! 726: } (split(/&/,$ENV{'QUERY_STRING'}));
! 727:
! 728: # ------------------------------------------- Nothing there? Must be login user
! 729:
! 730: unless ($ENV{'form.uname'}) {
! 731: $ENV{'form.uname'}=$ENV{'user.name'};
! 732: $ENV{'form.udom'}=$ENV{'user.domain'};
! 733: }
! 734: # ------------------------------------------------------------------- Open page
! 735:
1.7 www 736: $r->content_type('text/html');
737: $r->send_http_header;
1.3 www 738:
1.10 ! www 739: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
! 740: $r->print(<<ENDSCRIPT);
! 741: <script language="JavaScript">
! 742:
! 743: function celledit(cn,cf) {
! 744: var cnf=prompt(cn,cf);
! 745: if (cnf!=null) {
! 746: document.sheet.unewfield.value=cn;
! 747: document.sheet.unewformula.value=cnf;
! 748: document.sheet.submit();
! 749: }
! 750: }
! 751:
! 752: </script>
! 753: ENDSCRIPT
! 754: $r->print('</head><body bgcolor="#FFFFFF">'.
! 755: '<form action="'.$r->uri.'" name=sheet method=post>'.
! 756: &hiddenfield('uname',$ENV{'form.uname'}).
! 757: &hiddenfield('udom',$ENV{'form.udom'}).
! 758: &hiddenfield('usymb',$ENV{'form.usymb'}).
! 759: &hiddenfield('unewfield','').
! 760: &hiddenfield('unewformula',''));
1.4 www 761: my $sheetone=initsheet();
1.10 ! www 762: if ($ENV{'form.unewfield'}) {
! 763: $r->print('<h2>Modified Workcopy</h2>');
! 764: $ENV{'form.unewformula'}=~s/\'/\"/g;
! 765: $r->print('New formula: '.$ENV{'form.unewfield'}.'='.
! 766: $ENV{'form.unewformula'}.'<br>');
! 767: &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
! 768: $ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'},
! 769: $ENV{'form.unewfield'},$ENV{'form.unewformula'});
! 770: &setfilename($sheetone,$r->filename);
! 771: $r->filename=~/\.(\w+)/;
! 772: &settype($sheetone,$1);
! 773: } else {
! 774: &readsheet($sheetone,$r->filename);
! 775: }
1.8 www 776: &updaterows($sheetone);
1.10 ! www 777: &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
! 778: $ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'});
1.6 www 779: &calcsheet($sheetone);
780: $r->print(&outsheet($sheetone));
1.8 www 781:
1.10 ! www 782: $r->print('</form></body></html>');
1.7 www 783:
784: } else {
785: # ----------------------------- Not in a course, or not allowed to modify parms
786: $ENV{'user.error.msg'}=
787: $r->uri.":opa:0:0:Cannot modify spreadsheet";
788: return HTTP_NOT_ACCEPTABLE;
789: }
1.3 www 790: return OK;
1.1 www 791: }
792:
793: 1;
794: __END__
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
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