loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.105: download - view: text, annotated - select for diffs
Fri Aug 30 20:56:08 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Attempt to reduce calls into the safe space by keeping two sets of books.
Added use of $sheetdata and $asheetdata, which required changes to most
functions used outside of the safe space.  This code should be considered
beta (at best).  It runs, presumedly, but I wouldn't use it during a demo.

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