loncom/interface/lonspreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.134: download - view: text, annotated - select for diffs
Wed Nov 6 20:00:13 2002 UTC (21 years, 6 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Module now uses Spreadsheet::WriteExcel
csv download now writes to a temp file in the prtspool directory and serves
up a link to the user.
Excel output is now available - &outsheet_excel writes the currently
displayed spreadsheet to an excel file in the prtspool directory and gives the
user a link.
&format_plain_rowlabel has been renamed and rewritten to &format_excel_rowlabel
The output method is now specified with a <select /> form.  html is the
default.
The buttons to insert rows in the spreadsheet have been removed temporarily.

1: # 2: # $Id: lonspreadsheet.pm,v 1.134 2002/11/06 20:00:13 matthew Exp $ 3: # 4: # Copyright Michigan State University Board of Trustees 5: # 6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 7: # 8: # LON-CAPA is free software; you can redistribute it and/or modify 9: # it under the terms of the GNU General Public License as published by 10: # the Free Software Foundation; either version 2 of the License, or 11: # (at your option) any later version. 12: # 13: # LON-CAPA is distributed in the hope that it will be useful, 14: # but WITHOUT ANY WARRANTY; without even the implied warranty of 15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16: # GNU General Public License for more details. 17: # 18: # You should have received a copy of the GNU General Public License 19: # along with LON-CAPA; if not, write to the Free Software 20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 21: # 22: # /home/httpd/html/adm/gpl.txt 23: # 24: # http://www.lon-capa.org/ 25: # 26: # The LearningOnline Network with CAPA 27: # Spreadsheet/Grades Display Handler 28: # 29: # POD required stuff: 30: 31: =head1 NAME 32: 33: lonspreadsheet 34: 35: =head1 SYNOPSIS 36: 37: Spreadsheet interface to internal LON-CAPA data 38: 39: =head1 DESCRIPTION 40: 41: Lonspreadsheet provides course coordinators the ability to manage their 42: students grades online. The students are able to view their own grades, but 43: not the grades of their peers. The spreadsheet is highly customizable, 44: offering the ability to use Perl code to manipulate data, as well as many 45: built-in functions. 46: 47: =head2 Functions available to user of lonspreadsheet 48: 49: =over 4 50: 51: =cut 52: 53: package Apache::lonspreadsheet; 54: 55: use strict; 56: use Safe; 57: use Safe::Hole; 58: use Opcode; 59: use Apache::lonnet; 60: use Apache::Constants qw(:common :http); 61: use GDBM_File; 62: use HTML::TokeParser; 63: use Apache::lonhtmlcommon; 64: use Apache::loncoursedata; 65: 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: # 1114: # Procedures for screen output 1115: # 1116: # --------------------------------------------- Produce output row n from sheet 1117: 1118: sub get_row { 1119: my ($sheet,$n) = @_; 1120: my ($rowlabel,@rowdata); 1121: if ($n eq '-') { 1122: ($rowlabel,@rowdata) = &templaterow($sheet); 1123: } elsif ($sheet->{'sheettype'} eq 'studentcalc') { 1124: ($rowlabel,@rowdata) = &outrowassess($sheet,$n); 1125: } else { 1126: ($rowlabel,@rowdata) = &outrow($sheet,$n); 1127: } 1128: return ($rowlabel,@rowdata); 1129: } 1130: 1131: ######################################################################## 1132: ######################################################################## 1133: sub sort_indicies { 1134: my $sheet = shift; 1135: # 1136: # Sort the rows in some manner 1137: # 1138: my @sortby=(); 1139: my @sortidx=(); 1140: for (my $row=1;$row<=$sheet->{'maxrow'};$row++) { 1141: push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}')); 1142: push (@sortidx, $row); 1143: } 1144: @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx; 1145: return @sortidx; 1146: } 1147: 1148: ######################################################################## 1149: ######################################################################## 1150: 1151: sub html_editable_cell { 1152: my ($cell,$bgcolor) = @_; 1153: my $result; 1154: my ($name,$formula,$value); 1155: if (defined($cell)) { 1156: $name = $cell->{'name'}; 1157: $formula = $cell->{'formula'}; 1158: $value = $cell->{'value'}; 1159: } 1160: $name = '' if (! defined($name)); 1161: $formula = '' if (! defined($formula)); 1162: if (! defined($value)) { 1163: $value = '<font color="'.$bgcolor.'">#</font>'; 1164: if ($formula ne '') { 1165: $value = '<i>undefined value</i>'; 1166: } 1167: } 1168: if ($value =~ /^\s*$/ ) { 1169: $value = '<font color="'.$bgcolor.'">#</font>'; 1170: } 1171: $result .= '<a href="javascript:celledit(\''. 1172: $name.'\',\''.$formula.'\');">'.$value.'</a>'; 1173: return $result; 1174: } 1175: 1176: sub html_uneditable_cell { 1177: my ($cell,$bgcolor) = @_; 1178: my $value = (defined($cell) ? $cell->{'value'} : ''); 1179: return ' '.$value.' '; 1180: } 1181: 1182: ######################################################################## 1183: ######################################################################## 1184: 1185: sub outsheet_html { 1186: my ($sheet,$r) = @_; 1187: my ($num_uneditable,$realm,$row_type); 1188: if ($sheet->{'sheettype'} eq 'assesscalc') { 1189: $num_uneditable = 1; 1190: $realm = 'Assessment'; 1191: $row_type = 'Item'; 1192: } elsif ($sheet->{'sheettype'} eq 'studentcalc') { 1193: $num_uneditable = 26; 1194: $realm = 'User'; 1195: $row_type = 'Assessment'; 1196: } elsif ($sheet->{'sheettype'} eq 'classcalc') { 1197: $num_uneditable = 26; 1198: $realm = 'Course'; 1199: $row_type = 'Student'; 1200: } else { 1201: return; # error 1202: } 1203: #################################### 1204: # Print out header table 1205: #################################### 1206: my $num_left = 52-$num_uneditable; 1207: my $tabledata =<<"END"; 1208: <table border="2"> 1209: <tr> 1210: <th colspan="1" rowspan="2"><font size="+2">$realm</font></th> 1211: <td bgcolor="#FFDDDD" colspan="$num_uneditable"> 1212: <b><font size="+1">Import</font></b></td> 1213: <td colspan="$num_left"> 1214: <b><font size="+1">Calculations</font></b></td> 1215: </tr><tr> 1216: END 1217: my $label_num = 0; 1218: foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ 1219: if ($label_num<$num_uneditable) { 1220: $tabledata.='<td bgcolor="#FFDDDD">'; 1221: } else { 1222: $tabledata.='<td>'; 1223: } 1224: $tabledata.="<b><font size=+1>$_</font></b></td>"; 1225: $label_num++; 1226: } 1227: $tabledata.="</tr>\n"; 1228: $r->print($tabledata); 1229: #################################### 1230: # Print out template row 1231: #################################### 1232: my ($rowlabel,@rowdata) = &get_row($sheet,'-'); 1233: my $row_html = '<tr><td>'.&format_html_rowlabel($rowlabel).'</td>'; 1234: my $num_cols_output = 0; 1235: foreach my $cell (@rowdata) { 1236: if ($num_cols_output++ < $num_uneditable) { 1237: $row_html .= '<td bgcolor="#FFDDDD">'; 1238: $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); 1239: } else { 1240: $row_html .= '<td bgcolor="#EOFFDD">'; 1241: $row_html .= &html_editable_cell($cell,'#E0FFDD'); 1242: } 1243: $row_html .= '</td>'; 1244: } 1245: $row_html.= "</tr>\n"; 1246: $r->print($row_html); 1247: #################################### 1248: # Print out summary/export row 1249: #################################### 1250: my ($rowlabel,@rowdata) = &get_row($sheet,'0'); 1251: my $rowcount = 0; 1252: $row_html = '<tr><td>'.&format_html_rowlabel($rowlabel).'</td>'; 1253: $num_cols_output = 0; 1254: foreach my $cell (@rowdata) { 1255: if ($num_cols_output++ < 26) { 1256: $row_html .= '<td bgcolor="#CCCCFF">'; 1257: $row_html .= &html_editable_cell($cell,'#CCCCFF'); 1258: } else { 1259: $row_html .= '<td bgcolor="#DDCCFF">'; 1260: $row_html .= &html_uneditable_cell(undef,'#CCCCFF'); 1261: } 1262: $row_html .= '</td>'; 1263: } 1264: $row_html.= "</tr>\n"; 1265: $r->print($row_html); 1266: $r->print('</table>'); 1267: #################################### 1268: # Prepare to output rows 1269: #################################### 1270: my @Rows = &sort_indicies($sheet); 1271: # 1272: # Loop through the rows and output them one at a time 1273: my $rows_output=0; 1274: foreach my $rownum (@Rows) { 1275: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum); 1276: # 1277: my $defaultbg='#E0FF'; 1278: # 1279: my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum. 1280: '</font></b></td>'; 1281: # 1282: if ($sheet->{'sheettype'} eq 'classcalc') { 1283: $row_html.='<td>'.&format_html_rowlabel($rowlabel).'</td>'; 1284: # Output links for each student? 1285: # Nope, that is already done for us in format_html_rowlabel (for now) 1286: } elsif ($sheet->{'sheettype'} eq 'studentcalc') { 1287: $row_html.='<td>'.&format_html_rowlabel($rowlabel); 1288: $row_html.= '<br>'. 1289: '<select name="sel_'.$rownum.'" '. 1290: 'onChange="changesheet('.$rownum.')">'. 1291: '<option name="default">Default</option>'; 1292: foreach (@{$sheet->{'othersheets'}}) { 1293: $row_html.='<option name="'.$_.'"'; 1294: #if ($ufn eq $_) { 1295: # $row_html.=' selected'; 1296: #} 1297: $row_html.='>'.$_.'</option>'; 1298: } 1299: $row_html.='</select></td>'; 1300: } elsif ($sheet->{'sheettype'} eq 'assesscalc') { 1301: $row_html.='<td>'.&format_html_rowlabel($rowlabel).'</td>'; 1302: } 1303: # 1304: my $shown_cells = 0; 1305: foreach my $cell (@rowdata) { 1306: my $value = $cell->{'value'}; 1307: my $formula = $cell->{'formula'}; 1308: my $cellname = $cell->{'name'}; 1309: # 1310: my $bgcolor; 1311: if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) { 1312: $bgcolor = $defaultbg.'99'; 1313: } else { 1314: $bgcolor = $defaultbg.'DD'; 1315: } 1316: $bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable); 1317: # 1318: $row_html.='<td bgcolor='.$bgcolor.'>'; 1319: if ($shown_cells < $num_uneditable) { 1320: $row_html .= &html_uneditable_cell($cell,$bgcolor); 1321: } else { 1322: $row_html .= &html_editable_cell($cell,$bgcolor); 1323: } 1324: $row_html.='</td>'; 1325: $shown_cells++; 1326: } 1327: if ($row_html) { 1328: if ($rows_output % 25 == 0) { 1329: $r->print("</table>\n<br>\n"); 1330: $r->rflush(); 1331: $r->print('<table border=2>'. 1332: '<tr><td> <td>'.$row_type.'</td>'. 1333: '<td>'. 1334: join('</td><td>', 1335: (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 1336: 'abcdefghijklmnopqrstuvwxyz'))). 1337: "</td></tr>\n"); 1338: } 1339: $rows_output++; 1340: $r->print($row_html); 1341: } 1342: } 1343: # 1344: $r->print('</table>'); 1345: # 1346: # Debugging code (be sure to uncomment errorlog code in safe space): 1347: # 1348: # $r->print("\n<pre>"); 1349: # $r->print(&geterrorlog($sheet)); 1350: # $r->print("\n</pre>"); 1351: return 1; 1352: } 1353: 1354: sub outsheet_csv { 1355: my ($sheet,$r) = @_; 1356: my $csvdata = ''; 1357: my @Values; 1358: #################################### 1359: # Prepare to output rows 1360: #################################### 1361: my @Rows = &sort_indicies($sheet); 1362: # 1363: # Loop through the rows and output them one at a time 1364: my $rows_output=0; 1365: foreach my $rownum (@Rows) { 1366: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum); 1367: push (@Values,&format_csv_rowlabel($rowlabel)); 1368: foreach my $cell (@rowdata) { 1369: push (@Values,'"'.$cell->{'value'}.'"'); 1370: } 1371: $csvdata.= join(',',@Values)."\n"; 1372: @Values = (); 1373: } 1374: # 1375: # Write the CSV data to a file and serve up a link 1376: # 1377: my $filename = '/prtspool/'. 1378: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 1379: time.'_'.rand(1000000000).'.csv'; 1380: my $file; 1381: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { 1382: $r->log_error("Couldn't open $filename for output $!"); 1383: $r->print("Problems occured in writing the csv file. ". 1384: "This error has been logged. ". 1385: "Please alert your LON-CAPA administrator."); 1386: $r->print("<pre>\n".$csvdata."</pre>\n"); 1387: return 0; 1388: } 1389: print $file $csvdata; 1390: close($file); 1391: $r->print('<br /><br />'. 1392: '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n"); 1393: # 1394: return 1; 1395: } 1396: 1397: sub outsheet_excel { 1398: my ($sheet,$r) = @_; 1399: my $filename = '/prtspool/'. 1400: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 1401: time.'_'.rand(1000000000).'.xls'; 1402: &Apache::lonnet::logthis("spreadsheet:filename = ".$filename); 1403: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); 1404: if (! defined($workbook)) { 1405: $r->log_error("Error creating excel spreadsheet $filename: $!"); 1406: $r->print("Problems creating new Excel file. ". 1407: "This error has been logged. ". 1408: "Please alert your LON-CAPA administrator"); 1409: return 0; 1410: } 1411: # 1412: # The spreadsheet stores temporary data in files, then put them 1413: # together. If needed we should be able to disable this (memory only). 1414: # The temporary directory must be specified before calling 'addworksheet'. 1415: # File::Temp is used to determine the temporary directory. 1416: $workbook->set_tempdir('/home/httpd/perl/tmp'); 1417: # 1418: # Determine the name to give the worksheet 1419: my $sheetname; 1420: if ($sheet->{'sheettype'} eq 'classcalc') { 1421: $sheetname = 'Main'; 1422: } elsif ($sheet->{'sheettype'} eq 'studentcalc') { 1423: $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'}; 1424: } elsif ($sheet->{'sheettype'} eq 'assesscalc') { 1425: $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'}.' assessment'; 1426: } 1427: my $worksheet = $workbook->addworksheet($sheetname); 1428: #################################### 1429: # Prepare to output rows 1430: #################################### 1431: my @Rows = &sort_indicies($sheet); 1432: # 1433: # Loop through the rows and output them one at a time 1434: my $rows_output=0; 1435: foreach my $rownum (@Rows) { 1436: my ($rowlabel,@rowdata) = &get_row($sheet,$rownum); 1437: my $cols_output = 0; 1438: my $label = &format_excel_rowlabel($rowlabel); 1439: $worksheet->write($rows_output,$cols_output++,$label); 1440: if (ref($label)) { 1441: $cols_output = (scalar(@$label)); 1442: } 1443: foreach my $cell (@rowdata) { 1444: $worksheet->write($rows_output,$cols_output++, 1445: $cell->{'value'}); 1446: } 1447: $rows_output++; 1448: } 1449: # 1450: $workbook->close(); 1451: # Okay, the spreadsheet is taken care of, so give the user a link. 1452: $r->print('<br /><br />'. 1453: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); 1454: return 1; 1455: } 1456: 1457: sub outsheet_xml { 1458: my ($sheet,$r) = @_; 1459: } 1460: 1461: sub outsheet { 1462: my ($r,$sheet)=@_; 1463: if (! exists($ENV{'form.output'})) { 1464: $ENV{'form.output'} = 'HTML'; 1465: } 1466: if (lc($ENV{'form.output'}) eq 'csv') { 1467: &outsheet_csv($sheet,$r); 1468: } elsif (lc($ENV{'form.output'}) eq 'excel') { 1469: &outsheet_excel($sheet,$r); 1470: # } elsif (lc($ENV{'form.output'}) eq 'xml' ) { 1471: # &outsheet_xml($sheet,$r); 1472: } else { 1473: &outsheet_html($sheet,$r); 1474: } 1475: } 1476: 1477: ######################################################################## 1478: ######################################################################## 1479: sub othersheets { 1480: my ($sheet,$stype)=@_; 1481: $stype = $sheet->{'sheettype'} if (! defined($stype)); 1482: # 1483: my $cnum = $sheet->{'cnum'}; 1484: my $cdom = $sheet->{'cdom'}; 1485: my $chome = $sheet->{'chome'}; 1486: # 1487: my @alternatives=(); 1488: my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); 1489: my ($tmp) = keys(%results); 1490: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1491: @alternatives = sort (keys(%results)); 1492: } 1493: return @alternatives; 1494: } 1495: 1496: # 1497: # -------------------------------------- Parse a spreadsheet 1498: # 1499: sub parse_sheet { 1500: # $sheetxml is a scalar reference or a scalar 1501: my ($sheetxml) = @_; 1502: if (! ref($sheetxml)) { 1503: my $tmp = $sheetxml; 1504: $sheetxml = \$tmp; 1505: } 1506: my %f; 1507: my $parser=HTML::TokeParser->new($sheetxml); 1508: my $token; 1509: while ($token=$parser->get_token) { 1510: if ($token->[0] eq 'S') { 1511: if ($token->[1] eq 'field') { 1512: $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= 1513: $parser->get_text('/field'); 1514: } 1515: if ($token->[1] eq 'template') { 1516: $f{'template_'.$token->[2]->{'col'}}= 1517: $parser->get_text('/template'); 1518: } 1519: } 1520: } 1521: return \%f; 1522: } 1523: 1524: # 1525: # -------------------------------------- Read spreadsheet formulas for a course 1526: # 1527: sub readsheet { 1528: my ($sheet,$fn)=@_; 1529: # 1530: my $stype = $sheet->{'sheettype'}; 1531: my $cnum = $sheet->{'cnum'}; 1532: my $cdom = $sheet->{'cdom'}; 1533: my $chome = $sheet->{'chome'}; 1534: # 1535: if (! defined($fn)) { 1536: # There is no filename. Look for defaults in course and global, cache 1537: unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { 1538: my %tmphash = &Apache::lonnet::get('environment', 1539: ['spreadsheet_default_'.$stype], 1540: $cdom,$cnum); 1541: my ($tmp) = keys(%tmphash); 1542: if ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1543: $fn = 'default_'.$stype; 1544: } else { 1545: $fn = $tmphash{'spreadsheet_default_'.$stype}; 1546: } 1547: unless (($fn) && ($fn!~/^error\:/)) { 1548: $fn='default_'.$stype; 1549: } 1550: $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 1551: } 1552: } 1553: # $fn now has a value 1554: $sheet->{'filename'} = $fn; 1555: # see if sheet is cached 1556: my $fstring=''; 1557: if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { 1558: my %tmp = split(/___;___/,$fstring); 1559: $sheet->{'f'} = \%tmp; 1560: &setformulas($sheet); 1561: } else { 1562: # Not cached, need to read 1563: my %f=(); 1564: if ($fn=~/^default\_/) { 1565: my $sheetxml=''; 1566: my $fh; 1567: my $dfn=$fn; 1568: $dfn=~s/\_/\./g; 1569: if ($fh=Apache::File->new($includedir.'/'.$dfn)) { 1570: $sheetxml=join('',<$fh>); 1571: } else { 1572: $sheetxml='<field row="0" col="A">"Error"</field>'; 1573: } 1574: %f=%{&parse_sheet(\$sheetxml)}; 1575: } elsif($fn=~/\/*\.spreadsheet$/) { 1576: my $sheetxml=&Apache::lonnet::getfile 1577: (&Apache::lonnet::filelocation('',$fn)); 1578: if ($sheetxml == -1) { 1579: $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' 1580: .$fn.'"</field>'; 1581: } 1582: %f=%{&parse_sheet(\$sheetxml)}; 1583: } else { 1584: my $sheet=''; 1585: my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); 1586: my ($tmp) = keys(%tmphash); 1587: unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { 1588: foreach (keys(%tmphash)) { 1589: $f{$_}=$tmphash{$_}; 1590: } 1591: } 1592: } 1593: # Cache and set 1594: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 1595: $sheet->{'f'}=\%f; 1596: &setformulas($sheet); 1597: } 1598: } 1599: 1600: # -------------------------------------------------------- Make new spreadsheet 1601: sub makenewsheet { 1602: my ($uname,$udom,$stype,$usymb)=@_; 1603: my $sheet={}; 1604: $sheet->{'uname'} = $uname; 1605: $sheet->{'udom'} = $udom; 1606: $sheet->{'sheettype'} = $stype; 1607: $sheet->{'usymb'} = $usymb; 1608: $sheet->{'cid'} = $ENV{'request.course.id'}; 1609: $sheet->{'csec'} = $Section{$uname.':'.$udom}; 1610: $sheet->{'coursefilename'} = $ENV{'request.course.fn'}; 1611: $sheet->{'cnum'} = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; 1612: $sheet->{'cdom'} = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; 1613: $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'}; 1614: $sheet->{'coursedesc'} = $ENV{'course.'.$ENV{'request.course.id'}. 1615: 'description'}; 1616: $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom); 1617: # 1618: # 1619: $sheet->{'f'} = {}; 1620: $sheet->{'constants'} = {}; 1621: $sheet->{'othersheets'} = []; 1622: $sheet->{'rowlabel'} = {}; 1623: # 1624: # 1625: $sheet->{'safe'}=&initsheet($sheet->{'sheettype'}); 1626: # 1627: # Place all the %$sheet items into the safe space except the safe space 1628: # itself 1629: my $initstring = ''; 1630: foreach (qw/uname udom sheettype usymb cid csec coursefilename 1631: cnum cdom chome uhome/) { 1632: $initstring.= qq{\$$_="$sheet->{$_}";}; 1633: } 1634: $sheet->{'safe'}->reval($initstring); 1635: return $sheet; 1636: } 1637: 1638: # ------------------------------------------------------------ Save spreadsheet 1639: sub writesheet { 1640: my ($sheet,$makedef)=@_; 1641: my $cid=$sheet->{'cid'}; 1642: if (&Apache::lonnet::allowed('opa',$cid)) { 1643: my %f=&getformulas($sheet); 1644: my $stype= $sheet->{'sheettype'}; 1645: my $cnum = $sheet->{'cnum'}; 1646: my $cdom = $sheet->{'cdom'}; 1647: my $chome= $sheet->{'chome'}; 1648: my $fn = $sheet->{'filename'}; 1649: # Cache new sheet 1650: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 1651: # Write sheet 1652: foreach (keys(%f)) { 1653: delete($f{$_}) if ($f{$_} eq 'import'); 1654: } 1655: my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); 1656: if ($reply eq 'ok') { 1657: $reply = &Apache::lonnet::put($stype.'_spreadsheets', 1658: {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, 1659: $cdom,$cnum); 1660: if ($reply eq 'ok') { 1661: if ($makedef) { 1662: return &Apache::lonnet::put('environment', 1663: {'spreadsheet_default_'.$stype => $fn }, 1664: $cdom,$cnum); 1665: } 1666: return $reply; 1667: } 1668: return $reply; 1669: } 1670: return $reply; 1671: } 1672: return 'unauthorized'; 1673: } 1674: 1675: # ----------------------------------------------- Make a temp copy of the sheet 1676: # "Modified workcopy" - interactive only 1677: # 1678: sub tmpwrite { 1679: my ($sheet) = @_; 1680: my $fn=$ENV{'user.name'}.'_'. 1681: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. 1682: $sheet->{'filename'}; 1683: $fn=~s/\W/\_/g; 1684: $fn=$tmpdir.$fn.'.tmp'; 1685: my $fh; 1686: if ($fh=Apache::File->new('>'.$fn)) { 1687: print $fh join("\n",&getformulas($sheet)); 1688: } 1689: } 1690: 1691: # ---------------------------------------------------------- Read the temp copy 1692: sub tmpread { 1693: my ($sheet,$nfield,$nform)=@_; 1694: my $fn=$ENV{'user.name'}.'_'. 1695: $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. 1696: $sheet->{'filename'}; 1697: $fn=~s/\W/\_/g; 1698: $fn=$tmpdir.$fn.'.tmp'; 1699: my $fh; 1700: my %fo=(); 1701: my $countrows=0; 1702: if ($fh=Apache::File->new($fn)) { 1703: my $name; 1704: while ($name=<$fh>) { 1705: chomp($name); 1706: my $value=<$fh>; 1707: chomp($value); 1708: $fo{$name}=$value; 1709: if ($name=~/^A(\d+)$/) { 1710: if ($1>$countrows) { 1711: $countrows=$1; 1712: } 1713: } 1714: } 1715: } 1716: if ($nform eq 'changesheet') { 1717: $fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0]; 1718: unless ($ENV{'form.sel_'.$nfield} eq 'Default') { 1719: $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; 1720: } 1721: } elsif ($nfield eq 'insertrow') { 1722: $countrows++; 1723: my $newrow=substr('000000'.$countrows,-7); 1724: if ($nform eq 'top') { 1725: $fo{'A'.$countrows}='--- '.$newrow; 1726: } else { 1727: $fo{'A'.$countrows}='~~~ '.$newrow; 1728: } 1729: } else { 1730: if ($nfield) { $fo{$nfield}=$nform; } 1731: } 1732: $sheet->{'f'}=\%fo; 1733: &setformulas($sheet); 1734: } 1735: 1736: ################################################## 1737: ################################################## 1738: 1739: =pod 1740: 1741: =item &parmval() 1742: 1743: Determine the value of a parameter. 1744: 1745: Inputs: $what, the parameter needed, $sheet, the safe space 1746: 1747: Returns: The value of a parameter, or '' if none. 1748: 1749: This function cascades through the possible levels searching for a value for 1750: a parameter. The levels are checked in the following order: 1751: user, course (at section level and course level), map, and lonnet::metadata. 1752: This function uses %parmhash, which must be tied prior to calling it. 1753: This function also requires %courseopt and %useropt to be initialized for 1754: this user and course. 1755: 1756: =cut 1757: 1758: ################################################## 1759: ################################################## 1760: sub parmval { 1761: my ($what,$sheet)=@_; 1762: my $symb = $sheet->{'usymb'}; 1763: unless ($symb) { return ''; } 1764: # 1765: my $cid = $sheet->{'cid'}; 1766: my $csec = $sheet->{'csec'}; 1767: my $uname = $sheet->{'uname'}; 1768: my $udom = $sheet->{'udom'}; 1769: my $result=''; 1770: # 1771: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); 1772: # Cascading lookup scheme 1773: my $rwhat=$what; 1774: $what =~ s/^parameter\_//; 1775: $what =~ s/\_([^\_]+)$/\.$1/; 1776: # 1777: my $symbparm = $symb.'.'.$what; 1778: my $mapparm = $mapname.'___(all).'.$what; 1779: my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; 1780: # 1781: my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; 1782: my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; 1783: my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; 1784: # 1785: my $courselevel = $usercourseprefix.'.'.$what; 1786: my $courselevelr = $usercourseprefix.'.'.$symbparm; 1787: my $courselevelm = $usercourseprefix.'.'.$mapparm; 1788: # fourth, check user 1789: if (defined($uname)) { 1790: return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); 1791: return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); 1792: return $useropt{$courselevel} if (defined($useropt{$courselevel})); 1793: } 1794: # third, check course 1795: if (defined($csec)) { 1796: return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); 1797: return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); 1798: return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); 1799: } 1800: # 1801: return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); 1802: return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); 1803: return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); 1804: # second, check map parms 1805: my $thisparm = $parmhash{$symbparm}; 1806: return $thisparm if (defined($thisparm)); 1807: # first, check default 1808: return &Apache::lonnet::metadata($fn,$rwhat.'.default'); 1809: } 1810: 1811: 1812: ################################################################## 1813: ## Row label formatting routines ## 1814: ################################################################## 1815: sub format_html_rowlabel { 1816: my $rowlabel = shift; 1817: return '' if ($rowlabel eq ''); 1818: my ($type,$labeldata) = split(':',$rowlabel,2); 1819: my $result = ''; 1820: if ($type eq 'symb') { 1821: my ($symb,$uname,$udom,$title) = split(':',$labeldata); 1822: $symb = &Apache::lonnet::unescape($symb); 1823: $result = '<a href="/adm/assesscalc?usymb='.$symb. 1824: '&uname='.$uname.'&udom='.$udom.'">'.$title.'</a>'; 1825: } elsif ($type eq 'student') { 1826: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 1827: $result ='<a href="/adm/studentcalc?uname='.$sname. 1828: '&udom='.$sdom.'">'; 1829: $result.=$section.' '.$id." ".$fullname.'</a>'; 1830: } elsif ($type eq 'parameter') { 1831: $result = $labeldata; 1832: } else { 1833: $result = '<b><font size=+1>'.$rowlabel.'</font></b>'; 1834: } 1835: return $result; 1836: } 1837: 1838: sub format_csv_rowlabel { 1839: my $rowlabel = shift; 1840: return '' if ($rowlabel eq ''); 1841: my ($type,$labeldata) = split(':',$rowlabel,2); 1842: my $result = ''; 1843: if ($type eq 'symb') { 1844: my ($symb,$uname,$udom,$title) = split(':',$labeldata); 1845: $symb = &Apache::lonnet::unescape($symb); 1846: $result = $title; 1847: } elsif ($type eq 'student') { 1848: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 1849: $result = join('","',($sname,$sdom,$fullname,$section,$id)); 1850: } elsif ($type eq 'parameter') { 1851: $labeldata =~ s/<br>/ /g; 1852: $result = $labeldata; 1853: } else { 1854: $result = $rowlabel; 1855: } 1856: return '"'.$result.'"'; 1857: } 1858: 1859: sub format_excel_rowlabel { 1860: my $rowlabel = shift; 1861: return '' if ($rowlabel eq ''); 1862: my ($type,$labeldata) = split(':',$rowlabel,2); 1863: my $result = ''; 1864: if ($type eq 'symb') { 1865: my ($symb,$uname,$udom,$title) = split(':',$labeldata); 1866: $symb = &Apache::lonnet::unescape($symb); 1867: $result = $title; 1868: } elsif ($type eq 'student') { 1869: my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata); 1870: $section = '' if (! defined($section)); 1871: $id = '' if (! defined($id)); 1872: my @Data = ($sname,$sdom,$fullname,$section,$id); 1873: $result = \@Data; 1874: } elsif ($type eq 'parameter') { 1875: $labeldata =~ s/<br>/ /g; 1876: $result = $labeldata; 1877: } else { 1878: $result = $rowlabel; 1879: } 1880: return $result; 1881: } 1882: 1883: # ---------------------------------------------- Update rows for course listing 1884: sub updateclasssheet { 1885: my ($sheet) = @_; 1886: my $cnum =$sheet->{'cnum'}; 1887: my $cdom =$sheet->{'cdom'}; 1888: my $cid =$sheet->{'cid'}; 1889: my $chome =$sheet->{'chome'}; 1890: # 1891: %Section = (); 1892: 1893: # 1894: # Read class list and row labels 1895: my $classlist = &Apache::loncoursedata::get_classlist(); 1896: if (! defined($classlist)) { 1897: return 'Could not access course classlist'; 1898: } 1899: # 1900: my %currentlist=(); 1901: foreach my $student (keys(%$classlist)) { 1902: my ($studentDomain,$studentName,$end,$start,$id,$studentSection, 1903: $fullname,$status) = @{$classlist->{$student}}; 1904: if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') { 1905: $currentlist{$student}=join(':',('student',$studentName, 1906: $studentDomain,$fullname, 1907: $studentSection,$id)); 1908: } 1909: } 1910: # 1911: # Find discrepancies between the course row table and this 1912: # 1913: my %f=&getformulas($sheet); 1914: my $changed=0; 1915: # 1916: $sheet->{'maxrow'}=0; 1917: my %existing=(); 1918: # 1919: # Now obsolete rows 1920: foreach (keys(%f)) { 1921: if ($_=~/^A(\d+)/) { 1922: if ($1 > $sheet->{'maxrow'}) { 1923: $sheet->{'maxrow'}= $1; 1924: } 1925: $existing{$f{$_}}=1; 1926: unless ((defined($currentlist{$f{$_}})) || (!$1) || 1927: ($f{$_}=~/^(~~~|---)/)) { 1928: $f{$_}='!!! Obsolete'; 1929: $changed=1; 1930: } 1931: } 1932: } 1933: # 1934: # New and unknown keys 1935: foreach my $student (sort keys(%currentlist)) { 1936: unless ($existing{$student}) { 1937: $changed=1; 1938: $sheet->{'maxrow'}++; 1939: $f{'A'.$sheet->{'maxrow'}}=$student; 1940: } 1941: } 1942: if ($changed) { 1943: $sheet->{'f'} = \%f; 1944: &setformulas($sheet,%f); 1945: } 1946: # 1947: &setrowlabels($sheet,\%currentlist); 1948: } 1949: 1950: # ----------------------------------- Update rows for student and assess sheets 1951: sub updatestudentassesssheet { 1952: my ($sheet) = @_; 1953: # 1954: my %bighash; 1955: # 1956: my $stype = $sheet->{'sheettype'}; 1957: my $uname = $sheet->{'uname'}; 1958: my $udom = $sheet->{'udom'}; 1959: $sheet->{'rowlabel'} = {}; 1960: my $identifier =$sheet->{'coursefilename'}.'_'.$stype.'_'.$uname.'_'.$udom; 1961: if ($updatedata{$identifier}) { 1962: %{$sheet->{'rowlabel'}}=split(/___;___/,$updatedata{$identifier}); 1963: } else { 1964: # Tie hash 1965: tie(%bighash,'GDBM_File',$sheet->{'coursefilename'}.'.db', 1966: &GDBM_READER(),0640); 1967: if (! tied(%bighash)) { 1968: return 'Could not access course data'; 1969: } 1970: # Get all assessments 1971: # 1972: # parameter_labels is used in the assessment sheets to provide labels 1973: # for the parameters. 1974: my %parameter_labels= 1975: ('timestamp' => 1976: 'parameter:Timestamp of Last Transaction<br>timestamp', 1977: 'subnumber' => 1978: 'parameter:Number of Submissions<br>subnumber', 1979: 'tutornumber' => 1980: 'parameter:Number of Tutor Responses<br>tutornumber', 1981: 'totalpoints' => 1982: 'parameter:Total Points Granted<br>totalpoints'); 1983: # 1984: # assesslist holds the descriptions of all assessments 1985: my %assesslist; 1986: foreach ('Feedback','Evaluation','Tutoring','Discussion') { 1987: my $symb = '_'.lc($_); 1988: $assesslist{$symb} = join(':',('symb',$symb,$uname,$udom,$_)); 1989: } 1990: while (($_,undef) = each(%bighash)) { 1991: next if ($_!~/^src\_(\d+)\.(\d+)$/); 1992: my $mapid=$1; 1993: my $resid=$2; 1994: my $id=$mapid.'.'.$resid; 1995: my $srcf=$bighash{$_}; 1996: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { 1997: my $symb= 1998: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). 1999: '___'.$resid.'___'.&Apache::lonnet::declutter($srcf); 2000: $assesslist{$symb}='symb:'.&Apache::lonnet::escape($symb).':' 2001: .$uname.':'.$udom.':'.$bighash{'title_'.$id}; 2002: next if ($stype ne 'assesscalc'); 2003: foreach my $key (split(/\,/, 2004: &Apache::lonnet::metadata($srcf,'keys') 2005: )) { 2006: next if ($key !~ /^(stores|parameter)_/); 2007: my $display= 2008: &Apache::lonnet::metadata($srcf,$key.'.display'); 2009: unless ($display) { 2010: $display.= 2011: &Apache::lonnet::metadata($srcf,$key.'.name'); 2012: } 2013: $display.='<br>'.$key; 2014: $parameter_labels{$key}='parameter:'.$display; 2015: } # end of foreach 2016: } 2017: } # end of foreach (keys(%bighash)) 2018: untie(%bighash); 2019: # 2020: # %parameter_labels has a list of storage and parameter displays by 2021: # unikey 2022: # %assesslist has a list of all resource, by symb 2023: # 2024: if ($stype eq 'assesscalc') { 2025: $sheet->{'rowlabel'} = \%parameter_labels; 2026: } elsif ($stype eq 'studentcalc') { 2027: $sheet->{'rowlabel'} = \%assesslist; 2028: } 2029: $updatedata{$sheet->{'coursefilename'}.'_'.$stype.'_' 2030: .$uname.'_'.$udom}= 2031: join('___;___',%{$sheet->{'rowlabel'}}); 2032: # Get current from cache 2033: } 2034: # Find discrepancies between the course row table and this 2035: # 2036: my %f=&getformulas($sheet); 2037: my $changed=0; 2038: 2039: $sheet->{'maxrow'} = 0; 2040: my %existing=(); 2041: # Now obsolete rows 2042: foreach (keys(%f)) { 2043: next if ($_!~/^A(\d+)/); 2044: if ($1 > $sheet->{'maxrow'}) { 2045: $sheet->{'maxrow'} = $1; 2046: } 2047: my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); 2048: $existing{$usy}=1; 2049: unless ((exists($sheet->{'rowlabel'}->{$usy}) && 2050: (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) || 2051: ($f{$_}=~/^(~~~|---)/))){ 2052: $f{$_}='!!! Obsolete'; 2053: $changed=1; 2054: } elsif ($ufn) { 2055: $sheet->{'rowlabel'}->{$usy} 2056: =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; 2057: } 2058: } 2059: # New and unknown keys 2060: foreach (keys(%{$sheet->{'rowlabel'}})) { 2061: unless ($existing{$_}) { 2062: $changed=1; 2063: $sheet->{'maxrow'}++; 2064: $f{'A'.$sheet->{'maxrow'}}=$_; 2065: } 2066: } 2067: if ($changed) { 2068: $sheet->{'f'} = \%f; 2069: &setformulas($sheet); 2070: } 2071: # 2072: undef %existing; 2073: } 2074: 2075: # ------------------------------------------------ Load data for one assessment 2076: 2077: sub loadstudent { 2078: my ($sheet)=@_; 2079: my %c=(); 2080: my %f=&getformulas($sheet); 2081: $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'}; 2082: # Get ALL the student preformance data 2083: my @tmp = &Apache::lonnet::dump($sheet->{'cid'}, 2084: $sheet->{'udom'}, 2085: $sheet->{'uname'}, 2086: undef); 2087: if ($tmp[0] !~ /^error:/) { 2088: %cachedstores = @tmp; 2089: } 2090: undef @tmp; 2091: # 2092: my @assessdata=(); 2093: foreach (keys(%f)) { 2094: next if ($_!~/^A(\d+)/); 2095: my $row=$1; 2096: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); 2097: my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); 2098: @assessdata=&exportsheet($sheet,$sheet->{'uname'}, 2099: $sheet->{'udom'}, 2100: 'assesscalc',$usy,$ufn); 2101: my $index=0; 2102: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 2103: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 2104: if ($assessdata[$index]) { 2105: my $col=$_; 2106: if ($assessdata[$index]=~/\D/) { 2107: $c{$col.$row}="'".$assessdata[$index]."'"; 2108: } else { 2109: $c{$col.$row}=$assessdata[$index]; 2110: } 2111: unless ($col eq 'A') { 2112: $f{$col.$row}='import'; 2113: } 2114: } 2115: $index++; 2116: } 2117: } 2118: $cachedassess=''; 2119: undef %cachedstores; 2120: $sheet->{'f'} = \%f; 2121: &setformulas($sheet); 2122: &setconstants($sheet,\%c); 2123: } 2124: 2125: # --------------------------------------------------- Load data for one student 2126: # 2127: sub loadcourse { 2128: my ($sheet,$r)=@_; 2129: my %c=(); 2130: my %f=&getformulas($sheet); 2131: my $total=0; 2132: foreach (keys(%f)) { 2133: if ($_=~/^A(\d+)/) { 2134: unless ($f{$_}=~/^[\!\~\-]/) { $total++; } 2135: } 2136: } 2137: my $now=0; 2138: my $since=time; 2139: $r->print(<<ENDPOP); 2140: <script> 2141: popwin=open('','popwin','width=400,height=100'); 2142: popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+ 2143: '<h3>Spreadsheet Calculation Progress</h3>'+ 2144: '<form name=popremain>'+ 2145: '<input type=text size=35 name=remaining value=Starting></form>'+ 2146: '</body></html>'); 2147: popwin.document.close(); 2148: </script> 2149: ENDPOP 2150: $r->rflush(); 2151: foreach (keys(%f)) { 2152: next if ($_!~/^A(\d+)/); 2153: my $row=$1; 2154: next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); 2155: my ($sname,$sdom) = split(':',$f{$_}); 2156: my @studentdata=&exportsheet($sheet,$sname,$sdom,'studentcalc'); 2157: undef %userrdatas; 2158: $now++; 2159: $r->print('<script>popwin.document.popremain.remaining.value="'. 2160: $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)). 2161: ' secs remaining";</script>'); 2162: $r->rflush(); 2163: # 2164: my $index=0; 2165: foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 2166: 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { 2167: if (defined($studentdata[$index])) { 2168: my $col=$_; 2169: if ($studentdata[$index]=~/\D/) { 2170: $c{$col.$row}="'".$studentdata[$index]."'"; 2171: } else { 2172: $c{$col.$row}=$studentdata[$index]; 2173: } 2174: unless ($col eq 'A') { 2175: $f{$col.$row}='import'; 2176: } 2177: } 2178: $index++; 2179: } 2180: } 2181: $sheet->{'f'}=\%f; 2182: &setformulas($sheet); 2183: &setconstants($sheet,\%c); 2184: $r->print('<script>popwin.close()</script>'); 2185: $r->rflush(); 2186: } 2187: 2188: # ------------------------------------------------ Load data for one assessment 2189: # 2190: sub loadassessment { 2191: my ($sheet)=@_; 2192: 2193: my $uhome = $sheet->{'uhome'}; 2194: my $uname = $sheet->{'uname'}; 2195: my $udom = $sheet->{'udom'}; 2196: my $symb = $sheet->{'usymb'}; 2197: my $cid = $sheet->{'cid'}; 2198: my $cnum = $sheet->{'cnum'}; 2199: my $cdom = $sheet->{'cdom'}; 2200: my $chome = $sheet->{'chome'}; 2201: 2202: my $namespace; 2203: unless ($namespace=$cid) { return ''; } 2204: # Get stored values 2205: my %returnhash=(); 2206: if ($cachedassess eq $uname.':'.$udom) { 2207: # 2208: # get data out of the dumped stores 2209: # 2210: my $version=$cachedstores{'version:'.$symb}; 2211: my $scope; 2212: for ($scope=1;$scope<=$version;$scope++) { 2213: foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { 2214: $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; 2215: } 2216: } 2217: } else { 2218: # 2219: # restore individual 2220: # 2221: %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname); 2222: for (my $version=1;$version<=$returnhash{'version'};$version++) { 2223: foreach (split(/\:/,$returnhash{$version.':keys'})) { 2224: $returnhash{$_}=$returnhash{$version.':'.$_}; 2225: } 2226: } 2227: } 2228: # 2229: # returnhash now has all stores for this resource 2230: # convert all "_" to "." to be able to use libraries, multiparts, etc 2231: # 2232: # This is dumb. It is also necessary :( 2233: my @oldkeys=keys %returnhash; 2234: # 2235: foreach my $name (@oldkeys) { 2236: my $value=$returnhash{$name}; 2237: delete $returnhash{$name}; 2238: $name=~s/\_/\./g; 2239: $returnhash{$name}=$value; 2240: } 2241: # initialize coursedata and userdata for this user 2242: undef %courseopt; 2243: undef %useropt; 2244: 2245: my $userprefix=$uname.'_'.$udom.'_'; 2246: 2247: unless ($uhome eq 'no_host') { 2248: # Get coursedata 2249: unless ((time-$courserdatas{$cid.'.last_cache'})<240) { 2250: my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum); 2251: $courserdatas{$cid}=\%Tmp; 2252: $courserdatas{$cid.'.last_cache'}=time; 2253: } 2254: while (my ($name,$value) = each(%{$courserdatas{$cid}})) { 2255: $courseopt{$userprefix.$name}=$value; 2256: } 2257: # Get userdata (if present) 2258: unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) { 2259: my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname); 2260: $userrdatas{$cid} = \%Tmp; 2261: # Most of the time the user does not have a 'resourcedata.db' 2262: # file. We need to cache that we got nothing instead of bothering 2263: # with requesting it every time. 2264: $userrdatas{$uname.'@'.$udom.'.last_cache'}=time; 2265: } 2266: while (my ($name,$value) = each(%{$userrdatas{$cid}})) { 2267: $useropt{$userprefix.$name}=$value; 2268: } 2269: } 2270: # now courseopt, useropt initialized for this user and course 2271: # (used by parmval) 2272: # 2273: # Load keys for this assessment only 2274: # 2275: my %thisassess=(); 2276: my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); 2277: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { 2278: $thisassess{$_}=1; 2279: } 2280: # 2281: # Load parameters 2282: # 2283: my %c=(); 2284: if (tie(%parmhash,'GDBM_File', 2285: $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { 2286: my %f=&getformulas($sheet); 2287: foreach my $cell (keys(%f)) { 2288: next if ($cell !~ /^A/); 2289: next if ($f{$cell} =~/^[\!\~\-]/); 2290: if ($f{$cell}=~/^parameter/) { 2291: if (defined($thisassess{$f{$cell}})) { 2292: my $val = &parmval($f{$cell},$sheet); 2293: $c{$cell} = $val; 2294: $c{$f{$cell}} = $val; 2295: } 2296: } else { 2297: my $key=$f{$cell}; 2298: my $ckey=$key; 2299: $key=~s/^stores\_/resource\./; 2300: $key=~s/\_/\./g; 2301: $c{$cell}=$returnhash{$key}; 2302: $c{$ckey}=$returnhash{$key}; 2303: } 2304: } 2305: untie(%parmhash); 2306: } 2307: &setconstants($sheet,\%c); 2308: } 2309: 2310: # --------------------------------------------------------- Various form fields 2311: 2312: sub textfield { 2313: my ($title,$name,$value)=@_; 2314: return "\n<p><b>$title:</b><br>". 2315: '<input type=text name="'.$name.'" size=80 value="'.$value.'">'; 2316: } 2317: 2318: sub hiddenfield { 2319: my ($name,$value)=@_; 2320: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">'; 2321: } 2322: 2323: sub selectbox { 2324: my ($title,$name,$value,%options)=@_; 2325: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">'; 2326: foreach (sort keys(%options)) { 2327: $selout.='<option value="'.$_.'"'; 2328: if ($_ eq $value) { $selout.=' selected'; } 2329: $selout.='>'.$options{$_}.'</option>'; 2330: } 2331: return $selout.'</select>'; 2332: } 2333: 2334: # =============================================== Update information in a sheet 2335: # 2336: # Add new users or assessments, etc. 2337: # 2338: 2339: sub updatesheet { 2340: my ($sheet)=@_; 2341: my $stype=$sheet->{'sheettype'}; 2342: if ($stype eq 'classcalc') { 2343: return &updateclasssheet($sheet); 2344: } else { 2345: return &updatestudentassesssheet($sheet); 2346: } 2347: } 2348: 2349: # =================================================== Load the rows for a sheet 2350: # 2351: # Import the data for rows 2352: # 2353: 2354: sub loadrows { 2355: my ($sheet,$r)=@_; 2356: my $stype=$sheet->{'sheettype'}; 2357: if ($stype eq 'classcalc') { 2358: &loadcourse($sheet,$r); 2359: } elsif ($stype eq 'studentcalc') { 2360: &loadstudent($sheet); 2361: } else { 2362: &loadassessment($sheet); 2363: } 2364: } 2365: 2366: # ======================================================= Forced recalculation? 2367: 2368: sub checkthis { 2369: my ($keyname,$time)=@_; 2370: return ($time<$expiredates{$keyname}); 2371: } 2372: 2373: sub forcedrecalc { 2374: my ($uname,$udom,$stype,$usymb)=@_; 2375: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 2376: my $time=$oldsheets{$key.'.time'}; 2377: if ($ENV{'form.forcerecalc'}) { return 1; } 2378: unless ($time) { return 1; } 2379: if ($stype eq 'assesscalc') { 2380: my $map=(split(/___/,$usymb))[0]; 2381: if (&checkthis('::assesscalc:',$time) || 2382: &checkthis('::assesscalc:'.$map,$time) || 2383: &checkthis('::assesscalc:'.$usymb,$time) || 2384: &checkthis($uname.':'.$udom.':assesscalc:',$time) || 2385: &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || 2386: &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { 2387: return 1; 2388: } 2389: } else { 2390: if (&checkthis('::studentcalc:',$time) || 2391: &checkthis($uname.':'.$udom.':studentcalc:',$time)) { 2392: return 1; 2393: } 2394: } 2395: return 0; 2396: } 2397: 2398: # ============================================================== Export handler 2399: # exportsheet 2400: # returns the export row for a spreadsheet. 2401: # 2402: sub exportsheet { 2403: my ($sheet,$uname,$udom,$stype,$usymb,$fn)=@_; 2404: $uname = $uname || $sheet->{'uname'}; 2405: $udom = $udom || $sheet->{'udom'}; 2406: $stype = $stype || $sheet->{'sheettype'}; 2407: my @exportarr=(); 2408: if (defined($usymb) && ($usymb=~/^\_(\w+)/) && 2409: (!defined($fn) || $fn eq '')) { 2410: $fn='default_'.$1; 2411: } 2412: # 2413: # Check if cached 2414: # 2415: my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; 2416: my $found=''; 2417: if ($oldsheets{$key}) { 2418: foreach (split(/___&\___/,$oldsheets{$key})) { 2419: my ($name,$value)=split(/___=___/,$_); 2420: if ($name eq $fn) { 2421: $found=$value; 2422: } 2423: } 2424: } 2425: unless ($found) { 2426: &cachedssheets($sheet,$uname,$udom); 2427: if ($oldsheets{$key}) { 2428: foreach (split(/___&\___/,$oldsheets{$key})) { 2429: my ($name,$value)=split(/___=___/,$_); 2430: if ($name eq $fn) { 2431: $found=$value; 2432: } 2433: } 2434: } 2435: } 2436: # 2437: # Check if still valid 2438: # 2439: if ($found) { 2440: if (&forcedrecalc($uname,$udom,$stype,$usymb)) { 2441: $found=''; 2442: } 2443: } 2444: if ($found) { 2445: # 2446: # Return what was cached 2447: # 2448: @exportarr=split(/___;___/,$found); 2449: return @exportarr; 2450: } 2451: # 2452: # Not cached 2453: # 2454: my ($newsheet)=&makenewsheet($uname,$udom,$stype,$usymb); 2455: &readsheet($newsheet,$fn); 2456: &updatesheet($newsheet); 2457: &loadrows($newsheet); 2458: &calcsheet($newsheet); 2459: @exportarr=&exportdata($newsheet); 2460: ## 2461: ## Store now 2462: ## 2463: # 2464: # load in the old value 2465: # 2466: my %currentlystored=(); 2467: if ($stype eq 'studentcalc') { 2468: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets', 2469: [$key], 2470: $sheet->{'cdom'},$sheet->{'cnum'}); 2471: if ($tmp[0]!~/^error/) { 2472: %currentlystored = @tmp; 2473: } 2474: } else { 2475: my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'. 2476: $sheet->{'cid'},[$key], 2477: $sheet->{'udom'},$sheet->{'uname'}); 2478: if ($tmp[0]!~/^error/) { 2479: %currentlystored = @tmp; 2480: } 2481: } 2482: # 2483: # Add the new line 2484: # 2485: $currentlystored{$fn}=join('___;___',@exportarr); 2486: # 2487: # Stick everything back together 2488: # 2489: my $newstore=''; 2490: foreach (keys(%currentlystored)) { 2491: if ($newstore) { $newstore.='___&___'; } 2492: $newstore.=$_.'___=___'.$currentlystored{$_}; 2493: } 2494: my $now=time; 2495: # 2496: # Store away the new value 2497: # 2498: if ($stype eq 'studentcalc') { 2499: &Apache::lonnet::put('nohist_calculatedsheets', 2500: { $key => $newstore, 2501: $key.time => $now }, 2502: $sheet->{'cdom'},$sheet->{'cnum'}); 2503: } else { 2504: &Apache::lonnet::put('nohist_calculatedsheets_'.$sheet->{'cid'}, 2505: { $key => $newstore, 2506: $key.time => $now }, 2507: $sheet->{'udom'}, 2508: $sheet->{'uname'}) 2509: } 2510: return @exportarr; 2511: } 2512: 2513: # ============================================================ Expiration Dates 2514: # 2515: # Load previously cached student spreadsheets for this course 2516: # 2517: sub expirationdates { 2518: undef %expiredates; 2519: my $cid=$ENV{'request.course.id'}; 2520: my @tmp = &Apache::lonnet::dump('nohist_expirationdates', 2521: $ENV{'course.'.$cid.'.domain'}, 2522: $ENV{'course.'.$cid.'.num'}); 2523: if (lc($tmp[0])!~/^error/){ 2524: %expiredates = @tmp; 2525: } 2526: } 2527: 2528: # ===================================================== Calculated sheets cache 2529: # 2530: # Load previously cached student spreadsheets for this course 2531: # 2532: 2533: sub cachedcsheets { 2534: my $cid=$ENV{'request.course.id'}; 2535: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets', 2536: $ENV{'course.'.$cid.'.domain'}, 2537: $ENV{'course.'.$cid.'.num'}); 2538: if ($tmp[0] !~ /^error/) { 2539: my %StupidTempHash = @tmp; 2540: while (my ($key,$value) = each %StupidTempHash) { 2541: $oldsheets{$key} = $value; 2542: } 2543: } 2544: } 2545: 2546: # ===================================================== Calculated sheets cache 2547: # 2548: # Load previously cached assessment spreadsheets for this student 2549: # 2550: 2551: sub cachedssheets { 2552: my ($sheet,$uname,$udom) = @_; 2553: $uname = $uname || $sheet->{'uname'}; 2554: $udom = $udom || $sheet->{'udom'}; 2555: if (! $loadedcaches{$sheet->{'uname'}.'_'.$sheet->{'udom'}}) { 2556: my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets', 2557: $sheet->{'udom'}, 2558: $sheet->{'uname'}); 2559: if ($tmp[0] !~ /^error/) { 2560: my %StupidTempHash = @tmp; 2561: while (my ($key,$value) = each %StupidTempHash) { 2562: $oldsheets{$key} = $value; 2563: } 2564: $loadedcaches{$sheet->{'uname'}.'_'.$sheet->{'udom'}}=1; 2565: } 2566: } 2567: } 2568: 2569: # ===================================================== Calculated sheets cache 2570: # 2571: # Load previously cached assessment spreadsheets for this student 2572: # 2573: 2574: # ================================================================ Main handler 2575: # 2576: # Interactive call to screen 2577: # 2578: # 2579: sub handler { 2580: my $r=shift; 2581: 2582: if (! exists($ENV{'form.Status'})) { 2583: $ENV{'form.Status'} = 'Active'; 2584: } 2585: if (! exists($ENV{'form.output'})) { 2586: $ENV{'form.output'} = 'HTML'; 2587: } 2588: # Check this server 2589: my $loaderror=&Apache::lonnet::overloaderror($r); 2590: if ($loaderror) { return $loaderror; } 2591: # Check the course homeserver 2592: $loaderror= &Apache::lonnet::overloaderror($r, 2593: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); 2594: if ($loaderror) { return $loaderror; } 2595: 2596: if ($r->header_only) { 2597: $r->content_type('text/html'); 2598: $r->send_http_header; 2599: return OK; 2600: } 2601: # Global directory configs 2602: $includedir = $r->dir_config('lonIncludes'); 2603: $tmpdir = $r->dir_config('lonDaemons').'/tmp/'; 2604: # Needs to be in a course 2605: if (! $ENV{'request.course.fn'}) { 2606: # Not in a course, or not allowed to modify parms 2607: $ENV{'user.error.msg'}= 2608: $r->uri.":opa:0:0:Cannot modify spreadsheet"; 2609: return HTTP_NOT_ACCEPTABLE; 2610: } 2611: # Get query string for limited number of parameters 2612: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 2613: ['uname','udom','usymb','ufn']); 2614: if ($ENV{'request.role'} =~ /^st\./) { 2615: delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'})); 2616: delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'})); 2617: } 2618: if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { 2619: $ENV{'form.ufn'}='default_'.$1; 2620: } 2621: # Interactive loading of specific sheet? 2622: if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { 2623: $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; 2624: } 2625: # 2626: # Determine the user name and domain for the sheet. 2627: my $aname; 2628: my $adom; 2629: unless ($ENV{'form.uname'}) { 2630: $aname=$ENV{'user.name'}; 2631: $adom=$ENV{'user.domain'}; 2632: } else { 2633: $aname=$ENV{'form.uname'}; 2634: $adom=$ENV{'form.udom'}; 2635: } 2636: # 2637: # Open page 2638: $r->content_type('text/html'); 2639: $r->header_out('Cache-control','no-cache'); 2640: $r->header_out('Pragma','no-cache'); 2641: $r->send_http_header; 2642: # Screen output 2643: $r->print('<html><head><title>LON-CAPA Spreadsheet</title>'); 2644: if ($ENV{'request.role'} !~ /^st\./) { 2645: $r->print(<<ENDSCRIPT); 2646: <script language="JavaScript"> 2647: 2648: function celledit(cn,cf) { 2649: var cnf=prompt(cn,cf); 2650: if (cnf!=null) { 2651: document.sheet.unewfield.value=cn; 2652: document.sheet.unewformula.value=cnf; 2653: document.sheet.submit(); 2654: } 2655: } 2656: 2657: function changesheet(cn) { 2658: document.sheet.unewfield.value=cn; 2659: document.sheet.unewformula.value='changesheet'; 2660: document.sheet.submit(); 2661: } 2662: 2663: function insertrow(cn) { 2664: document.sheet.unewfield.value='insertrow'; 2665: document.sheet.unewformula.value=cn; 2666: document.sheet.submit(); 2667: } 2668: 2669: </script> 2670: ENDSCRIPT 2671: } 2672: $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet'). 2673: '<form action="'.$r->uri.'" name=sheet method=post>'); 2674: $r->print(&hiddenfield('uname',$ENV{'form.uname'}). 2675: &hiddenfield('udom',$ENV{'form.udom'}). 2676: &hiddenfield('usymb',$ENV{'form.usymb'}). 2677: &hiddenfield('unewfield',''). 2678: &hiddenfield('unewformula','')); 2679: $r->rflush(); 2680: # 2681: # Full recalc? 2682: if ($ENV{'form.forcerecalc'}) { 2683: $r->print('<h4>Completely Recalculating Sheet ...</h4>'); 2684: undef %spreadsheets; 2685: undef %courserdatas; 2686: undef %userrdatas; 2687: undef %defaultsheets; 2688: undef %updatedata; 2689: } 2690: # Read new sheet or modified worksheet 2691: $r->uri=~/\/(\w+)$/; 2692: my ($sheet)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); 2693: # 2694: # If a new formula had been entered, go from work copy 2695: if ($ENV{'form.unewfield'}) { 2696: $r->print('<h2>Modified Workcopy</h2>'); 2697: $ENV{'form.unewformula'}=~s/\'/\"/g; 2698: $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='. 2699: $ENV{'form.unewformula'}.'<p>'); 2700: $sheet->{'filename'} = $ENV{'form.ufn'}; 2701: &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'}); 2702: } elsif ($ENV{'form.saveas'}) { 2703: $sheet->{'filename'} = $ENV{'form.ufn'}; 2704: &tmpread($sheet); 2705: } else { 2706: &readsheet($sheet,$ENV{'form.ufn'}); 2707: } 2708: # Print out user information 2709: if ($sheet->{'sheettype'} ne 'classcalc') { 2710: $r->print('<p><b>User:</b> '.$sheet->{'uname'}. 2711: '<br><b>Domain:</b> '.$sheet->{'udom'}); 2712: $r->print('<br><b>Section/Group:</b> '.$sheet->{'csec'}); 2713: if ($ENV{'form.usymb'}) { 2714: $r->print('<br><b>Assessment:</b> <tt>'. 2715: $ENV{'form.usymb'}.'</tt>'); 2716: } 2717: } 2718: # 2719: # Check user permissions 2720: if (($sheet->{'sheettype'} eq 'classcalc' ) || 2721: ($sheet->{'uname'} ne $ENV{'user.name'} ) || 2722: ($sheet->{'udom'} ne $ENV{'user.domain'})) { 2723: unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) { 2724: $r->print('<h1>Access Permission Denied</h1>'. 2725: '</form></body></html>'); 2726: return OK; 2727: } 2728: } 2729: # Additional options 2730: $r->print('<br />'. 2731: '<input type="submit" name="forcerecalc" '. 2732: 'value="Completely Recalculate Sheet"><p>'); 2733: if ($sheet->{'sheettype'} eq 'assesscalc') { 2734: $r->print('<p><font size=+2>'. 2735: '<a href="/adm/studentcalc?'. 2736: 'uname='.$sheet->{'uname'}. 2737: '&udom='.$sheet->{'udom'}.'">'. 2738: 'Level up: Student Sheet</a></font><p>'); 2739: } 2740: if (($sheet->{'sheettype'} eq 'studentcalc') && 2741: (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) { 2742: $r->print ('<p><font size=+2><a href="/adm/classcalc">'. 2743: 'Level up: Course Sheet</a></font><p>'); 2744: } 2745: # Save dialog 2746: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2747: my $fname=$ENV{'form.ufn'}; 2748: $fname=~s/\_[^\_]+$//; 2749: if ($fname eq 'default') { $fname='course_default'; } 2750: $r->print('<input type=submit name=saveas value="Save as ...">'. 2751: '<input type=text size=20 name=newfn value="'.$fname.'">'. 2752: 'make default: <input type=checkbox name="makedefufn"><p>'); 2753: } 2754: $r->print(&hiddenfield('ufn',$sheet->{'filename'})); 2755: # Load dialog 2756: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2757: $r->print('<p><input type=submit name=load value="Load ...">'. 2758: '<select name="loadthissheet">'. 2759: '<option name="default">Default</option>'); 2760: foreach (&othersheets($sheet)) { 2761: $r->print('<option name="'.$_.'"'); 2762: if ($ENV{'form.ufn'} eq $_) { 2763: $r->print(' selected'); 2764: } 2765: $r->print('>'.$_.'</option>'); 2766: } 2767: $r->print('</select><p>'); 2768: if ($sheet->{'sheettype'} eq 'studentcalc') { 2769: &setothersheets($sheet, 2770: &othersheets($sheet,'assesscalc')); 2771: } 2772: } 2773: # Cached sheets 2774: &expirationdates(); 2775: undef %oldsheets; 2776: undef %loadedcaches; 2777: if ($sheet->{'sheettype'} eq 'classcalc') { 2778: $r->print("Loading previously calculated student sheets ...\n"); 2779: $r->rflush(); 2780: &cachedcsheets(); 2781: } elsif ($sheet->{'sheettype'} eq 'studentcalc') { 2782: $r->print("Loading previously calculated assessment sheets ...\n"); 2783: $r->rflush(); 2784: &cachedssheets($sheet); 2785: } 2786: # Update sheet, load rows 2787: $r->print("Loaded sheet(s), updating rows ...<br>\n"); 2788: $r->rflush(); 2789: # 2790: &updatesheet($sheet); 2791: $r->print("Updated rows, loading row data ...\n"); 2792: $r->rflush(); 2793: # 2794: &loadrows($sheet,$r); 2795: $r->print("Loaded row data, calculating sheet ...<br>\n"); 2796: $r->rflush(); 2797: # 2798: my $calcoutput=&calcsheet($sheet); 2799: $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); 2800: # See if something to save 2801: if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { 2802: my $fname=''; 2803: if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { 2804: $fname=~s/\W/\_/g; 2805: if ($fname eq 'default') { $fname='course_default'; } 2806: $fname.='_'.$sheet->{'sheettype'}; 2807: $sheet->{'filename'} = $fname; 2808: $ENV{'form.ufn'}=$fname; 2809: $r->print('<p>Saving spreadsheet: '. 2810: &writesheet($sheet,$ENV{'form.makedefufn'}). 2811: '<p>'); 2812: } 2813: } 2814: # 2815: # Write the modified worksheet 2816: $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'<p>'); 2817: &tmpwrite($sheet); 2818: if ($sheet->{'sheettype'} eq 'studentcalc') { 2819: $r->print('<br>Show rows with empty A column: '); 2820: } else { 2821: $r->print('<br>Show empty rows: '); 2822: } 2823: # 2824: $r->print(&hiddenfield('userselhidden','true'). 2825: '<input type="checkbox" name="showall" onClick="submit()"'); 2826: # 2827: if ($ENV{'form.showall'}) { 2828: $r->print(' checked'); 2829: } else { 2830: unless ($ENV{'form.userselhidden'}) { 2831: unless 2832: ($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') { 2833: $r->print(' checked'); 2834: $ENV{'form.showall'}=1; 2835: } 2836: } 2837: } 2838: $r->print('>'); 2839: # 2840: # CSV format checkbox (classcalc sheets only) 2841: $r->print(' Output as <select name="output" size="1" onClick="submit()">'. 2842: "\n"); 2843: foreach my $mode (qw/HTML CSV EXCEL/) { 2844: $r->print('<option value="'.$mode.'"'); 2845: if ($ENV{'form.output'} eq $mode) { 2846: $r->print(' selected '); 2847: } 2848: $r->print('>'.$mode.'</option>'."\n"); 2849: } 2850: $r->print("</select>\n"); 2851: # 2852: if ($sheet->{'sheettype'} eq 'classcalc') { 2853: $r->print(' Student Status: '. 2854: &Apache::lonhtmlcommon::StatusOptions 2855: ($ENV{'form.Status'},'sheet')); 2856: } 2857: # 2858: # Buttons to insert rows 2859: # $r->print(<<ENDINSERTBUTTONS); 2860: #<br> 2861: #<input type='button' onClick='insertrow("top");' 2862: #value='Insert Row Top'> 2863: #<input type='button' onClick='insertrow("bottom");' 2864: #value='Insert Row Bottom'><br> 2865: #ENDINSERTBUTTONS 2866: # Print out sheet 2867: &outsheet($r,$sheet); 2868: $r->print('</form></body></html>'); 2869: # Done 2870: return OK; 2871: } 2872: 2873: 1; 2874: __END__