loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.103: download - view: text, annotated - select for diffs
Thu Aug 29 15:35:01 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Added MINPARM and MAXPARM, which return minimum and maximum values associated
with a parameter name.  Invoke as follows: localtime(MINPARM('duedate'));
Note, these functions do regular expression matches of their inputs on the
parameters available in a spreadsheet, not any string substitutioni, as in
the EXPANDSUM function.

1: # 2: # $Id: lonspreadsheet.pm,v 1.103 2002/08/29 15:35:01 matthew Exp $ 3: # 4: # Copyright Michigan State University Board of Trustees 5: # 6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 7: # 8: # LON-CAPA is free software; you can redistribute it and/or modify 9: # it under the terms of the GNU General Public License as published by 10: # the Free Software Foundation; either version 2 of the License, or 11: # (at your option) any later version. 12: # 13: # LON-CAPA is distributed in the hope that it will be useful, 14: # but WITHOUT ANY WARRANTY; without even the implied warranty of 15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16: # GNU General Public License for more details. 17: # 18: # You should have received a copy of the GNU General Public License 19: # along with LON-CAPA; if not, write to the Free Software 20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21: # 22: # /home/httpd/html/adm/gpl.txt 23: # 24: # http://www.lon-capa.org/ 25: # 26: # The LearningOnline Network with CAPA 27: # Spreadsheet/Grades Display Handler 28: # 29: # 11/11,11/15,11/27,12/04,12/05,12/06,12/07, 30: # 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30, 31: # 01/01/01,02/01,03/01,19/01,20/01,22/01, 32: # 03/05,03/08,03/10,03/12,03/13,03/15,03/17, 33: # 03/19,03/20,03/21,03/27,04/05,04/09, 34: # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17, 35: # 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer 36: # 01/14/02 Matthew 37: # 02/04/02 Matthew 38: 39: # POD required stuff: 40: 41: =head1 NAME 42: 43: lonspreadsheet 44: 45: =head1 SYNOPSIS 46: 47: Spreadsheet interface to internal LON-CAPA data 48: 49: =head1 DESCRIPTION 50: 51: Lonspreadsheet provides course coordinators the ability to manage their 52: students grades online. The students are able to view their own grades, but 53: not the grades of their peers. The spreadsheet is highly customizable, 54: offering the ability to use Perl code to manipulate data, as well as many 55: built-in functions. 56: 57: 58: =head2 Functions available to user of lonspreadsheet 59: 60: =over 4 61: 62: =cut 63: 64: package Apache::lonspreadsheet; 65: 66: use strict; 67: use Safe; 68: use Safe::Hole; 69: use Opcode; 70: use Apache::lonnet; 71: use Apache::Constants qw(:common :http); 72: use GDBM_File; 73: use HTML::TokeParser; 74: use Apache::lonhtmlcommon; 75: # 76: # Caches for previously calculated spreadsheets 77: # 78: 79: my %oldsheets; 80: my %loadedcaches; 81: my %expiredates; 82: 83: # 84: # Cache for stores of an individual user 85: # 86: 87: my $cachedassess; 88: my %cachedstores; 89: 90: # 91: # These cache hashes need to be independent of user, resource and course 92: # (user and course can/should be in the keys) 93: # 94: 95: my %spreadsheets; 96: my %courserdatas; 97: my %userrdatas; 98: my %defaultsheets; 99: my %updatedata; 100: 101: # 102: # These global hashes are dependent on user, course and resource, 103: # and need to be initialized every time when a sheet is calculated 104: # 105: my %courseopt; 106: my %useropt; 107: my %parmhash; 108: 109: # 110: # Some hashes for stats on timing and performance 111: # 112: 113: my %starttimes; 114: my %usedtimes; 115: my %numbertimes; 116: 117: # Stuff that only the screen handler can know 118: 119: my $includedir; 120: my $tmpdir; 121: 122: # ============================================================================= 123: # ===================================== Implements an instance of a spreadsheet 124: 125: sub initsheet { 126: my $safeeval = new Safe(shift); 127: my $safehole = new Safe::Hole; 128: $safeeval->permit("entereval"); 129: $safeeval->permit(":base_math"); 130: $safeeval->permit("sort"); 131: $safeeval->deny(":base_io"); 132: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 133: $safeeval->share('$@'); 134: my $code=<<'ENDDEFS'; 135: # ---------------------------------------------------- Inside of the safe space 136: 137: # 138: # f: formulas 139: # t: intermediate format (variable references expanded) 140: # v: output values 141: # c: preloaded constants (A-column) 142: # rl: row label 143: # os: other spreadsheets (for student spreadsheet only) 144: 145: undef %v; 146: undef %t; 147: undef %f; 148: undef %c; 149: undef %rowlabel; 150: undef @os; 151: 152: $maxrow=0; 153: $sheettype=''; 154: 155: # filename/reference of the sheet 156: 157: $filename=''; 158: 159: # user data 160: $uname=''; 161: $uhome=''; 162: $udom=''; 163: 164: # course data 165: 166: $csec=''; 167: $chome=''; 168: $cnum=''; 169: $cdom=''; 170: $cid=''; 171: $cfn=''; 172: 173: # symb 174: 175: $usymb=''; 176: 177: # error messages 178: 179: $errormsg=''; 180: 181: sub mask { 182: my ($lower,$upper)=@_; 183: 184: $lower=~/([A-Za-z]|\*)(\d+|\*)/; 185: my $la=$1; 186: my $ld=$2; 187: 188: $upper=~/([A-Za-z]|\*)(\d+|\*)/; 189: my $ua=$1; 190: my $ud=$2; 191: my $alpha=''; 192: my $num=''; 193: 194: if (($la eq '*') || ($ua eq '*')) { 195: $alpha='[A-Za-z]'; 196: } else { 197: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || 198: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { 199: $alpha='['.$la.'-'.$ua.']'; 200: } else { 201: $alpha='['.$la.'-Za-'.$ua.']'; 202: } 203: } 204: 205: if (($ld eq '*') || ($ud eq '*')) { 206: $num='\d+'; 207: } else { 208: if (length($ld)!=length($ud)) { 209: $num.='('; 210: foreach ($ld=~m/\d/g) { 211: $num.='['.$_.'-9]'; 212: } 213: if (length($ud)-length($ld)>1) { 214: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; 215: } 216: $num.='|'; 217: foreach ($ud=~m/\d/g) { 218: $num.='[0-'.$_.']'; 219: } 220: $num.=')'; 221: } else { 222: my @lda=($ld=~m/\d/g); 223: my @uda=($ud=~m/\d/g); 224: my $i; $j=0; $notdone=1; 225: for ($i=0;($i<=$#lda)&&($notdone);$i++) { 226: if ($lda[$i]==$uda[$i]) { 227: $num.=$lda[$i]; 228: $j=$i; 229: } else { 230: $notdone=0; 231: } 232: } 233: if ($j<$#lda-1) { 234: $num.='('.$lda[$j+1]; 235: for ($i=$j+2;$i<=$#lda;$i++) { 236: $num.='['.$lda[$i].'-9]'; 237: } 238: if ($uda[$j+1]-$lda[$j+1]>1) { 239: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. 240: ($#lda-$j-1).'}'; 241: } 242: $num.='|'.$uda[$j+1]; 243: for ($i=$j+2;$i<=$#uda;$i++) { 244: $num.='[0-'.$uda[$i].']'; 245: } 246: $num.=')'; 247: } else { 248: if ($lda[$#lda]!=$uda[$#uda]) { 249: $num.='['.$lda[$#lda].'-'.$uda[$#uda].']'; 250: } 251: } 252: } 253: } 254: return '^'.$alpha.$num."\$"; 255: } 256: 257: #------------------------------------------------------- 258: 259: =item UWCALC(hashname,modules,units,date) 260: 261: returns the proportion of the module 262: weights not previously completed by the student. 263: 264: =over 4 265: 266: =item hashname 267: 268: name of the hash the module dates have been inserted into 269: 270: =item modules 271: 272: reference to a cell which contains a comma deliminated list of modules 273: covered by the assignment. 274: 275: =item units 276: 277: reference to a cell which contains a comma deliminated list of module 278: weights with respect to the assignment 279: 280: =item date 281: 282: reference to a cell which contains the date the assignment was completed. 283: 284: =back 285: 286: =cut 287: 288: #------------------------------------------------------- 289: sub UWCALC { 290: my ($hashname,$modules,$units,$date) = @_; 291: my @Modules = split(/,/,$modules); 292: my @Units = split(/,/,$units); 293: my $total_weight; 294: foreach (@Units) { 295: $total_weight += $_; 296: } 297: my $usum=0; 298: for (my $i=0; $i<=$#Modules; $i++) { 299: if (&HASH($hashname,$Modules[$i]) eq $date) { 300: $usum += $Units[$i]; 301: } 302: } 303: return $usum/$total_weight; 304: } 305: 306: #------------------------------------------------------- 307: 308: =item CDLSUM(list) 309: 310: returns the sum of the elements in a cell which contains 311: a Comma Deliminate List of numerical values. 312: 'list' is a reference to a cell which contains a comma deliminated list. 313: 314: =cut 315: 316: #------------------------------------------------------- 317: sub CDLSUM { 318: my ($list)=@_; 319: my $sum; 320: foreach (split/,/,$list) { 321: $sum += $_; 322: } 323: return $sum; 324: } 325: 326: #------------------------------------------------------- 327: 328: =item CDLITEM(list,index) 329: 330: returns the item at 'index' in a Comma Deliminated List. 331: 332: =over 4 333: 334: =item list 335: 336: reference to a cell which contains a comma deliminated list. 337: 338: =item index 339: 340: the Perl index of the item requested (first element in list has 341: an index of 0) 342: 343: =back 344: 345: =cut 346: 347: #------------------------------------------------------- 348: sub CDLITEM { 349: my ($list,$index)=@_; 350: my @Temp = split/,/,$list; 351: return $Temp[$index]; 352: } 353: 354: #------------------------------------------------------- 355: 356: =item CDLHASH(name,key,value) 357: 358: loads a comma deliminated list of keys into 359: the hash 'name', all with a value of 'value'. 360: 361: =over 4 362: 363: =item name 364: 365: name of the hash. 366: 367: =item key 368: 369: (a pointer to) a comma deliminated list of keys. 370: 371: =item value 372: 373: a single value to be entered for each key. 374: 375: =back 376: 377: =cut 378: 379: #------------------------------------------------------- 380: sub CDLHASH { 381: my ($name,$key,$value)=@_; 382: my @Keys; 383: my @Values; 384: # Check to see if we have multiple $key values 385: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 386: my $keymask = &mask($key); 387: # Assume the keys are addresses 388: my @Temp = grep /$keymask/,keys(%v); 389: @Keys = $v{@Temp}; 390: } else { 391: $Keys[0]= $key; 392: } 393: my @Temp; 394: foreach $key (@Keys) { 395: @Temp = (@Temp, split/,/,$key); 396: } 397: @Keys = @Temp; 398: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 399: my $valmask = &mask($value); 400: my @Temp = grep /$valmask/,keys(%v); 401: @Values =$v{@Temp}; 402: } else { 403: $Values[0]= $value; 404: } 405: $value = $Values[0]; 406: # Add values to hash 407: for (my $i = 0; $i<=$#Keys; $i++) { 408: my $key = $Keys[$i]; 409: if (! exists ($hashes{$name}->{$key})) { 410: $hashes{$name}->{$key}->[0]=$value; 411: } else { 412: my @Temp = sort(@{$hashes{$name}->{$key}},$value); 413: $hashes{$name}->{$key} = \@Temp; 414: } 415: } 416: return "hash '$name' updated"; 417: } 418: 419: #------------------------------------------------------- 420: 421: =item GETHASH(name,key,index) 422: 423: returns the element in hash 'name' 424: reference by the key 'key', at index 'index' in the values list. 425: 426: =cut 427: 428: #------------------------------------------------------- 429: sub GETHASH { 430: my ($name,$key,$index)=@_; 431: if (! defined($index)) { 432: $index = 0; 433: } 434: if ($key =~ /^[A-z]\d+$/) { 435: $key = $v{$key}; 436: } 437: return $hashes{$name}->{$key}->[$index]; 438: } 439: 440: #------------------------------------------------------- 441: 442: =item CLEARHASH(name) 443: 444: clears all the values from the hash 'name' 445: 446: =item CLEARHASH(name,key) 447: 448: clears all the values from the hash 'name' associated with the given key. 449: 450: =cut 451: 452: #------------------------------------------------------- 453: sub CLEARHASH { 454: my ($name,$key)=@_; 455: if (defined($key)) { 456: if (exists($hashes{$name}->{$key})) { 457: $hashes{$name}->{$key}=undef; 458: return "hash '$name' key '$key' cleared"; 459: } 460: } else { 461: if (exists($hashes{$name})) { 462: $hashes{$name}=undef; 463: return "hash '$name' cleared"; 464: } 465: } 466: return "Error in clearing hash"; 467: } 468: 469: #------------------------------------------------------- 470: 471: =item HASH(name,key,value) 472: 473: loads values into an internal hash. If a key 474: already has a value associated with it, the values are sorted numerically. 475: 476: =item HASH(name,key) 477: 478: returns the 0th value in the hash 'name' associated with 'key'. 479: 480: =cut 481: 482: #------------------------------------------------------- 483: sub HASH { 484: my ($name,$key,$value)=@_; 485: my @Keys; 486: undef @Keys; 487: my @Values; 488: # Check to see if we have multiple $key values 489: if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 490: my $keymask = &mask($key); 491: # Assume the keys are addresses 492: my @Temp = grep /$keymask/,keys(%v); 493: @Keys = $v{@Temp}; 494: } else { 495: $Keys[0]= $key; 496: } 497: # If $value is empty, return the first value associated 498: # with the first key. 499: if (! $value) { 500: return $hashes{$name}->{$Keys[0]}->[0]; 501: } 502: # Check to see if we have multiple $value(s) 503: if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { 504: my $valmask = &mask($value); 505: my @Temp = grep /$valmask/,keys(%v); 506: @Values =$v{@Temp}; 507: } else { 508: $Values[0]= $value; 509: } 510: # Add values to hash 511: for (my $i = 0; $i<=$#Keys; $i++) { 512: my $key = $Keys[$i]; 513: my $value = ($i<=$#Values ? $Values[$i] : $Values[0]); 514: if (! exists ($hashes{$name}->{$key})) { 515: $hashes{$name}->{$key}->[0]=$value; 516: } else { 517: my @Temp = sort(@{$hashes{$name}->{$key}},$value); 518: $hashes{$name}->{$key} = \@Temp; 519: } 520: } 521: return $Values[-1]; 522: } 523: 524: #------------------------------------------------------- 525: 526: =item NUM(range) 527: 528: returns the number of items in the range. 529: 530: =cut 531: 532: #------------------------------------------------------- 533: sub NUM { 534: my $mask=mask(@_); 535: my $num= $#{@{grep(/$mask/,keys(%v))}}+1; 536: return $num; 537: } 538: 539: sub BIN { 540: my ($low,$high,$lower,$upper)=@_; 541: my $mask=mask($lower,$upper); 542: my $num=0; 543: foreach (grep /$mask/,keys(%v)) { 544: if (($v{$_}>=$low) && ($v{$_}<=$high)) { 545: $num++; 546: } 547: } 548: return $num; 549: } 550: 551: 552: #------------------------------------------------------- 553: 554: =item SUM(range) 555: 556: returns the sum of items in the range. 557: 558: =cut 559: 560: #------------------------------------------------------- 561: sub SUM { 562: my $mask=mask(@_); 563: my $sum=0; 564: foreach (grep /$mask/,keys(%v)) { 565: $sum+=$v{$_}; 566: } 567: return $sum; 568: } 569: 570: #------------------------------------------------------- 571: 572: =item MEAN(range) 573: 574: compute the average of the items in the range. 575: 576: =cut 577: 578: #------------------------------------------------------- 579: sub MEAN { 580: my $mask=mask(@_); 581: my $sum=0; my $num=0; 582: foreach (grep /$mask/,keys(%v)) { 583: $sum+=$v{$_}; 584: $num++; 585: } 586: if ($num) { 587: return $sum/$num; 588: } else { 589: return undef; 590: } 591: } 592: 593: #------------------------------------------------------- 594: 595: =item STDDEV(range) 596: 597: compute the standard deviation of the items in the range. 598: 599: =cut 600: 601: #------------------------------------------------------- 602: sub STDDEV { 603: my $mask=mask(@_); 604: my $sum=0; my $num=0; 605: foreach (grep /$mask/,keys(%v)) { 606: $sum+=$v{$_}; 607: $num++; 608: } 609: unless ($num>1) { return undef; } 610: my $mean=$sum/$num; 611: $sum=0; 612: foreach (grep /$mask/,keys(%v)) { 613: $sum+=($v{$_}-$mean)**2; 614: } 615: return sqrt($sum/($num-1)); 616: } 617: 618: #------------------------------------------------------- 619: 620: =item PROD(range) 621: 622: compute the product of the items in the range. 623: 624: =cut 625: 626: #------------------------------------------------------- 627: sub PROD { 628: my $mask=mask(@_); 629: my $prod=1; 630: foreach (grep /$mask/,keys(%v)) { 631: $prod*=$v{$_}; 632: } 633: return $prod; 634: } 635: 636: #------------------------------------------------------- 637: 638: =item MAX(range) 639: 640: compute the maximum of the items in the range. 641: 642: =cut 643: 644: #------------------------------------------------------- 645: sub MAX { 646: my $mask=mask(@_); 647: my $max='-'; 648: foreach (grep /$mask/,keys(%v)) { 649: unless ($max) { $max=$v{$_}; } 650: if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; } 651: } 652: return $max; 653: } 654: 655: #------------------------------------------------------- 656: 657: =item MIN(range) 658: 659: compute the minimum of the items in the range. 660: 661: =cut 662: 663: #------------------------------------------------------- 664: sub MIN { 665: my $mask=mask(@_); 666: my $min='-'; 667: foreach (grep /$mask/,keys(%v)) { 668: unless ($max) { $max=$v{$_}; } 669: if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; } 670: } 671: return $min; 672: } 673: 674: #------------------------------------------------------- 675: 676: =item SUMMAX(num,lower,upper) 677: 678: compute the sum of the largest 'num' items in the range from 679: 'lower' to 'upper' 680: 681: =cut 682: 683: #------------------------------------------------------- 684: sub SUMMAX { 685: my ($num,$lower,$upper)=@_; 686: my $mask=mask($lower,$upper); 687: my @inside=(); 688: foreach (grep /$mask/,keys(%v)) { 689: push (@inside,$v{$_}); 690: } 691: @inside=sort(@inside); 692: my $sum=0; my $i; 693: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 694: $sum+=$inside[$i]; 695: } 696: return $sum; 697: } 698: 699: #------------------------------------------------------- 700: 701: =item SUMMIN(num,lower,upper) 702: 703: compute the sum of the smallest 'num' items in the range from 704: 'lower' to 'upper' 705: 706: =cut 707: 708: #------------------------------------------------------- 709: sub SUMMIN { 710: my ($num,$lower,$upper)=@_; 711: my $mask=mask($lower,$upper); 712: my @inside=(); 713: foreach (grep /$mask/,keys(%v)) { 714: $inside[$#inside+1]=$v{$_}; 715: } 716: @inside=sort(@inside); 717: my $sum=0; my $i; 718: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 719: $sum+=$inside[$i]; 720: } 721: return $sum; 722: } 723: 724: #------------------------------------------------------- 725: 726: =item MINPARM(parametername) 727: 728: Returns the minimum value of the parameters matching the parametername. 729: parametername should be a string such as 'duedate'. 730: 731: =cut 732: 733: #------------------------------------------------------- 734: sub MINPARM { 735: my ($expression) = @_; 736: my $min = undef; 737: study($expression); 738: foreach $parameter (keys(%c)) { 739: next if ($parameter !~ /$expression/); 740: if ((! defined($min)) || ($min > $c{$parameter})) { 741: $min = $c{$parameter} 742: } 743: } 744: return $min; 745: } 746: 747: #------------------------------------------------------- 748: 749: =item MAXPARM(parametername) 750: 751: Returns the maximum value of the parameters matching the input parameter name. 752: parametername should be a string such as 'duedate'. 753: 754: =cut 755: 756: #------------------------------------------------------- 757: sub MAXPARM { 758: my ($expression) = @_; 759: my $max = undef; 760: study($expression); 761: foreach $parameter (keys(%c)) { 762: next if ($parameter !~ /$expression/); 763: if ((! defined($min)) || ($max < $c{$parameter})) { 764: $max = $c{$parameter} 765: } 766: } 767: return $max; 768: } 769: 770: #-------------------------------------------------------- 771: sub expandnamed { 772: my $expression=shift; 773: if ($expression=~/^\&/) { 774: my ($func,$var,$formula)=($expression=~/^\&(\w+)$([^\;]+)\;(.*)$/); 775: my @vars=split(/\W+/,$formula); 776: my %values=(); 777: undef %values; 778: foreach ( @vars ) { 779: my $varname=$_; 780: if ($varname=~/\D/) { 781: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; 782: $varname=~s/$var/$\\w\+$/g; 783: foreach (keys(%c)) { 784: if ($_=~/$varname/) { 785: $values{$1}=1; 786: } 787: } 788: } 789: } 790: if ($func eq 'EXPANDSUM') { 791: my $result=''; 792: foreach (keys(%values)) { 793: my $thissum=$formula; 794: $thissum=~s/$var/$_/g; 795: $result.=$thissum.'+'; 796: } 797: $result=~s/\+$//; 798: return $result; 799: } else { 800: return 0; 801: } 802: } else { 803: # it is not a function, so it is a parameter name 804: # We should do the following: 805: # 1. Take the list of parameter names 806: # 2. look through the list for ones that match the parameter we want 807: # 3. If there are no collisions, return the one that matches 808: # 4. If there is a collision, return 'bad parameter name error' 809: my $returnvalue = ''; 810: my @matches = (); 811: $#matches = -1; 812: study $expression; 813: foreach $parameter (keys(%c)) { 814: push @matches,$parameter if ($parameter =~ /$expression/); 815: } 816: if ($#matches == 0) { 817: $returnvalue = '$c{\''.$matches[0].'\'}'; 818: } elsif ($#matches > 0) { 819: # more than one match. Look for a concise one 820: $returnvalue = "'non-unique parameter name : $expression'"; 821: foreach (@matches) { 822: if (/^$expression$/) { 823: $returnvalue = '$c{\''.$_.'\'}'; 824: } 825: } 826: } else { 827: $returnvalue = "'bad parameter name : $expression'"; 828: } 829: return $returnvalue; 830: } 831: } 832: 833: sub sett { 834: %t=(); 835: my $pattern=''; 836: if ($sheettype eq 'assesscalc') { 837: $pattern='A'; 838: } else { 839: $pattern='[A-Z]'; 840: } 841: 842: # Deal with the template row 843: foreach (keys(%f)) { 844: if ($_=~/template\_(\w)/) { 845: my $col=$1; 846: unless ($col=~/^$pattern/) { 847: foreach (keys(%f)) { 848: if ($_=~/A(\d+)/) { 849: my $trow=$1; 850: if ($trow) { 851: # Get the name of this cell 852: my $lb=$col.$trow; 853: # Grab the template declaration 854: $t{$lb}=$f{'template_'.$col}; 855: # Replace '#' with the row number 856: $t{$lb}=~s/\#/$trow/g; 857: # Replace '....' with ',' 858: $t{$lb}=~s/\.\.+/\,/g; 859: # Replace 'A0' with the value from 'A0' 860: $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; 861: # Replace parameters 862: $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; 863: } 864: } 865: } 866: } 867: } 868: } 869: 870: # Deal with the normal cells 871: foreach (keys(%f)) { 872: if (($f{$_}) && ($_!~/template\_/)) { 873: my $matches=($_=~/^$pattern(\d+)/); 874: if (($matches) && ($1)) { 875: unless ($f{$_}=~/^\!/) { 876: $t{$_}=$c{$_}; 877: } 878: } else { 879: $t{$_}=$f{$_}; 880: $t{$_}=~s/\.\.+/\,/g; 881: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; 882: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; 883: } 884: } 885: } 886: # For inserted lines, [B-Z] is also valid 887: 888: unless ($sheettype eq 'assesscalc') { 889: foreach (keys(%f)) { 890: if ($_=~/[B-Z](\d+)/) { 891: if ($f{'A'.$1}=~/^[\~\-]/) { 892: $t{$_}=$f{$_}; 893: $t{$_}=~s/\.\.+/\,/g; 894: $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; 895: $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; 896: } 897: } 898: } 899: } 900: 901: # For some reason 'A0' gets special treatment... This seems superfluous 902: # but I imagine it is here for a reason. 903: $t{'A0'}=$f{'A0'}; 904: $t{'A0'}=~s/\.\.+/\,/g; 905: $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; 906: $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; 907: } 908: 909: sub calc { 910: undef %v; 911: &sett(); 912: my $notfinished=1; 913: my $lastcalc=''; 914: my $depth=0; 915: while ($notfinished) { 916: $notfinished=0; 917: foreach (keys(%t)) { 918: my $old=$v{$_}; 919: $v{$_}=eval $t{$_}; 920: if ($@) { 921: undef %v; 922: return $_.': '.$@; 923: } 924: if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; } 925: } 926: $depth++; 927: if ($depth>100) { 928: undef %v; 929: return $lastcalc.': Maximum calculation depth exceeded'; 930: } 931: } 932: return ''; 933: } 934: 935: sub templaterow { 936: my @cols=(); 937: $cols[0]='<b><font size=+1>Template</font></b>'; 938: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 939: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 940: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 941: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 942: my $fm=$f{'template_'.$_}; 943: $fm=~s/[\'\"]/\&\#34;/g; 944: $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; 945: } 946: return @cols; 947: } 948: 949: sub outrowassess { 950: my $n=shift; 951: my @cols=(); 952: if ($n) { 953: my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); 954: if ($rowlabel{$usy}) { 955: $cols[0]=$rowlabel{$usy}.'<br>'. 956: '<select name="sel_'.$n.'" onChange="changesheet('.$n. 957: ')"><option name="default">Default</option>'; 958: } else { $cols[0]=''; } 959: foreach (@os) { 960: $cols[0].='<option name="'.$_.'"'; 961: if ($ufn eq $_) { 962: $cols[0].=' selected'; 963: } 964: $cols[0].='>'.$_.'</option>'; 965: } 966: $cols[0].='</select>'; 967: } else { 968: $cols[0]='<b><font size=+1>Export</font></b>'; 969: } 970: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 971: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 972: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 973: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 974: my $fm=$f{$_.$n}; 975: $fm=~s/[\'\"]/\&\#34;/g; 976: push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n}); 977: } 978: return @cols; 979: } 980: 981: sub outrow { 982: my $n=shift; 983: my @cols=(); 984: if ($n) { 985: $cols[0]=$rowlabel{$f{'A'.$n}}; 986: } else { 987: $cols[0]='<b><font size=+1>Export</font></b>'; 988: } 989: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 990: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 991: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 992: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 993: my $fm=$f{$_.$n}; 994: $fm=~s/[\'\"]/\&\#34;/g; 995: $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; 996: } 997: return @cols; 998: } 999: 1000: sub exportrowa { 1001: my @exportarray=(); 1002: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1003: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 1004: $exportarray[$#exportarray+1]=$v{$_.'0'}; 1005: } 1006: return @exportarray; 1007: } 1008: 1009: # ------------------------------------------- End of "Inside of the safe space" 1010: ENDDEFS 1011: $safeeval->reval($code); 1012: return $safeeval; 1013: } 1014: 1015: # ------------------------------------------------ Add or change formula values 1016: 1017: sub setformulas { 1018: my ($safeeval,%f)=@_; 1019: %{$safeeval->varglob('f')}=%f; 1020: } 1021: 1022: # ------------------------------------------------ Add or change formula values 1023: 1024: sub setconstants { 1025: my ($safeeval,%c)=@_; 1026: %{$safeeval->varglob('c')}=%c; 1027: } 1028: 1029: # --------------------------------------------- Set names of other spreadsheets 1030: 1031: sub setothersheets { 1032: my ($safeeval,@os)=@_; 1033: @{$safeeval->varglob('os')}=@os; 1034: } 1035: 1036: # ------------------------------------------------ Add or change formula values 1037: 1038: sub setrowlabels { 1039: my ($safeeval,%rowlabel)=@_; 1040: %{$safeeval->varglob('rowlabel')}=%rowlabel; 1041: } 1042: 1043: # ------------------------------------------------------- Calculate spreadsheet 1044: 1045: sub calcsheet { 1046: my $safeeval=shift; 1047: return $safeeval->reval('&calc();'); 1048: } 1049: 1050: # ------------------------------------------------------------------ Get values 1051: 1052: sub getvalues { 1053: my $safeeval=shift; 1054: return $safeeval->reval('%v'); 1055: } 1056: 1057: # ---------------------------------------------------------------- Get formulas 1058: 1059: sub getformulas { 1060: my $safeeval=shift; 1061: return %{$safeeval->varglob('f')}; 1062: } 1063: 1064: # ----------------------------------------------------- Get value of $f{'A'.$n} 1065: 1066: sub getfa { 1067: my ($safeeval,$n)=@_; 1068: return $safeeval->reval('$f{"A'.$n.'"}'); 1069: } 1070: 1071: # -------------------------------------------------------------------- Get type 1072: 1073: sub gettype { 1074: my $safeeval=shift; 1075: return $safeeval->reval('$sheettype'); 1076: } 1077: 1078: # ------------------------------------------------------------------ Set maxrow 1079: 1080: sub setmaxrow { 1081: my ($safeeval,$row)=@_; 1082: $safeeval->reval('$maxrow='.$row.';'); 1083: } 1084: 1085: # ------------------------------------------------------------------ Get maxrow 1086: 1087: sub getmaxrow { 1088: my $safeeval=shift; 1089: return $safeeval->reval('$maxrow'); 1090: } 1091: 1092: # ---------------------------------------------------------------- Set filename 1093: 1094: sub setfilename { 1095: my ($safeeval,$fn)=@_; 1096: $safeeval->reval('$filename="'.$fn.'";'); 1097: } 1098: 1099: # ---------------------------------------------------------------- Get filename 1100: 1101: sub getfilename { 1102: my $safeeval=shift; 1103: return $safeeval->reval('$filename'); 1104: } 1105: 1106: # --------------------------------------------------------------- Get course ID 1107: 1108: sub getcid { 1109: my $safeeval=shift; 1110: return $safeeval->reval('$cid'); 1111: } 1112: 1113: # --------------------------------------------------------- Get course filename 1114: 1115: sub getcfn { 1116: my $safeeval=shift; 1117: return $safeeval->reval('$cfn'); 1118: } 1119: 1120: # ----------------------------------------------------------- Get course number 1121: 1122: sub getcnum { 1123: my $safeeval=shift; 1124: return $safeeval->reval('$cnum'); 1125: } 1126: 1127: # ------------------------------------------------------------- Get course home 1128: 1129: sub getchome { 1130: my $safeeval=shift; 1131: return $safeeval->reval('$chome'); 1132: } 1133: 1134: # ----------------------------------------------------------- Get course domain 1135: 1136: sub getcdom { 1137: my $safeeval=shift; 1138: return $safeeval->reval('$cdom'); 1139: } 1140: 1141: # ---------------------------------------------------------- Get course section 1142: 1143: sub getcsec { 1144: my $safeeval=shift; 1145: return $safeeval->reval('$csec'); 1146: } 1147: 1148: # --------------------------------------------------------------- Get user name 1149: 1150: sub getuname { 1151: my $safeeval=shift; 1152: return $safeeval->reval('$uname'); 1153: } 1154: 1155: # ------------------------------------------------------------- Get user domain 1156: 1157: sub getudom { 1158: my $safeeval=shift; 1159: return $safeeval->reval('$udom'); 1160: } 1161: 1162: # --------------------------------------------------------------- Get user home 1163: 1164: sub getuhome { 1165: my $safeeval=shift; 1166: return $safeeval->reval('$uhome'); 1167: } 1168: 1169: # -------------------------------------------------------------------- Get symb 1170: 1171: sub getusymb { 1172: my $safeeval=shift; 1173: return $safeeval->reval('$usymb'); 1174: } 1175: 1176: # ------------------------------------------------------------- Export of A-row 1177: 1178: sub exportdata { 1179: my $safeeval=shift; 1180: return $safeeval->reval('&exportrowa()'); 1181: } 1182: 1183: 1184: # ========================================================== End of Spreadsheet 1185: # ============================================================================= 1186: 1187: # 1188: # Procedures for screen output 1189: # 1190: # --------------------------------------------- Produce output row n from sheet 1191: 1192: sub rown { 1193: my ($safeeval,$n)=@_; 1194: my $defaultbg; 1195: my $rowdata=''; 1196: my $dataflag=0; 1197: unless ($n eq '-') { 1198: $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF'; 1199: } else { 1200: $defaultbg='#E0FF'; 1201: } 1202: unless ($ENV{'form.showcsv'}) { 1203: $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>"; 1204: } else { 1205: $rowdata.="\n".'"'.$n.'"'; 1206: } 1207: my $showf=0; 1208: my $proc; 1209: my $maxred=1; 1210: my $sheettype=&gettype($safeeval); 1211: if ($sheettype eq 'studentcalc') { 1212: $proc='&outrowassess'; 1213: $maxred=26; 1214: } else { 1215: $proc='&outrow'; 1216: } 1217: if ($sheettype eq 'assesscalc') { 1218: $maxred=1; 1219: } else { 1220: $maxred=26; 1221: } 1222: if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; } 1223: if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; } 1224: foreach ($safeeval->reval($proc.'('.$n.')')) { 1225: my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); 1226: my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); 1227: if ((($vl ne '') || ($vl eq '0')) && 1228: (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; } 1229: if ($showf==0) { $vl=$_; } 1230: unless ($ENV{'form.showcsv'}) { 1231: if ($showf<=$maxred) { $bgcolor='#FFDDDD'; } 1232: if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } 1233: if (($showf>$maxred) || ((!$n) && ($showf>0))) { 1234: if ($vl eq '') { 1235: $vl='<font size=+2 color='.$bgcolor.'>#</font>'; 1236: } 1237: $rowdata.= 1238: '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl. 1239: '</a></td>'; 1240: } else { 1241: $rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>'; 1242: } 1243: } else { 1244: $rowdata.=',"'.$vl.'"'; 1245: } 1246: $showf++; 1247: } # End of foreach($safeval...) 1248: if ($ENV{'form.showall'} || ($dataflag)) { 1249: return $rowdata.($ENV{'form.showcsv'}?'':'</tr>'); 1250: } else { 1251: return ''; 1252: } 1253: } 1254: 1255: # ------------------------------------------------------------- Print out sheet 1256: 1257: sub outsheet { 1258: my ($r,$safeeval)=@_; 1259: my $maxred; 1260: my $realm; 1261: if (&gettype($safeeval) eq 'assesscalc') { 1262: $maxred=1; 1263: $realm='Assessment'; 1264: } elsif (&gettype($safeeval) eq 'studentcalc') { 1265: $maxred=26; 1266: $realm='User'; 1267: } else { 1268: $maxred=26; 1269: $realm='Course'; 1270: } 1271: my $maxyellow=52-$maxred; 1272: my $tabledata; 1273: unless ($ENV{'form.showcsv'}) { 1274: $tabledata= 1275: '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'. 1276: $realm.'</font></th>'. 1277: '<td bgcolor=#FFDDDD colspan='.$maxred. 1278: '><b><font size=+1>Import</font></b></td>'. 1279: '<td colspan='.$maxyellow. 1280: '><b><font size=+1>Calculations</font></b></td></tr><tr>'; 1281: my $showf=0; 1282: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1283: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 1284: 'a','b','c','d','e','f','g','h','i','j','k','l','m', 1285: 'n','o','p','q','r','s','t','u','v','w','x','y','z') { 1286: $showf++; 1287: if ($showf<=$maxred) { 1288: $tabledata.='<td bgcolor="#FFDDDD">'; 1289: } else { 1290: $tabledata.='<td>'; 1291: } 1292: $tabledata.="<b><font size=+1>$_</font></b></td>"; 1293: } 1294: $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0); 1295: } else { $tabledata='<pre>'; } 1296: 1297: $r->print($tabledata); 1298: 1299: my $row; 1300: my $maxrow=&getmaxrow($safeeval); 1301: 1302: my @sortby=(); 1303: my @sortidx=(); 1304: for ($row=1;$row<=$maxrow;$row++) { 1305: $sortby[$row-1]=$safeeval->reval('$f{"A'.$row.'"}'); 1306: $sortidx[$row-1]=$row-1; 1307: } 1308: @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx; 1309: my $what='Student'; 1310: if (&gettype($safeeval) eq 'assesscalc') { 1311: $what='Item'; 1312: } elsif (&gettype($safeeval) eq 'studentcalc') { 1313: $what='Assessment'; 1314: } 1315: 1316: my $n=0; 1317: for ($row=0;$row<$maxrow;$row++) { 1318: my $thisrow=&rown($safeeval,$sortidx[$row]+1); 1319: if ($thisrow) { 1320: if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) { 1321: $r->print("</table>\n<br>\n"); 1322: $r->rflush(); 1323: $r->print('<table border=2><tr><td> <td>'.$what.'</td>'); 1324: $r->print('<td>'.join('</td><td>', 1325: (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 1326: 'abcdefghijklmnopqrstuvwxyz'))). 1327: "</td></tr>\n"); 1328: } 1329: $n++; 1330: $r->print($thisrow); 1331: } 1332: } 1333: $r->print($ENV{'form.showcsv'}?'</pre>':'</table>'); 1334: } 1335: 1336: # 1337: # ----------------------------------------------- Read list of available sheets 1338: # 1339: sub othersheets { 1340: my ($safeeval,$stype)=@_; 1341: # 1342: my $cnum=&getcnum($safeeval); 1343: my $cdom=&getcdom($safeeval); 1344: my $chome=&getchome($safeeval); 1345: # 1346: my @alternatives=(); 1347: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); 1348: my ($tmp) = keys(%results); 1349: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1350: @alternatives = sort (keys(%results)); 1351: } 1352: return @alternatives; 1353: } 1354: 1355: 1356: # 1357: # -------------------------------------- Parse a spreadsheet 1358: # 1359: sub parse_sheet { 1360: # $sheetxml is a scalar reference or a scalar 1361: my ($sheetxml) = @_; 1362: if (! ref($sheetxml)) { 1363: my $tmp = $sheetxml; 1364: $sheetxml = \$tmp; 1365: } 1366: my %f; 1367: my $parser=HTML::TokeParser->new($sheetxml); 1368: my $token; 1369: while ($token=$parser->get_token) { 1370: if ($token->[0] eq 'S') { 1371: if ($token->[1] eq 'field') { 1372: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= 1373: $parser->get_text('/field'); 1374: } 1375: if ($token->[1] eq 'template') { 1376: $f{'template_'.$token->[2]->{'col'}}= 1377: $parser->get_text('/template'); 1378: } 1379: } 1380: } 1381: return \%f; 1382: } 1383: 1384: # 1385: # -------------------------------------- Read spreadsheet formulas for a course 1386: # 1387: 1388: sub readsheet { 1389: my ($safeeval,$fn)=@_; 1390: my $stype=&gettype($safeeval); 1391: my $cnum=&getcnum($safeeval); 1392: my $cdom=&getcdom($safeeval); 1393: my $chome=&getchome($safeeval); 1394: 1395: if (! defined($fn)) { 1396: # There is no filename. Look for defaults in course and global, cache 1397: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { 1398: my %tmphash = &Apache::lonnet::get('environment', 1399: ['spreadsheet_default_'.$stype], 1400: $cdom,$cnum); 1401: my ($tmp) = keys(%tmphash); 1402: if ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1403: $fn = 'default_'.$stype; 1404: } else { 1405: $fn = $tmphash{'spreadsheet_default_'.$stype}; 1406: } 1407: unless (($fn) && ($fn!~/^error\:/)) { 1408: $fn='default_'.$stype; 1409: } 1410: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 1411: } 1412: } 1413: 1414: # ---------------------------------------------------------- fn now has a value 1415: 1416: &setfilename($safeeval,$fn); 1417: 1418: # ------------------------------------------------------ see if sheet is cached 1419: my $fstring=''; 1420: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { 1421: &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring)); 1422: } else { 1423: 1424: # ---------------------------------------------------- Not cached, need to read 1425: 1426: my %f=(); 1427: 1428: if ($fn=~/^default\_/) { 1429: my $sheetxml=''; 1430: my $fh; 1431: my $dfn=$fn; 1432: $dfn=~s/\_/\./g; 1433: if ($fh=Apache::File->new($includedir.'/'.$dfn)) { 1434: $sheetxml=join('',<$fh>); 1435: } else { 1436: $sheetxml='<field row="0" col="A">"Error"</field>'; 1437: } 1438: %f=%{&parse_sheet(\$sheetxml)}; 1439: } elsif($fn=~/\/*\.spreadsheet$/) { 1440: my $sheetxml=&Apache::lonnet::getfile 1441: (&Apache::lonnet::filelocation('',$fn)); 1442: if ($sheetxml == -1) { 1443: $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' 1444: .$fn.'"</field>'; 1445: } 1446: %f=%{&parse_sheet(\$sheetxml)}; 1447: } else { 1448: my $sheet=''; 1449: my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); 1450: my ($tmp) = keys(%tmphash); 1451: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1452: foreach (keys(%tmphash)) { 1453: $f{$_}=$tmphash{$_}; 1454: } 1455: } 1456: } 1457: # --------------------------------------------------------------- Cache and set 1458: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 1459: &setformulas($safeeval,%f); 1460: } 1461: } 1462: 1463: # -------------------------------------------------------- Make new spreadsheet 1464: 1465: sub makenewsheet { 1466: my ($uname,$udom,$stype,$usymb)=@_; 1467: my $safeeval=initsheet($stype); 1468: $safeeval->reval( 1469: '$uname="'.$uname. 1470: '";$udom="'.$udom. 1471: '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom). 1472: '";$sheettype="'.$stype. 1473: '";$usymb="'.$usymb. 1474: '";$csec="'.&Apache::lonnet::usection($udom,$uname, 1475: $ENV{'request.course.id'}). 1476: '";$cid="'.$ENV{'request.course.id'}. 1477: '";$cfn="'.$ENV{'request.course.fn'}. 1478: '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. 1479: '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. 1480: '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";'); 1481: return $safeeval; 1482: } 1483: 1484: # ------------------------------------------------------------ Save spreadsheet 1485: 1486: sub writesheet { 1487: my ($safeeval,$makedef)=@_; 1488: my $cid=&getcid($safeeval); 1489: if (&Apache::lonnet::allowed('opa',$cid)) { 1490: my %f=&getformulas($safeeval); 1491: my $stype=&gettype($safeeval); 1492: my $cnum=&getcnum($safeeval); 1493: my $cdom=&getcdom($safeeval); 1494: my $chome=&getchome($safeeval); 1495: my $fn=&getfilename($safeeval); 1496: 1497: # ------------------------------------------------------------- Cache new sheet 1498: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 1499: # ----------------------------------------------------------------- Write sheet 1500: my $sheetdata=''; 1501: foreach (keys(%f)) { 1502: unless ($f{$_} eq 'import') { 1503: $sheetdata.=&Apache::lonnet::escape($_).'='. 1504: &Apache::lonnet::escape($f{$_}).'&'; 1505: } 1506: } 1507: $sheetdata=~s/\&$//; 1508: my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. 1509: $sheetdata,$chome); 1510: if ($reply eq 'ok') { 1511: $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. 1512: $stype.'_spreadsheets:'. 1513: &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'. 1514: $ENV{'user.domain'}, 1515: $chome); 1516: if ($reply eq 'ok') { 1517: if ($makedef) { 1518: return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. 1519: ':environment:spreadsheet_default_'.$stype.'='. 1520: &Apache::lonnet::escape($fn), 1521: $chome); 1522: } else { 1523: return $reply; 1524: } 1525: } else { 1526: return $reply; 1527: } 1528: } else { 1529: return $reply; 1530: } 1531: } 1532: return 'unauthorized'; 1533: } 1534: 1535: # ----------------------------------------------- Make a temp copy of the sheet 1536: # "Modified workcopy" - interactive only 1537: # 1538: 1539: sub tmpwrite { 1540: my $safeeval=shift; 1541: my $fn=$ENV{'user.name'}.'_'. 1542: $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. 1543: &getfilename($safeeval); 1544: $fn=~s/\W/\_/g; 1545: $fn=$tmpdir.$fn.'.tmp'; 1546: my $fh; 1547: if ($fh=Apache::File->new('>'.$fn)) { 1548: print $fh join("\n",&getformulas($safeeval)); 1549: } 1550: } 1551: 1552: # ---------------------------------------------------------- Read the temp copy 1553: 1554: sub tmpread { 1555: my ($safeeval,$nfield,$nform)=@_; 1556: my $fn=$ENV{'user.name'}.'_'. 1557: $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. 1558: &getfilename($safeeval); 1559: $fn=~s/\W/\_/g; 1560: $fn=$tmpdir.$fn.'.tmp'; 1561: my $fh; 1562: my %fo=(); 1563: my $countrows=0; 1564: if ($fh=Apache::File->new($fn)) { 1565: my $name; 1566: while ($name=<$fh>) { 1567: chomp($name); 1568: my $value=<$fh>; 1569: chomp($value); 1570: $fo{$name}=$value; 1571: if ($name=~/^A(\d+)$/) { 1572: if ($1>$countrows) { 1573: $countrows=$1; 1574: } 1575: } 1576: } 1577: } 1578: if ($nform eq 'changesheet') { 1579: $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0]; 1580: unless ($ENV{'form.sel_'.$nfield} eq 'Default') { 1581: $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; 1582: } 1583: } elsif ($nfield eq 'insertrow') { 1584: $countrows++; 1585: my $newrow=substr('000000'.$countrows,-7); 1586: if ($nform eq 'top') { 1587: $fo{'A'.$countrows}='--- '.$newrow; 1588: } else { 1589: $fo{'A'.$countrows}='~~~ '.$newrow; 1590: } 1591: } else { 1592: if ($nfield) { $fo{$nfield}=$nform; } 1593: } 1594: &setformulas($safeeval,%fo); 1595: } 1596: 1597: # ================================================================== Parameters 1598: # -------------------------------------------- Figure out a cascading parameter 1599: # 1600: # For this function to work 1601: # 1602: # * parmhash needs to be tied 1603: # * courseopt and useropt need to be initialized for this user and course 1604: # 1605: 1606: sub parmval { 1607: my ($what,$safeeval)=@_; 1608: my $cid=&getcid($safeeval); 1609: my $csec=&getcsec($safeeval); 1610: my $uname=&getuname($safeeval); 1611: my $udom=&getudom($safeeval); 1612: my $symb=&getusymb($safeeval); 1613: 1614: unless ($symb) { return ''; } 1615: my $result=''; 1616: 1617: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); 1618: # ----------------------------------------------------- Cascading lookup scheme 1619: my $rwhat=$what; 1620: $what=~s/^parameter\_//; 1621: $what=~s/\_([^\_]+)$/\.$1/; 1622: 1623: my $symbparm=$symb.'.'.$what; 1624: my $mapparm=$mapname.'___(all).'.$what; 1625: my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; 1626: 1627: my $seclevel= 1628: $usercourseprefix.'.['. 1629: $csec.'].'.$what; 1630: my $seclevelr= 1631: $usercourseprefix.'.['. 1632: $csec.'].'.$symbparm; 1633: my $seclevelm= 1634: $usercourseprefix.'.['. 1635: $csec.'].'.$mapparm; 1636: 1637: my $courselevel= 1638: $usercourseprefix.'.'.$what; 1639: my $courselevelr= 1640: $usercourseprefix.'.'.$symbparm; 1641: my $courselevelm= 1642: $usercourseprefix.'.'.$mapparm; 1643: 1644: # ---------------------------------------------------------- fourth, check user 1645: 1646: if ($uname) { 1647: 1648: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; } 1649: 1650: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; } 1651: 1652: if ($useropt{$courselevel}) { return $useropt{$courselevel}; } 1653: 1654: } 1655: 1656: # --------------------------------------------------------- third, check course 1657: 1658: if ($csec) { 1659: 1660: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; } 1661: 1662: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; } 1663: 1664: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; } 1665: 1666: } 1667: 1668: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; } 1669: 1670: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; } 1671: 1672: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; } 1673: 1674: # ----------------------------------------------------- second, check map parms 1675: 1676: my $thisparm=$parmhash{$symbparm}; 1677: if ($thisparm) { return $thisparm; } 1678: 1679: # -------------------------------------------------------- first, check default 1680: 1681: return &Apache::lonnet::metadata($fn,$rwhat.'.default'); 1682: 1683: } 1684: 1685: # ---------------------------------------------- Update rows for course listing 1686: 1687: sub updateclasssheet { 1688: my $safeeval=shift; 1689: my $cnum=&getcnum($safeeval); 1690: my $cdom=&getcdom($safeeval); 1691: my $cid=&getcid($safeeval); 1692: my $chome=&getchome($safeeval); 1693: # 1694: # Read class list and row labels 1695: my %classlist; 1696: my @tmp = &Apache::lonnet::dump('classlist',$cdom,$cnum); 1697: if ($tmp[0] !~ /^error/) { 1698: %classlist = @tmp; 1699: } else { 1700: return 'Could not access course data'; 1701: } 1702: undef @tmp; 1703: # 1704: my %currentlist=(); 1705: my $now=time; 1706: foreach my $student (keys(%classlist)) { 1707: my ($end,$start)=split(/\:/,$classlist{$student}); 1708: my $active=1; 1709: $active = 0 if (($end) && ($now>$end)); 1710: $active = 1 if ($ENV{'form.Status'} eq 'Any'); 1711: $active = !$active if ($ENV{'form.Status'} eq 'Expired'); 1712: if ($active) { 1713: my $rowlabel=''; 1714: my ($studentName,$studentDomain)=split(/\:/,$student); 1715: my $studentSection=&Apache::lonnet::usection($studentDomain, 1716: $studentName,$cid); 1717: if ($studentSection==-1) { 1718: unless ($ENV{'form.showcsv'}) { 1719: $rowlabel='<font color=red>Data not available: '. 1720: $studentName.'</font>'; 1721: } else { 1722: $rowlabel='ERROR","'.$studentName. 1723: '","Data not available","","","'; 1724: } 1725: } else { 1726: my %reply=&Apache::lonnet::idrget($studentDomain,$studentName); 1727: my %studentInformation=&Apache::lonnet::get 1728: ('environment', 1729: ['lastname','generation','firstname','middlename','id'], 1730: $studentDomain,$studentName); 1731: if (! $ENV{'form.showcsv'}) { 1732: $rowlabel='<a href="/adm/studentcalc?uname='.$studentName. 1733: '&udom='.$studentDomain.'">'. 1734: $studentSection.' '; 1735: foreach ('id','firstname','middlename', 1736: 'lastname','generation'){ 1737: $rowlabel.=$studentInformation{$_}." "; 1738: } 1739: $rowlabel.='</a>'; 1740: } else { 1741: $rowlabel= '"'.join('","', 1742: ($studentSection, 1743: $studentInformation{'id'}, 1744: $studentInformation{'firstname'}, 1745: $studentInformation{'middlename'}, 1746: $studentInformation{'lastname'}, 1747: $studentInformation{'generation'}) 1748: ).'"'; 1749: } 1750: } 1751: $currentlist{$student}=$rowlabel; 1752: } # end of if ($active) 1753: } # end of foreach my $student (keys(%classlist)) 1754: # 1755: # Find discrepancies between the course row table and this 1756: # 1757: my %f=&getformulas($safeeval); 1758: my $changed=0; 1759: # 1760: my $maxrow=0; 1761: my %existing=(); 1762: # 1763: # Now obsolete rows 1764: foreach (keys(%f)) { 1765: if ($_=~/^A(\d+)/) { 1766: $maxrow=($1>$maxrow)?$1:$maxrow; 1767: $existing{$f{$_}}=1; 1768: unless ((defined($currentlist{$f{$_}})) || (!$1) || 1769: ($f{$_}=~/^(\~\~\~|\-\-\-)/)) { 1770: $f{$_}='!!! Obsolete'; 1771: $changed=1; 1772: } 1773: } 1774: } 1775: # 1776: # New and unknown keys 1777: foreach (sort keys(%currentlist)) { 1778: unless ($existing{$_}) { 1779: $changed=1; 1780: $maxrow++; 1781: $f{'A'.$maxrow}=$_; 1782: } 1783: } 1784: if ($changed) { &setformulas($safeeval,%f); } 1785: # 1786: &setmaxrow($safeeval,$maxrow); 1787: &setrowlabels($safeeval,%currentlist); 1788: } 1789: 1790: # ----------------------------------- Update rows for student and assess sheets 1791: 1792: sub updatestudentassesssheet { 1793: my $safeeval=shift; 1794: my %bighash; 1795: my $stype=&gettype($safeeval); 1796: my %current=(); 1797: unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) { 1798: # -------------------------------------------------------------------- Tie hash 1799: if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', 1800: &GDBM_READER(),0640)) { 1801: # --------------------------------------------------------- Get all assessments 1802: 1803: my %allkeys=('timestamp' => 1804: 'Timestamp of Last Transaction<br>timestamp', 1805: 'subnumber' => 1806: 'Number of Submissions<br>subnumber', 1807: 'tutornumber' => 1808: 'Number of Tutor Responses<br>tutornumber', 1809: 'totalpoints' => 1810: 'Total Points Granted<br>totalpoints'); 1811: 1812: my $adduserstr=''; 1813: if ((&getuname($safeeval) ne $ENV{'user.name'}) || 1814: (&getudom($safeeval) ne $ENV{'user.domain'})) { 1815: $adduserstr='&uname='.&getuname($safeeval). 1816: '&udom='.&getudom($safeeval); 1817: } 1818: 1819: my %allassess=('_feedback' => 1820: '<a href="/adm/assesscalc?usymb=_feedback'.$adduserstr. 1821: '">Feedback</a>', 1822: '_evaluation' => 1823: '<a href="/adm/assesscalc?usymb=_evaluation'.$adduserstr. 1824: '">Evaluation</a>', 1825: '_tutoring' => 1826: '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr. 1827: '">Tutoring</a>', 1828: '_discussion' => 1829: '<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr. 1830: '">Discussion</a>' 1831: ); 1832: 1833: foreach (keys(%bighash)) { 1834: if ($_=~/^src\_(\d+)\.(\d+)$/) { 1835: my $mapid=$1; 1836: my $resid=$2; 1837: my $id=$mapid.'.'.$resid; 1838: my $srcf=$bighash{$_}; 1839: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { 1840: my $symb= 1841: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). 1842: '___'.$resid.'___'. 1843: &Apache::lonnet::declutter($srcf); 1844: $allassess{$symb}= 1845: '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. 1846: $bighash{'title_'.$id}.'</a>'; 1847: if ($stype eq 'assesscalc') { 1848: foreach (split(/\,/, 1849: &Apache::lonnet::metadata($srcf,'keys'))) { 1850: if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) { 1851: my $key=$_; 1852: my $display= 1853: &Apache::lonnet::metadata($srcf,$key.'.display'); 1854: unless ($display) { 1855: $display.= 1856: &Apache::lonnet::metadata($srcf,$key.'.name'); 1857: } 1858: $display.='<br>'.$key; 1859: $allkeys{$key}=$display; 1860: } 1861: } # end of foreach 1862: } 1863: } 1864: } 1865: } # end of foreach (keys(%bighash)) 1866: untie(%bighash); 1867: 1868: # 1869: # %allkeys has a list of storage and parameter displays by unikey 1870: # %allassess has a list of all resource displays by symb 1871: # 1872: 1873: if ($stype eq 'assesscalc') { 1874: %current=%allkeys; 1875: } elsif ($stype eq 'studentcalc') { 1876: %current=%allassess; 1877: } 1878: $updatedata{$ENV{'request.course.fn'}.'_'.$stype}= 1879: join('___;___',%current); 1880: } else { 1881: return 'Could not access course data'; 1882: } 1883: # ------------------------------------------------------ Get current from cache 1884: } else { 1885: %current=split(/\_\_\_\;\_\_\_/, 1886: $updatedata{$ENV{'request.course.fn'}.'_'.$stype}); 1887: } 1888: # -------------------- Find discrepancies between the course row table and this 1889: # 1890: my %f=&getformulas($safeeval); 1891: my $changed=0; 1892: 1893: my $maxrow=0; 1894: my %existing=(); 1895: 1896: # ----------------------------------------------------------- Now obsolete rows 1897: foreach (keys(%f)) { 1898: if ($_=~/^A(\d+)/) { 1899: $maxrow=($1>$maxrow)?$1:$maxrow; 1900: my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); 1901: $existing{$usy}=1; 1902: unless ((defined($current{$usy})) || (!$1) || 1903: ($f{$_}=~/^(\~\~\~|\-\-\-)/)){ 1904: $f{$_}='!!! Obsolete'; 1905: $changed=1; 1906: } elsif ($ufn) { 1907: $current{$usy} 1908: =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; 1909: } 1910: } 1911: } 1912: 1913: # -------------------------------------------------------- New and unknown keys 1914: 1915: foreach (keys(%current)) { 1916: unless ($existing{$_}) { 1917: $changed=1; 1918: $maxrow++; 1919: $f{'A'.$maxrow}=$_; 1920: } 1921: } 1922: 1923: if ($changed) { &setformulas($safeeval,%f); } 1924: 1925: &setmaxrow($safeeval,$maxrow); 1926: &setrowlabels($safeeval,%current); 1927: 1928: undef %current; 1929: undef %existing; 1930: } 1931: 1932: # ------------------------------------------------ Load data for one assessment 1933: 1934: sub loadstudent { 1935: my $safeeval=shift; 1936: my %c=(); 1937: my %f=&getformulas($safeeval); 1938: $cachedassess=&getuname($safeeval).':'.&getudom($safeeval); 1939: # Get ALL the student preformance data 1940: my @tmp = &Apache::lonnet::dump(&getcid($safeeval), 1941: &getudom($safeeval), 1942: &getuname($safeeval), 1943: undef); 1944: if ($tmp[0] !~ /^error:/) { 1945: %cachedstores = @tmp; 1946: } 1947: undef @tmp; 1948: # 1949: my @assessdata=(); 1950: foreach (keys(%f)) { 1951: if ($_=~/^A(\d+)/) { 1952: my $row=$1; 1953: unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) { 1954: my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); 1955: @assessdata=&exportsheet(&getuname($safeeval), 1956: &getudom($safeeval), 1957: 'assesscalc',$usy,$ufn); 1958: my $index=0; 1959: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 1960: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 1961: if ($assessdata[$index]) { 1962: my $col=$_; 1963: if ($assessdata[$index]=~/\D/) { 1964: $c{$col.$row}="'".$assessdata[$index]."'"; 1965: } else { 1966: $c{$col.$row}=$assessdata[$index]; 1967: } 1968: unless ($col eq 'A') { 1969: $f{$col.$row}='import'; 1970: } 1971: } 1972: $index++; 1973: } 1974: } 1975: } 1976: } 1977: $cachedassess=''; 1978: undef %cachedstores; 1979: &setformulas($safeeval,%f); 1980: &setconstants($safeeval,%c); 1981: } 1982: 1983: # --------------------------------------------------- Load data for one student 1984: 1985: sub loadcourse { 1986: my ($safeeval,$r)=@_; 1987: my %c=(); 1988: my %f=&getformulas($safeeval); 1989: my $total=0; 1990: foreach (keys(%f)) { 1991: if ($_=~/^A(\d+)/) { 1992: unless ($f{$_}=~/^[\!\~\-]/) { $total++; } 1993: } 1994: } 1995: my $now=0; 1996: my $since=time; 1997: $r->print(<<ENDPOP); 1998: <script> 1999: popwin=open('','popwin','width=400,height=100'); 2000: popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+ 2001: '<h3>Spreadsheet Calculation Progress</h3>'+ 2002: '<form name=popremain>'+ 2003: '<input type=text size=35 name=remaining value=Starting></form>'+ 2004: '</body></html>'); 2005: popwin.document.close(); 2006: </script> 2007: ENDPOP 2008: $r->rflush(); 2009: foreach (keys(%f)) { 2010: if ($_=~/^A(\d+)/) { 2011: my $row=$1; 2012: unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) { 2013: my @studentdata=&exportsheet(split(/\:/,$f{$_}), 2014: 'studentcalc'); 2015: undef %userrdatas; 2016: $now++; 2017: $r->print('<script>popwin.document.popremain.remaining.value="'. 2018: $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). 2019: ' secs remaining";</script>'); 2020: $r->rflush(); 2021: 2022: my $index=0; 2023: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 2024: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 2025: if ($studentdata[$index]) { 2026: my $col=$_; 2027: if ($studentdata[$index]=~/\D/) { 2028: $c{$col.$row}="'".$studentdata[$index]."'"; 2029: } else { 2030: $c{$col.$row}=$studentdata[$index]; 2031: } 2032: unless ($col eq 'A') { 2033: $f{$col.$row}='import'; 2034: } 2035: } 2036: $index++; 2037: } 2038: } 2039: } 2040: } 2041: &setformulas($safeeval,%f); 2042: &setconstants($safeeval,%c); 2043: $r->print('<script>popwin.close()</script>'); 2044: $r->rflush(); 2045: } 2046: 2047: # ------------------------------------------------ Load data for one assessment 2048: 2049: sub loadassessment { 2050: my $safeeval=shift; 2051: 2052: my $uhome=&getuhome($safeeval); 2053: my $uname=&getuname($safeeval); 2054: my $udom=&getudom($safeeval); 2055: my $symb=&getusymb($safeeval); 2056: my $cid=&getcid($safeeval); 2057: my $cnum=&getcnum($safeeval); 2058: my $cdom=&getcdom($safeeval); 2059: my $chome=&getchome($safeeval); 2060: 2061: my $namespace; 2062: unless ($namespace=$cid) { return ''; } 2063: 2064: # ----------------------------------------------------------- Get stored values 2065: 2066: my %returnhash=(); 2067: 2068: if ($cachedassess eq $uname.':'.$udom) { 2069: # 2070: # get data out of the dumped stores 2071: # 2072: 2073: my $version=$cachedstores{'version:'.$symb}; 2074: my $scope; 2075: for ($scope=1;$scope<=$version;$scope++) { 2076: foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { 2077: $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; 2078: } 2079: } 2080: 2081: } else { 2082: # 2083: # restore individual 2084: # 2085: 2086: my $answer=&Apache::lonnet::reply( 2087: "restore:$udom:$uname:". 2088: &Apache::lonnet::escape($namespace).":". 2089: &Apache::lonnet::escape($symb),$uhome); 2090: foreach (split(/\&/,$answer)) { 2091: my ($name,$value)=split(/\=/,$_); 2092: $returnhash{&Apache::lonnet::unescape($name)}= 2093: &Apache::lonnet::unescape($value); 2094: } 2095: my $version; 2096: for ($version=1;$version<=$returnhash{'version'};$version++) { 2097: foreach (split(/\:/,$returnhash{$version.':keys'})) { 2098: $returnhash{$_}=$returnhash{$version.':'.$_}; 2099: } 2100: } 2101: } 2102: # ----------------------------- returnhash now has all stores for this resource 2103: 2104: # --------- convert all "_" to "." to be able to use libraries, multiparts, etc 2105: 2106: my @oldkeys=keys %returnhash; 2107: 2108: foreach (@oldkeys) { 2109: my $name=$_; 2110: my $value=$returnhash{$_}; 2111: delete $returnhash{$_}; 2112: $name=~s/\_/\./g; 2113: $returnhash{$name}=$value; 2114: } 2115: 2116: # ---------------------------- initialize coursedata and userdata for this user 2117: undef %courseopt; 2118: undef %useropt; 2119: 2120: my $userprefix=$uname.'_'.$udom.'_'; 2121: 2122: unless ($uhome eq 'no_host') { 2123: # -------------------------------------------------------------- Get coursedata 2124: unless 2125: ((time-$courserdatas{$cid.'.last_cache'})<240) { 2126: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum. 2127: ':resourcedata',$chome); 2128: if ($reply!~/^error\:/) { 2129: $courserdatas{$cid}=$reply; 2130: $courserdatas{$cid.'.last_cache'}=time; 2131: } 2132: } 2133: foreach (split(/\&/,$courserdatas{$cid})) { 2134: my ($name,$value)=split(/\=/,$_); 2135: $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= 2136: &Apache::lonnet::unescape($value); 2137: } 2138: # --------------------------------------------------- Get userdata (if present) 2139: unless 2140: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { 2141: my $reply= 2142: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); 2143: if ($reply!~/^error\:/) { 2144: $userrdatas{$uname.'___'.$udom}=$reply; 2145: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time; 2146: } 2147: } 2148: foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { 2149: my ($name,$value)=split(/\=/,$_); 2150: $useropt{$userprefix.&Apache::lonnet::unescape($name)}= 2151: &Apache::lonnet::unescape($value); 2152: } 2153: } 2154: # ----------------- now courseopt, useropt initialized for this user and course 2155: # (used by parmval) 2156: 2157: # 2158: # Load keys for this assessment only 2159: # 2160: my %thisassess=(); 2161: my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); 2162: 2163: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { 2164: $thisassess{$_}=1; 2165: } 2166: # 2167: # Load parameters 2168: # 2169: my %c=(); 2170: 2171: if (tie(%parmhash,'GDBM_File', 2172: &getcfn($safeeval).'_parms.db',&GDBM_READER(),0640)) { 2173: my %f=&getformulas($safeeval); 2174: foreach (keys(%f)) { 2175: if ($_=~/^A/) { 2176: unless ($f{$_}=~/^[\!\~\-]/) { 2177: if ($f{$_}=~/^parameter/) { 2178: if ($thisassess{$f{$_}}) { 2179: my $val=&parmval($f{$_},$safeeval); 2180: $c{$_}=$val; 2181: $c{$f{$_}}=$val; 2182: } 2183: } else { 2184: my $key=$f{$_}; 2185: my $ckey=$key; 2186: $key=~s/^stores\_/resource\./; 2187: $key=~s/\_/\./g; 2188: $c{$_}=$returnhash{$key}; 2189: $c{$ckey}=$returnhash{$key}; 2190: } 2191: } 2192: } 2193: } 2194: untie(%parmhash); 2195: } 2196: &setconstants($safeeval,%c); 2197: } 2198: 2199: # --------------------------------------------------------- Various form fields 2200: 2201: sub textfield { 2202: my ($title,$name,$value)=@_; 2203: return "\n<p><b>$title:</b><br>". 2204: '<input type=text name="'.$name.'" size=80 value="'.$value.'">'; 2205: } 2206: 2207: sub hiddenfield { 2208: my ($name,$value)=@_; 2209: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">'; 2210: } 2211: 2212: sub selectbox { 2213: my ($title,$name,$value,%options)=@_; 2214: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">'; 2215: foreach (sort keys(%options)) { 2216: $selout.='<option value="'.$_.'"'; 2217: if ($_ eq $value) { $selout.=' selected'; } 2218: $selout.='>'.$options{$_}.'</option>'; 2219: } 2220: return $selout.'</select>'; 2221: } 2222: 2223: # =============================================== Update information in a sheet 2224: # 2225: # Add new users or assessments, etc. 2226: # 2227: 2228: sub updatesheet { 2229: my $safeeval=shift; 2230: my $stype=&gettype($safeeval); 2231: if ($stype eq 'classcalc') { 2232: return &updateclasssheet($safeeval); 2233: } else { 2234: return &updatestudentassesssheet($safeeval); 2235: } 2236: } 2237: 2238: # =================================================== Load the rows for a sheet 2239: # 2240: # Import the data for rows 2241: # 2242: 2243: sub loadrows { 2244: my ($safeeval,$r)=@_; 2245: my $stype=&gettype($safeeval); 2246: if ($stype eq 'classcalc') { 2247: &loadcourse($safeeval,$r); 2248: } elsif ($stype eq 'studentcalc') { 2249: &loadstudent($safeeval); 2250: } else { 2251: &loadassessment($safeeval); 2252: } 2253: } 2254: 2255: # ======================================================= Forced recalculation? 2256: 2257: sub checkthis { 2258: my ($keyname,$time)=@_; 2259: return ($time<$expiredates{$keyname}); 2260: } 2261: sub forcedrecalc { 2262: my ($uname,$udom,$stype,$usymb)=@_; 2263: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 2264: my $time=$oldsheets{$key.'.time'}; 2265: if ($ENV{'form.forcerecalc'}) { return 1; } 2266: unless ($time) { return 1; } 2267: if ($stype eq 'assesscalc') { 2268: my $map=(split(/\_\_\_/,$usymb))[0]; 2269: if (&checkthis('::assesscalc:',$time) || 2270: &checkthis('::assesscalc:'.$map,$time) || 2271: &checkthis('::assesscalc:'.$usymb,$time) || 2272: &checkthis($uname.':'.$udom.':assesscalc:',$time) || 2273: &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || 2274: &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { 2275: return 1; 2276: } 2277: } else { 2278: if (&checkthis('::studentcalc:',$time) || 2279: &checkthis($uname.':'.$udom.':studentcalc:',$time)) { 2280: return 1; 2281: } 2282: } 2283: return 0; 2284: } 2285: 2286: # ============================================================== Export handler 2287: # 2288: # Non-interactive call from with program 2289: # 2290: 2291: sub exportsheet { 2292: my ($uname,$udom,$stype,$usymb,$fn)=@_; 2293: my @exportarr=(); 2294: 2295: if (($usymb=~/^\_(\w+)/) && (!$fn)) { 2296: $fn='default_'.$1; 2297: } 2298: 2299: # 2300: # Check if cached 2301: # 2302: 2303: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 2304: my $found=''; 2305: 2306: if ($oldsheets{$key}) { 2307: foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { 2308: my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); 2309: if ($name eq $fn) { 2310: $found=$value; 2311: } 2312: } 2313: } 2314: 2315: unless ($found) { 2316: &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); 2317: if ($oldsheets{$key}) { 2318: foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { 2319: my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); 2320: if ($name eq $fn) { 2321: $found=$value; 2322: } 2323: } 2324: } 2325: } 2326: # 2327: # Check if still valid 2328: # 2329: if ($found) { 2330: if (&forcedrecalc($uname,$udom,$stype,$usymb)) { 2331: $found=''; 2332: } 2333: } 2334: 2335: if ($found) { 2336: # 2337: # Return what was cached 2338: # 2339: @exportarr=split(/\_\_\_\;\_\_\_/,$found); 2340: 2341: } else { 2342: # 2343: # Not cached 2344: # 2345: 2346: my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb); 2347: &readsheet($thissheet,$fn); 2348: &updatesheet($thissheet); 2349: &loadrows($thissheet); 2350: &calcsheet($thissheet); 2351: @exportarr=&exportdata($thissheet); 2352: # 2353: # Store now 2354: # 2355: my $cid=$ENV{'request.course.id'}; 2356: my $current=''; 2357: if ($stype eq 'studentcalc') { 2358: $current=&Apache::lonnet::reply('get:'. 2359: $ENV{'course.'.$cid.'.domain'}.':'. 2360: $ENV{'course.'.$cid.'.num'}. 2361: ':nohist_calculatedsheets:'. 2362: &Apache::lonnet::escape($key), 2363: $ENV{'course.'.$cid.'.home'}); 2364: } else { 2365: $current=&Apache::lonnet::reply('get:'. 2366: &getudom($thissheet).':'. 2367: &getuname($thissheet). 2368: ':nohist_calculatedsheets_'. 2369: $ENV{'request.course.id'}.':'. 2370: &Apache::lonnet::escape($key), 2371: &getuhome($thissheet)); 2372: 2373: } 2374: my %currentlystored=(); 2375: unless ($current=~/^error\:/) { 2376: foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) { 2377: my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); 2378: $currentlystored{$name}=$value; 2379: } 2380: } 2381: $currentlystored{$fn}=join('___;___',@exportarr); 2382: 2383: my $newstore=''; 2384: foreach (keys(%currentlystored)) { 2385: if ($newstore) { $newstore.='___&___'; } 2386: $newstore.=$_.'___=___'.$currentlystored{$_}; 2387: } 2388: my $now=time; 2389: if ($stype eq 'studentcalc') { 2390: &Apache::lonnet::reply('put:'. 2391: $ENV{'course.'.$cid.'.domain'}.':'. 2392: $ENV{'course.'.$cid.'.num'}. 2393: ':nohist_calculatedsheets:'. 2394: &Apache::lonnet::escape($key).'='. 2395: &Apache::lonnet::escape($newstore).'&'. 2396: &Apache::lonnet::escape($key).'.time='.$now, 2397: $ENV{'course.'.$cid.'.home'}); 2398: } else { 2399: &Apache::lonnet::reply('put:'. 2400: &getudom($thissheet).':'. 2401: &getuname($thissheet). 2402: ':nohist_calculatedsheets_'. 2403: $ENV{'request.course.id'}.':'. 2404: &Apache::lonnet::escape($key).'='. 2405: &Apache::lonnet::escape($newstore).'&'. 2406: &Apache::lonnet::escape($key).'.time='.$now, 2407: &getuhome($thissheet)); 2408: } 2409: } 2410: return @exportarr; 2411: } 2412: # ============================================================ Expiration Dates 2413: # 2414: # Load previously cached student spreadsheets for this course 2415: # 2416: 2417: sub expirationdates { 2418: undef %expiredates; 2419: my $cid=$ENV{'request.course.id'}; 2420: my $reply=&Apache::lonnet::reply('dump:'. 2421: $ENV{'course.'.$cid.'.domain'}.':'. 2422: $ENV{'course.'.$cid.'.num'}. 2423: ':nohist_expirationdates', 2424: $ENV{'course.'.$cid.'.home'}); 2425: unless ($reply=~/^error\:/) { 2426: foreach (split(/\&/,$reply)) { 2427: my ($name,$value)=split(/\=/,$_); 2428: $expiredates{&Apache::lonnet::unescape($name)} 2429: =&Apache::lonnet::unescape($value); 2430: } 2431: } 2432: } 2433: 2434: # ===================================================== Calculated sheets cache 2435: # 2436: # Load previously cached student spreadsheets for this course 2437: # 2438: 2439: sub cachedcsheets { 2440: my $cid=$ENV{'request.course.id'}; 2441: my $reply=&Apache::lonnet::reply('dump:'. 2442: $ENV{'course.'.$cid.'.domain'}.':'. 2443: $ENV{'course.'.$cid.'.num'}. 2444: ':nohist_calculatedsheets', 2445: $ENV{'course.'.$cid.'.home'}); 2446: unless ($reply=~/^error\:/) { 2447: foreach ( split(/\&/,$reply)) { 2448: my ($name,$value)=split(/\=/,$_); 2449: $oldsheets{&Apache::lonnet::unescape($name)} 2450: =&Apache::lonnet::unescape($value); 2451: } 2452: } 2453: } 2454: 2455: # ===================================================== Calculated sheets cache 2456: # 2457: # Load previously cached assessment spreadsheets for this student 2458: # 2459: 2460: sub cachedssheets { 2461: my ($sname,$sdom,$shome)=@_; 2462: unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) { 2463: my $cid=$ENV{'request.course.id'}; 2464: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname. 2465: ':nohist_calculatedsheets_'. 2466: $ENV{'request.course.id'}, 2467: $shome); 2468: unless ($reply=~/^error\:/) { 2469: foreach ( split(/\&/,$reply)) { 2470: my ($name,$value)=split(/\=/,$_); 2471: $oldsheets{&Apache::lonnet::unescape($name)} 2472: =&Apache::lonnet::unescape($value); 2473: } 2474: } 2475: $loadedcaches{$sname.'_'.$sdom}=1; 2476: } 2477: } 2478: 2479: # ===================================================== Calculated sheets cache 2480: # 2481: # Load previously cached assessment spreadsheets for this student 2482: # 2483: 2484: # ================================================================ Main handler 2485: # 2486: # Interactive call to screen 2487: # 2488: # 2489: 2490: 2491: sub handler { 2492: my $r=shift; 2493: 2494: if ($r->header_only) { 2495: $r->content_type('text/html'); 2496: $r->send_http_header; 2497: return OK; 2498: } 2499: 2500: # ---------------------------------------------------- Global directory configs 2501: 2502: $includedir=$r->dir_config('lonIncludes'); 2503: $tmpdir=$r->dir_config('lonDaemons').'/tmp/'; 2504: 2505: # ----------------------------------------------------- Needs to be in a course 2506: 2507: if ($ENV{'request.course.fn'}) { 2508: 2509: # --------------------------- Get query string for limited number of parameters 2510: 2511: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 2512: ['uname','udom','usymb','ufn']); 2513: 2514: if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { 2515: $ENV{'form.ufn'}='default_'.$1; 2516: } 2517: 2518: # -------------------------------------- Interactive loading of specific sheet? 2519: if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { 2520: $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; 2521: } 2522: # ------------------------------------------- Nothing there? Must be login user 2523: 2524: my $aname; 2525: my $adom; 2526: 2527: unless ($ENV{'form.uname'}) { 2528: $aname=$ENV{'user.name'}; 2529: $adom=$ENV{'user.domain'}; 2530: } else { 2531: $aname=$ENV{'form.uname'}; 2532: $adom=$ENV{'form.udom'}; 2533: } 2534: 2535: # ------------------------------------------------------------------- Open page 2536: 2537: $r->content_type('text/html'); 2538: $r->header_out('Cache-control','no-cache'); 2539: $r->header_out('Pragma','no-cache'); 2540: $r->send_http_header; 2541: 2542: # --------------------------------------------------------------- Screen output 2543: 2544: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); 2545: $r->print(<<ENDSCRIPT); 2546: <script language="JavaScript"> 2547: 2548: function celledit(cn,cf) { 2549: var cnf=prompt(cn,cf); 2550: if (cnf!=null) { 2551: document.sheet.unewfield.value=cn; 2552: document.sheet.unewformula.value=cnf; 2553: document.sheet.submit(); 2554: } 2555: } 2556: 2557: function changesheet(cn) { 2558: document.sheet.unewfield.value=cn; 2559: document.sheet.unewformula.value='changesheet'; 2560: document.sheet.submit(); 2561: } 2562: 2563: function insertrow(cn) { 2564: document.sheet.unewfield.value='insertrow'; 2565: document.sheet.unewformula.value=cn; 2566: document.sheet.submit(); 2567: } 2568: 2569: </script> 2570: ENDSCRIPT 2571: $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). 2572: '<form action="'.$r->uri.'" name=sheet method=post>'. 2573: &hiddenfield('uname',$ENV{'form.uname'}). 2574: &hiddenfield('udom',$ENV{'form.udom'}). 2575: &hiddenfield('usymb',$ENV{'form.usymb'}). 2576: &hiddenfield('unewfield',''). 2577: &hiddenfield('unewformula','')); 2578: 2579: # ---------------------- Make sure that this gets out, even if user hits "stop" 2580: 2581: $r->rflush(); 2582: 2583: # ---------------------------------------------------------------- Full recalc? 2584: 2585: 2586: if ($ENV{'form.forcerecalc'}) { 2587: $r->print('<h4>Completely Recalculating Sheet ...</h4>'); 2588: undef %spreadsheets; 2589: undef %courserdatas; 2590: undef %userrdatas; 2591: undef %defaultsheets; 2592: undef %updatedata; 2593: } 2594: 2595: # ---------------------------------------- Read new sheet or modified worksheet 2596: 2597: $r->uri=~/\/(\w+)$/; 2598: 2599: my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); 2600: 2601: # ------------------------ If a new formula had been entered, go from work copy 2602: 2603: if ($ENV{'form.unewfield'}) { 2604: $r->print('<h2>Modified Workcopy</h2>'); 2605: $ENV{'form.unewformula'}=~s/\'/\"/g; 2606: $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='. 2607: $ENV{'form.unewformula'}.'<p>'); 2608: &setfilename($asheet,$ENV{'form.ufn'}); 2609: &tmpread($asheet, 2610: $ENV{'form.unewfield'},$ENV{'form.unewformula'}); 2611: 2612: } elsif ($ENV{'form.saveas'}) { 2613: &setfilename($asheet,$ENV{'form.ufn'}); 2614: &tmpread($asheet); 2615: } else { 2616: &readsheet($asheet,$ENV{'form.ufn'}); 2617: } 2618: 2619: # -------------------------------------------------- Print out user information 2620: 2621: unless (&gettype($asheet) eq 'classcalc') { 2622: $r->print('<p><b>User:</b> '.&getuname($asheet). 2623: '<br><b>Domain:</b> '.&getudom($asheet)); 2624: if (&getcsec($asheet) eq '-1') { 2625: $r->print('<h3><font color=red>'. 2626: 'Not a student in this course</font></h3>'); 2627: } else { 2628: $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet)); 2629: } 2630: if ($ENV{'form.usymb'}) { 2631: $r->print('<br><b>Assessment:</b> <tt>'.$ENV{'form.usymb'}.'</tt>'); 2632: } 2633: } 2634: 2635: # ---------------------------------------------------- See if user can see this 2636: 2637: if ((&gettype($asheet) eq 'classcalc') || 2638: (&getuname($asheet) ne $ENV{'user.name'}) || 2639: (&getudom($asheet) ne $ENV{'user.domain'})) { 2640: unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) { 2641: $r->print( 2642: '<h1>Access Permission Denied</h1></form></body></html>'); 2643: return OK; 2644: } 2645: } 2646: 2647: # ---------------------------------------------------------- Additional options 2648: 2649: $r->print( 2650: '<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>' 2651: ); 2652: if (&gettype($asheet) eq 'assesscalc') { 2653: $r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='. 2654: &getuname($asheet). 2655: '&udom='.&getudom($asheet). 2656: '">Level up: Student Sheet</a></font><p>'); 2657: } 2658: 2659: if ((&gettype($asheet) eq 'studentcalc') && 2660: (&Apache::lonnet::allowed('vgr',&getcid($asheet)))) { 2661: $r->print ( 2662: '<p><font size=+2><a href="/adm/classcalc">'. 2663: 'Level up: Course Sheet</a></font><p>'); 2664: } 2665: 2666: 2667: # ----------------------------------------------------------------- Save dialog 2668: 2669: 2670: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2671: my $fname=$ENV{'form.ufn'}; 2672: $fname=~s/\_[^\_]+$//; 2673: if ($fname eq 'default') { $fname='course_default'; } 2674: $r->print('<input type=submit name=saveas value="Save as ...">'. 2675: '<input type=text size=20 name=newfn value="'.$fname. 2676: '"> (make default: <input type=checkbox name="makedefufn">)<p>'); 2677: } 2678: 2679: $r->print(&hiddenfield('ufn',&getfilename($asheet))); 2680: 2681: # ----------------------------------------------------------------- Load dialog 2682: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2683: $r->print('<p><input type=submit name=load value="Load ...">'. 2684: '<select name="loadthissheet">'. 2685: '<option name="default">Default</option>'); 2686: foreach (&othersheets($asheet,&gettype($asheet))) { 2687: $r->print('<option name="'.$_.'"'); 2688: if ($ENV{'form.ufn'} eq $_) { 2689: $r->print(' selected'); 2690: } 2691: $r->print('>'.$_.'</option>'); 2692: } 2693: $r->print('</select><p>'); 2694: if (&gettype($asheet) eq 'studentcalc') { 2695: &setothersheets($asheet,&othersheets($asheet,'assesscalc')); 2696: } 2697: } 2698: 2699: # --------------------------------------------------------------- Cached sheets 2700: 2701: &expirationdates(); 2702: 2703: undef %oldsheets; 2704: undef %loadedcaches; 2705: 2706: if (&gettype($asheet) eq 'classcalc') { 2707: $r->print("Loading previously calculated student sheets ...<br>\n"); 2708: $r->rflush(); 2709: &cachedcsheets(); 2710: } elsif (&gettype($asheet) eq 'studentcalc') { 2711: $r->print("Loading previously calculated assessment sheets ...<br>\n"); 2712: $r->rflush(); 2713: &cachedssheets(&getuname($asheet),&getudom($asheet), 2714: &getuhome($asheet)); 2715: } 2716: 2717: # ----------------------------------------------------- Update sheet, load rows 2718: 2719: $r->print("Loaded sheet(s), updating rows ...<br>\n"); 2720: $r->rflush(); 2721: 2722: &updatesheet($asheet); 2723: 2724: $r->print("Updated rows, loading row data ...<br>\n"); 2725: $r->rflush(); 2726: 2727: &loadrows($asheet,$r); 2728: 2729: $r->print("Loaded row data, calculating sheet ...<br>\n"); 2730: $r->rflush(); 2731: 2732: my $calcoutput=&calcsheet($asheet); 2733: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); 2734: 2735: # ---------------------------------------------------- See if something to save 2736: 2737: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2738: my $fname=''; 2739: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { 2740: $fname=~s/\W/\_/g; 2741: if ($fname eq 'default') { $fname='course_default'; } 2742: $fname.='_'.&gettype($asheet); 2743: &setfilename($asheet,$fname); 2744: $ENV{'form.ufn'}=$fname; 2745: $r->print('<p>Saving spreadsheet: '. 2746: &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>'); 2747: } 2748: } 2749: 2750: # ------------------------------------------------ Write the modified worksheet 2751: 2752: $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>'); 2753: 2754: &tmpwrite($asheet); 2755: 2756: if (&gettype($asheet) eq 'studentcalc') { 2757: $r->print('<br>Show rows with empty A column: '); 2758: } else { 2759: $r->print('<br>Show empty rows: '); 2760: } 2761: 2762: $r->print(&hiddenfield('userselhidden','true'). 2763: '<input type=checkbox name=showall onClick="submit()"'); 2764: 2765: if ($ENV{'form.showall'}) { 2766: $r->print(' checked'); 2767: } else { 2768: unless ($ENV{'form.userselhidden'}) { 2769: unless 2770: ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') { 2771: $r->print(' checked'); 2772: $ENV{'form.showall'}=1; 2773: } 2774: } 2775: } 2776: $r->print('>'); 2777: 2778: if (&gettype($asheet) eq 'classcalc') { 2779: $r->print( 2780: ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"'); 2781: if ($ENV{'form.showcsv'}) { $r->print(' checked'); } 2782: $r->print('>'); 2783: } 2784: 2785: # ------------------------------------------------------------------ Insertrows 2786: $r->print(' Student Status: '. 2787: &Apache::lonhtmlcommon::StatusOptions 2788: ($ENV{'form.Status'},'sheet')); 2789: 2790: $r->print(<<ENDINSERTBUTTONS); 2791: <br> 2792: <input type='button' onClick='insertrow("top");' 2793: value='Insert Row Top'> 2794: <input type='button' onClick='insertrow("bottom");' 2795: value='Insert Row Bottom'><br> 2796: ENDINSERTBUTTONS 2797: 2798: # ------------------------------------------------------------- Print out sheet 2799: 2800: &outsheet($r,$asheet); 2801: $r->print('</form></body></html>'); 2802: 2803: # ------------------------------------------------------------------------ Done 2804: } else { 2805: # ----------------------------- Not in a course, or not allowed to modify parms 2806: $ENV{'user.error.msg'}= 2807: $r->uri.":opa:0:0:Cannot modify spreadsheet"; 2808: return HTTP_NOT_ACCEPTABLE; 2809: } 2810: return OK; 2811: 2812: } 2813: 2814: 1; 2815: __END__ 2816: 2817: 2818: 2819: