loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.135: download - view: text, annotated - select for diffs
Thu Nov 7 15:37:02 2002 UTC (21 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Added "Multi-Sheet Excel" output.  Tested on small class, not on large.
Broke the Excel handling routines into smaller pieces to facilitate this.
Multi-Sheet Excel (recursive excel as it is known internally) is only
available at the course sheet level.

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