loncom/interface/lonspreadsheet.pm - view

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

Fixes bug which caused some cells to not be exported up from the student
spreadsheet.  &exportdata was modified to not return values of undef.
&loadcourse was modified to use named parameters to pass values to
&exportsheet.  It was also modified to do a if (defined(*value*)) instead of
if (*value).  Some strings appearantly are false, despite being nonzero and
of non-zero length.

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