loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.122: download - view: text, annotated - select for diffs
Tue Oct 22 13:29:57 2002 UTC (21 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Moved &templaterow, &outrow, and &outrowassess outside the safe space.
Rewrote part of &rown to make this work.  Changed the calling structure of
&setconstants to something a little more (Perl) object-like.

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