loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.133: download - view: text, annotated - select for diffs
Tue Nov 5 15:00:27 2002 UTC (21 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

CSV download now works as it used to.
Removed debugging code from html_editable_cell.
Fixed bug which caused cells which had only whitespace as a value to be
uneditable.
Broke &format_rowlabel into
&format_html_rowlabel, &format_csv_rowlabel, and &format_plain_rowlabel
Added meat to &outsheet_csv (look at how short it is!)
Modified &outsheet to call &outsheet_csv or &outsheet_html

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