loncom/interface/spreadsheet/Spreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / Spreadsheet.pm
Revision 1.3: download - view: text, annotated - select for diffs
Thu May 22 21:16:35 2003 UTC (21 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD

Added 'blackout' support.  A blackout occurs when an assessment has a part
flagged with 'problemstatus' equal to 'no'.  This prevents the display of
the students performance on the part until the answerdate has passed.

Spreadsheet.pm contains &blackout, which returns the blackout status of
the current spreadsheet.

assesscalc.pm contains code which
    a) causes the computation of the spreadsheet to determine the
       blackout status
    b) forces the recomputation of the spreadsheet if the user is a student.
  Obviously (b) is less than ideal and a new approach should be found.

studentcalc.pm's outsheet_html subroutine now supresses the display of the
export (aka 'summary') row, as well as the rows of any assessments which
are under blackout.

1: # 2: # $Id: Spreadsheet.pm,v 1.3 2003/05/22 21:16:35 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: Spreadsheet 34: 35: =head1 SYNOPSIS 36: 37: =head1 DESCRIPTION 38: 39: =over 4 40: 41: =cut 42: 43: ################################################### 44: ################################################### 45: ### Spreadsheet ### 46: ################################################### 47: ################################################### 48: package Apache::Spreadsheet; 49: 50: use strict; 51: use Apache::Constants qw(:common :http); 52: use Apache::lonnet; 53: use Safe; 54: use Safe::Hole; 55: use Opcode; 56: use HTML::Entities(); 57: use HTML::TokeParser; 58: use Spreadsheet::WriteExcel; 59: use Time::HiRes; 60: 61: ## 62: ## Package Variables 63: ## 64: my %expiredates; 65: 66: my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 67: my @LC_Columns = split(//,'abcdefghijklmnopqrstuvwxyz'); 68: 69: ###################################################### 70: 71: =pod 72: 73: =item &new 74: 75: Returns a new spreadsheet object. 76: 77: =cut 78: 79: ###################################################### 80: sub new { 81: my $this = shift; 82: my $class = ref($this) || $this; 83: my ($stype) = ($class =~ /Apache::(.*)$/); 84: # 85: my ($name,$domain,$filename,$usymb)=@_; 86: # 87: my $self = { 88: name => $name, 89: domain => $domain, 90: type => $stype, 91: symb => $usymb, 92: errorlog => '', 93: maxrow => '', 94: cid => $ENV{'request.course.id'}, 95: cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, 96: cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 97: chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, 98: coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, 99: coursefilename => $ENV{'request.course.fn'}, 100: # 101: # blackout is used to determine if any data needs to be hidden from the 102: # student. 103: blackout => 0, 104: # 105: # Data storage 106: formulas => {}, 107: constants => {}, 108: rows => [], 109: row_source => {}, 110: othersheets => [], 111: }; 112: # 113: $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain); 114: # 115: bless($self,$class); 116: # 117: # Load in the spreadsheet definition 118: $self->filename($filename); 119: if (exists($ENV{'form.workcopy'}) && 120: $self->{'type'} eq $ENV{'form.workcopy'}) { 121: $self->load_tmp(); 122: } else { 123: $self->load(); 124: } 125: return $self; 126: } 127: 128: ###################################################### 129: 130: =pod 131: 132: =item &filename 133: 134: get or set the filename for a spreadsheet. 135: 136: =cut 137: 138: ###################################################### 139: sub filename { 140: my $self = shift(); 141: if (@_) { 142: my ($newfilename) = @_; 143: if (! defined($newfilename) || $newfilename eq 'Default' || 144: $newfilename !~ /\w/ || $newfilename =~ /\W/) { 145: my %tmphash = &Apache::lonnet::get('environment', 146: ['spreadsheet_default_'. 147: $self->{'type'}], 148: $self->{'cdom'}, 149: $self->{'cnum'}); 150: my ($tmp) = keys(%tmphash); 151: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 152: $newfilename=$tmphash{'spreadsheet_default_'.$self->{'type'}}; 153: } 154: } 155: if (! defined($newfilename) || 156: $newfilename !~ /\w/ || 157: $newfilename =~ /^\W*$/) { 158: $newfilename = 'default.'.$self->{'type'}; 159: } else { 160: my $regexp = '_'.$self->{'type'}.'$'; 161: if ($newfilename !~ /$regexp/) { 162: $newfilename .= '_'.$self->{'type'}; 163: } 164: } 165: $self->{'filename'} = $newfilename; 166: return; 167: } 168: return $self->{'filename'}; 169: } 170: 171: ###################################################### 172: 173: =pod 174: 175: =item &make_default() 176: 177: Make the current spreadsheet file the default for the course. Expires all the 178: default spreadsheets.......! 179: 180: =cut 181: 182: ###################################################### 183: sub make_default { 184: my $self = shift(); 185: my $result = &Apache::lonnet::put('environment', 186: {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, 187: $self->{'cdom'},$self->{'cnum'}); 188: return $result if ($result ne 'ok'); 189: my $symb = $self->{'symb'}; 190: $symb = '' if (! defined($symb)); 191: &Apache::lonnet::expirespread('','',$self->{'type'},$symb); 192: } 193: 194: ###################################################### 195: 196: =pod 197: 198: =item &is_default() 199: 200: Returns 1 if the current spreadsheet is the default as specified in the 201: course environment. Returns 0 otherwise. 202: 203: =cut 204: 205: ###################################################### 206: sub is_default { 207: my $self = shift; 208: # Check to find out if we are the default spreadsheet (filenames match) 209: my $default_filename = ''; 210: my %tmphash = &Apache::lonnet::get('environment', 211: ['spreadsheet_default_'. 212: $self->{'type'}], 213: $self->{'cdom'}, 214: $self->{'cnum'}); 215: my ($tmp) = keys(%tmphash); 216: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 217: $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}}; 218: } 219: return 1 if ($self->filename() eq $default_filename); 220: return 0; 221: } 222: 223: sub initialize_spreadsheet_package { 224: &load_spreadsheet_expirationdates(); 225: &clear_spreadsheet_definition_cache(); 226: } 227: 228: sub load_spreadsheet_expirationdates { 229: undef %expiredates; 230: my $cid=$ENV{'request.course.id'}; 231: my @tmp = &Apache::lonnet::dump('nohist_expirationdates', 232: $ENV{'course.'.$cid.'.domain'}, 233: $ENV{'course.'.$cid.'.num'}); 234: if (lc($tmp[0]) !~ /^error/){ 235: %expiredates = @tmp; 236: } 237: } 238: 239: sub check_expiration_time { 240: my $self = shift; 241: my ($time)=@_; 242: my ($key1,$key2,$key3,$key4); 243: $key1 = '::'.$self->{'type'}.':'; 244: $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':'; 245: $key3 = $key2.$self->{'container'} if (defined($self->{'container'})); 246: $key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'})); 247: foreach my $key ($key1,$key2,$key3,$key4) { 248: next if (! defined($key)); 249: if (exists($expiredates{$key}) &&$expiredates{$key} > $time) { 250: return 0; 251: } 252: } 253: return 1; 254: } 255: 256: ###################################################### 257: 258: =pod 259: 260: =item &initialize_safe_space 261: 262: Returns the safe space required by a Spreadsheet object. 263: 264: =head 2 Safe Space Functions 265: 266: =over 4 267: 268: =cut 269: 270: ###################################################### 271: sub initialize_safe_space { 272: my $self = shift; 273: my $safeeval = new Safe(shift); 274: my $safehole = new Safe::Hole; 275: $safeeval->permit("entereval"); 276: $safeeval->permit(":base_math"); 277: $safeeval->permit("sort"); 278: $safeeval->deny(":base_io"); 279: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 280: $safehole->wrap(\&mask,$safeeval,'&mask'); 281: $safeeval->share('$@'); 282: my $code=<<'ENDDEFS'; 283: # ---------------------------------------------------- Inside of the safe space 284: # 285: # f: formulas 286: # t: intermediate format (variable references expanded) 287: # v: output values 288: # c: preloaded constants (A-column) 289: # rl: row label 290: # os: other spreadsheets (for student spreadsheet only) 291: undef %sheet_values; # Holds the (computed, final) values for the sheet 292: # This is only written to by &calc, the spreadsheet computation routine. 293: # It is read by many functions 294: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, 295: # which does the translation of strings like C5 into the value in C5. 296: # Used in &calc - %t holds the values that are actually eval'd. 297: undef %f; # Holds the formulas for each cell. This is the users 298: # (spreadsheet authors) data for each cell. 299: undef %c; # Holds the constants for a sheet. In the assessment 300: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, 301: # &sett, and &constants. There is no &getconstants. 302: # &constants is called by &loadstudent, &loadcourse, &load assessment, 303: undef @os; # Holds the names of other spreadsheets - this is used to specify 304: # the spreadsheets that are available for the assessment sheet. 305: # Set by &setothersheets. &setothersheets is called by &handler. A 306: # related subroutine is &othersheets. 307: $errorlog = ''; 308: # 309: $maxrow = 0; 310: $type = ''; 311: # 312: # filename/reference of the sheet 313: $filename = ''; 314: # 315: # user data 316: $name = ''; 317: $uhome = ''; 318: $domain = ''; 319: # 320: # course data 321: $csec = ''; 322: $chome= ''; 323: $cnum = ''; 324: $cdom = ''; 325: $cid = ''; 326: $coursefilename = ''; 327: # 328: # symb 329: $usymb = ''; 330: # 331: # error messages 332: $errormsg = ''; 333: # 334: #------------------------------------------------------- 335: 336: =pod 337: 338: =item NUM(range) 339: 340: returns the number of items in the range. 341: 342: =cut 343: 344: #------------------------------------------------------- 345: sub NUM { 346: my $mask=&mask(@_); 347: my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; 348: return $num; 349: } 350: 351: #------------------------------------------------------- 352: 353: =pod 354: 355: =item BIN(low,high,lower,upper) 356: 357: =cut 358: 359: #------------------------------------------------------- 360: sub BIN { 361: my ($low,$high,$lower,$upper)=@_; 362: my $mask=&mask($lower,$upper); 363: my $num=0; 364: foreach (grep /$mask/,keys(%sheet_values)) { 365: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { 366: $num++; 367: } 368: } 369: return $num; 370: } 371: 372: #------------------------------------------------------- 373: 374: =pod 375: 376: =item SUM(range) 377: 378: returns the sum of items in the range. 379: 380: =cut 381: 382: #------------------------------------------------------- 383: sub SUM { 384: my $mask=&mask(@_); 385: my $sum=0; 386: foreach (grep /$mask/,keys(%sheet_values)) { 387: $sum+=$sheet_values{$_}; 388: } 389: return $sum; 390: } 391: 392: #------------------------------------------------------- 393: 394: =pod 395: 396: =item MEAN(range) 397: 398: compute the average of the items in the range. 399: 400: =cut 401: 402: #------------------------------------------------------- 403: sub MEAN { 404: my $mask=&mask(@_); 405: my $sum=0; 406: my $num=0; 407: foreach (grep /$mask/,keys(%sheet_values)) { 408: $sum+=$sheet_values{$_}; 409: $num++; 410: } 411: if ($num) { 412: return $sum/$num; 413: } else { 414: return undef; 415: } 416: } 417: 418: #------------------------------------------------------- 419: 420: =pod 421: 422: =item STDDEV(range) 423: 424: compute the standard deviation of the items in the range. 425: 426: =cut 427: 428: #------------------------------------------------------- 429: sub STDDEV { 430: my $mask=&mask(@_); 431: my $sum=0; my $num=0; 432: foreach (grep /$mask/,keys(%sheet_values)) { 433: $sum+=$sheet_values{$_}; 434: $num++; 435: } 436: unless ($num>1) { return undef; } 437: my $mean=$sum/$num; 438: $sum=0; 439: foreach (grep /$mask/,keys(%sheet_values)) { 440: $sum+=($sheet_values{$_}-$mean)**2; 441: } 442: return sqrt($sum/($num-1)); 443: } 444: 445: #------------------------------------------------------- 446: 447: =pod 448: 449: =item PROD(range) 450: 451: compute the product of the items in the range. 452: 453: =cut 454: 455: #------------------------------------------------------- 456: sub PROD { 457: my $mask=&mask(@_); 458: my $prod=1; 459: foreach (grep /$mask/,keys(%sheet_values)) { 460: $prod*=$sheet_values{$_}; 461: } 462: return $prod; 463: } 464: 465: #------------------------------------------------------- 466: 467: =pod 468: 469: =item MAX(range) 470: 471: compute the maximum of the items in the range. 472: 473: =cut 474: 475: #------------------------------------------------------- 476: sub MAX { 477: my $mask=&mask(@_); 478: my $max='-'; 479: foreach (grep /$mask/,keys(%sheet_values)) { 480: unless ($max) { $max=$sheet_values{$_}; } 481: if (($sheet_values{$_}>$max) || ($max eq '-')) { 482: $max=$sheet_values{$_}; 483: } 484: } 485: return $max; 486: } 487: 488: #------------------------------------------------------- 489: 490: =pod 491: 492: =item MIN(range) 493: 494: compute the minimum of the items in the range. 495: 496: =cut 497: 498: #------------------------------------------------------- 499: sub MIN { 500: my $mask=&mask(@_); 501: my $min='-'; 502: foreach (grep /$mask/,keys(%sheet_values)) { 503: unless ($max) { $max=$sheet_values{$_}; } 504: if (($sheet_values{$_}<$min) || ($min eq '-')) { 505: $min=$sheet_values{$_}; 506: } 507: } 508: return $min; 509: } 510: 511: #------------------------------------------------------- 512: 513: =pod 514: 515: =item SUMMAX(num,lower,upper) 516: 517: compute the sum of the largest 'num' items in the range from 518: 'lower' to 'upper' 519: 520: =cut 521: 522: #------------------------------------------------------- 523: sub SUMMAX { 524: my ($num,$lower,$upper)=@_; 525: my $mask=&mask($lower,$upper); 526: my @inside=(); 527: foreach (grep /$mask/,keys(%sheet_values)) { 528: push (@inside,$sheet_values{$_}); 529: } 530: @inside=sort(@inside); 531: my $sum=0; my $i; 532: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 533: $sum+=$inside[$i]; 534: } 535: return $sum; 536: } 537: 538: #------------------------------------------------------- 539: 540: =pod 541: 542: =item SUMMIN(num,lower,upper) 543: 544: compute the sum of the smallest 'num' items in the range from 545: 'lower' to 'upper' 546: 547: =cut 548: 549: #------------------------------------------------------- 550: sub SUMMIN { 551: my ($num,$lower,$upper)=@_; 552: my $mask=&mask($lower,$upper); 553: my @inside=(); 554: foreach (grep /$mask/,keys(%sheet_values)) { 555: $inside[$#inside+1]=$sheet_values{$_}; 556: } 557: @inside=sort(@inside); 558: my $sum=0; my $i; 559: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 560: $sum+=$inside[$i]; 561: } 562: return $sum; 563: } 564: 565: #------------------------------------------------------- 566: 567: =pod 568: 569: =item MINPARM(parametername) 570: 571: Returns the minimum value of the parameters matching the parametername. 572: parametername should be a string such as 'duedate'. 573: 574: =cut 575: 576: #------------------------------------------------------- 577: sub MINPARM { 578: my ($expression) = @_; 579: my $min = undef; 580: study($expression); 581: foreach $parameter (keys(%c)) { 582: next if ($parameter !~ /$expression/); 583: if ((! defined($min)) || ($min > $c{$parameter})) { 584: $min = $c{$parameter} 585: } 586: } 587: return $min; 588: } 589: 590: #------------------------------------------------------- 591: 592: =pod 593: 594: =item MAXPARM(parametername) 595: 596: Returns the maximum value of the parameters matching the input parameter name. 597: parametername should be a string such as 'duedate'. 598: 599: =cut 600: 601: #------------------------------------------------------- 602: sub MAXPARM { 603: my ($expression) = @_; 604: my $max = undef; 605: study($expression); 606: foreach $parameter (keys(%c)) { 607: next if ($parameter !~ /$expression/); 608: if ((! defined($min)) || ($max < $c{$parameter})) { 609: $max = $c{$parameter} 610: } 611: } 612: return $max; 613: } 614: 615: 616: sub calc { 617: %sheet_values = %t; 618: my $notfinished = 1; 619: my $lastcalc = ''; 620: my $depth = 0; 621: while ($notfinished) { 622: $notfinished=0; 623: while (my ($cell,$value) = each(%t)) { 624: my $old=$sheet_values{$cell}; 625: $sheet_values{$cell}=eval $value; 626: # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n"; 627: if ($@) { 628: undef %sheet_values; 629: return $cell.': '.$@; 630: } 631: if ($sheet_values{$cell} ne $old) { 632: $notfinished=1; 633: $lastcalc=$cell; 634: } 635: } 636: # $errorlog.="------------------------------------------------"; 637: 638: $depth++; 639: if ($depth>100) { 640: undef %sheet_values; 641: return $lastcalc.': Maximum calculation depth exceeded'; 642: } 643: } 644: return ''; 645: } 646: 647: # ------------------------------------------- End of "Inside of the safe space" 648: ENDDEFS 649: $safeeval->reval($code); 650: $self->{'safe'} = $safeeval; 651: $self->{'root'} = $self->{'safe'}->root(); 652: # 653: # Place some of the %$self items into the safe space except the safe space 654: # itself 655: my $initstring = ''; 656: foreach (qw/name domain type usymb cid csec coursefilename 657: cnum cdom chome uhome/) { 658: $initstring.= qq{\$$_="$self->{$_}";}; 659: } 660: $self->{'safe'}->reval($initstring); 661: return $self; 662: } 663: ###################################################### 664: 665: =pod 666: 667: =back 668: 669: =cut 670: 671: ###################################################### 672: 673: 674: ###################################################### 675: 676: 677: ###################################################### 678: { 679: 680: my %memoizer; 681: 682: sub mask { 683: my ($lower,$upper)=@_; 684: my $key = $lower.'_'.$upper; 685: if (exists($memoizer{$key})) { 686: return $memoizer{$key}; 687: } 688: $upper = $lower if (! defined($upper)); 689: # 690: my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/); 691: my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/); 692: # 693: my $alpha=''; 694: my $num=''; 695: # 696: if (($la eq '*') || ($ua eq '*')) { 697: $alpha='[A-Za-z]'; 698: } else { 699: if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || 700: ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { 701: $alpha='['.$la.'-'.$ua.']'; 702: } else { 703: $alpha='['.$la.'-Za-'.$ua.']'; 704: } 705: } 706: if (($ld eq '*') || ($ud eq '*')) { 707: $num='\d+'; 708: } else { 709: if (length($ld)!=length($ud)) { 710: $num.='('; 711: foreach ($ld=~m/\d/g) { 712: $num.='['.$_.'-9]'; 713: } 714: if (length($ud)-length($ld)>1) { 715: $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; 716: } 717: $num.='|'; 718: foreach ($ud=~m/\d/g) { 719: $num.='[0-'.$_.']'; 720: } 721: $num.=')'; 722: } else { 723: my @lda=($ld=~m/\d/g); 724: my @uda=($ud=~m/\d/g); 725: my $i; 726: my $j=0; 727: my $notdone=1; 728: for ($i=0;($i<=$#lda)&&($notdone);$i++) { 729: if ($lda[$i]==$uda[$i]) { 730: $num.=$lda[$i]; 731: $j=$i; 732: } else { 733: $notdone=0; 734: } 735: } 736: if ($j<$#lda-1) { 737: $num.='('.$lda[$j+1]; 738: for ($i=$j+2;$i<=$#lda;$i++) { 739: $num.='['.$lda[$i].'-9]'; 740: } 741: if ($uda[$j+1]-$lda[$j+1]>1) { 742: $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. 743: ($#lda-$j-1).'}'; 744: } 745: $num.='|'.$uda[$j+1]; 746: for ($i=$j+2;$i<=$#uda;$i++) { 747: $num.='[0-'.$uda[$i].']'; 748: } 749: $num.=')'; 750: } else { 751: if ($lda[-1]!=$uda[-1]) { 752: $num.='['.$lda[-1].'-'.$uda[-1].']'; 753: } 754: } 755: } 756: } 757: my $expression ='^'.$alpha.$num."\$"; 758: $memoizer{$key} = $expression; 759: return $expression; 760: } 761: 762: } 763: 764: ## 765: ## sub add_hash_to_safe {} # spreadsheet, would like to destroy 766: ## 767: 768: # 769: # expandnamed used to reside in the safe space 770: # 771: sub expandnamed { 772: my $self = shift; 773: my $expression=shift; 774: if ($expression=~/^\&/) { 775: my ($func,$var,$formula)=($expression=~/^\&(\w+)$([^\;]+)\;(.*)$/); 776: my @vars=split(/\W+/,$formula); 777: my %values=(); 778: foreach my $varname ( @vars ) { 779: if ($varname=~/\D/) { 780: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; 781: $varname=~s/$var/$[\\w:\\- ]\+$/g; 782: foreach (keys(%{$self->{'constants'}})) { 783: if ($_=~/$varname/) { 784: $values{$1}=1; 785: } 786: } 787: } 788: } 789: if ($func eq 'EXPANDSUM') { 790: my $result=''; 791: foreach (keys(%values)) { 792: my $thissum=$formula; 793: $thissum=~s/$var/$_/g; 794: $result.=$thissum.'+'; 795: } 796: $result=~s/\+$//; 797: return $result; 798: } else { 799: return 0; 800: } 801: } else { 802: # it is not a function, so it is a parameter name 803: # We should do the following: 804: # 1. Take the list of parameter names 805: # 2. look through the list for ones that match the parameter we want 806: # 3. If there are no collisions, return the one that matches 807: # 4. If there is a collision, return 'bad parameter name error' 808: my $returnvalue = ''; 809: my @matches = (); 810: $#matches = -1; 811: study $expression; 812: my $parameter; 813: foreach $parameter (keys(%{$self->{'constants'}})) { 814: push @matches,$parameter if ($parameter =~ /$expression/); 815: } 816: if (scalar(@matches) == 0) { 817: $returnvalue = 'unmatched parameter: '.$parameter; 818: } elsif (scalar(@matches) == 1) { 819: # why do we not do this lookup here, instead of delaying it? 820: $returnvalue = '$c{\''.$matches[0].'\'}'; 821: } elsif (scalar(@matches) > 0) { 822: # more than one match. Look for a concise one 823: $returnvalue = "'non-unique parameter name : $expression'"; 824: foreach (@matches) { 825: if (/^$expression$/) { 826: # why do we not do this lookup here? 827: $returnvalue = '$c{\''.$_.'\'}'; 828: } 829: } 830: } else { 831: # There was a negative number of matches, which indicates 832: # something is wrong with reality. Better warn the user. 833: $returnvalue = 'bizzare parameter: '.$parameter; 834: } 835: return $returnvalue; 836: } 837: } 838: 839: sub sett { 840: my $self = shift; 841: my %t=(); 842: # 843: # Deal with the template row 844: foreach my $col ($self->template_cells()) { 845: next if ($col=~/^[A-Z]/); 846: foreach my $row ($self->rows()) { 847: # Get the name of this cell 848: my $cell=$col.$row; 849: # Grab the template declaration 850: $t{$cell}=$self->formula('template_'.$col); 851: # Replace '#' with the row number 852: $t{$cell}=~s/\#/$row/g; 853: # Replace '....' with ',' 854: $t{$cell}=~s/\.\.+/\,/g; 855: # Replace 'A0' with the value from 'A0' 856: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 857: # Replace parameters 858: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 859: } 860: } 861: # 862: # Deal with the normal cells 863: while (my($cell,$formula) = each(%{$self->{'formulas'}})) { 864: next if ($_=~/^template\_/); 865: my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/); 866: if ($row eq '0') { 867: $t{$cell}=$formula; 868: $t{$cell}=~s/\.\.+/\,/g; 869: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 870: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 871: } elsif ( $col =~ /^[A-Z]$/ ) { 872: if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) { 873: my $data = $self->{'constants'}->{$cell}; 874: $t{$cell} = $data; 875: } 876: } else { # $row > 1 and $col =~ /[a-z] 877: $t{$cell}=$formula; 878: $t{$cell}=~s/\.\.+/\,/g; 879: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 880: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 881: } 882: } 883: %{$self->{'safe'}->varglob('t')}=%t; 884: } 885: 886: ## 887: ## sync_safe_space: Called by calcsheet to make sure all the data we 888: # need to calculate is placed into the safe space 889: ## 890: sub sync_safe_space { 891: my $self = shift; 892: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'. 893: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}}; 894: # 'constants' leads a peaceful hidden life of 'c'. 895: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}}; 896: # 'othersheets' hides as 'os', a disguise few can penetrate. 897: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; 898: } 899: 900: ## 901: ## Retrieve the error log from the safe space (used for debugging) 902: ## 903: sub get_errorlog { 904: my $self = shift; 905: $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') }; 906: return $self->{'errorlog'}; 907: } 908: 909: ## 910: ## Clear the error log inside the safe space 911: ## 912: sub clear_errorlog { 913: my $self = shift; 914: $ {$self->{'safe'}->varglob('errorlog')} = ''; 915: $self->{'errorlog'} = ''; 916: } 917: 918: ## 919: ## constants: either set or get the constants 920: ## 921: sub constants { 922: my $self=shift; 923: my ($constants) = @_; 924: if (defined($constants)) { 925: if (! ref($constants)) { 926: my %tmp = @_; 927: $constants = \%tmp; 928: } 929: $self->{'constants'} = $constants; 930: return; 931: } else { 932: return %{$self->{'constants'}}; 933: } 934: } 935: 936: ## 937: ## formulas: either set or get the formulas 938: ## 939: sub formulas { 940: my $self=shift; 941: my ($formulas) = @_; 942: if (defined($formulas)) { 943: if (! ref($formulas)) { 944: my %tmp = @_; 945: $formulas = \%tmp; 946: } 947: $self->{'formulas'} = $formulas; 948: $self->{'rows'} = []; 949: $self->{'template_cells'} = []; 950: return; 951: } else { 952: return %{$self->{'formulas'}}; 953: } 954: } 955: 956: sub set_formula { 957: my $self = shift; 958: my ($cell,$formula) = @_; 959: $self->{'formulas'}->{$cell}=$formula; 960: return; 961: } 962: 963: ## 964: ## formulas_keys: Return the keys to the formulas hash. 965: ## 966: sub formulas_keys { 967: my $self = shift; 968: my @keys = keys(%{$self->{'formulas'}}); 969: return keys(%{$self->{'formulas'}}); 970: } 971: 972: ## 973: ## formula: Return the formula for a given cell in the spreadsheet 974: ## returns '' if the cell does not have a formula or does not exist 975: ## 976: sub formula { 977: my $self = shift; 978: my $cell = shift; 979: if (defined($cell) && exists($self->{'formulas'}->{$cell})) { 980: return $self->{'formulas'}->{$cell}; 981: } 982: return ''; 983: } 984: 985: ## 986: ## logthis: write the input to lonnet.log 987: ## 988: sub logthis { 989: my $self = shift; 990: my $message = shift; 991: &Apache::lonnet::logthis($self->{'type'}.':'. 992: $self->{'name'}.':'.$self->{'domain'}.':'. 993: $message); 994: return; 995: } 996: 997: ## 998: ## dump_formulas_to_log: makes lonnet.log huge... 999: ## 1000: sub dump_formulas_to_log { 1001: my $self =shift; 1002: $self->logthis("Spreadsheet formulas"); 1003: $self->logthis("--------------------------------------------------------"); 1004: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) { 1005: $self->logthis(' '.$cell.' = '.$formula); 1006: } 1007: $self->logthis("--------------------------------------------------------");} 1008: 1009: ## 1010: ## value: returns the computed value of a particular cell 1011: ## 1012: sub value { 1013: my $self = shift; 1014: my $cell = shift; 1015: if (defined($cell) && exists($self->{'values'}->{$cell})) { 1016: return $self->{'values'}->{$cell}; 1017: } 1018: return ''; 1019: } 1020: 1021: ## 1022: ## dump_values_to_log: makes lonnet.log huge... 1023: ## 1024: sub dump_values_to_log { 1025: my $self =shift; 1026: $self->logthis("Spreadsheet Values"); 1027: $self->logthis("------------------------------------------------------"); 1028: while (my ($cell, $value) = each(%{$self->{'values'}})) { 1029: $self->logthis(' '.$cell.' = '.$value); 1030: } 1031: $self->logthis("------------------------------------------------------"); 1032: } 1033: 1034: ## 1035: ## Yet another debugging function 1036: ## 1037: sub dump_hash_to_log { 1038: my $self= shift(); 1039: my %tmp = @_; 1040: if (@_<2) { 1041: %tmp = %{$_[0]}; 1042: } 1043: $self->logthis('---------------------------- (begin hash dump)'); 1044: while (my ($key,$val) = each (%tmp)) { 1045: $self->logthis(' '.$key.' = '.$val.':'); 1046: } 1047: $self->logthis('---------------------------- (finished hash dump)'); 1048: } 1049: 1050: ## 1051: ## rebuild_stats: rebuilds the rows and template_cells arrays 1052: ## 1053: sub rebuild_stats { 1054: my $self = shift; 1055: $self->{'rows'}=[]; 1056: $self->{'template_cells'}=[]; 1057: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 1058: push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0); 1059: push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/); 1060: } 1061: return; 1062: } 1063: 1064: ## 1065: ## template_cells returns a list of the cells defined in the template row 1066: ## 1067: sub template_cells { 1068: my $self = shift; 1069: $self->rebuild_stats() if (! defined($self->{'template_cells'}) || 1070: ! @{$self->{'template_cells'}}); 1071: return @{$self->{'template_cells'}}; 1072: } 1073: 1074: ## 1075: ## Sigh.... 1076: ## 1077: sub setothersheets { 1078: my $self = shift; 1079: my @othersheets = @_; 1080: $self->{'othersheets'} = \@othersheets; 1081: } 1082: 1083: ## 1084: ## rows returns a list of the names of cells defined in the A column 1085: ## 1086: sub rows { 1087: my $self = shift; 1088: $self->rebuild_stats() if (!@{$self->{'rows'}}); 1089: return @{$self->{'rows'}}; 1090: } 1091: 1092: # 1093: # calcsheet: makes all the calls to compute the spreadsheet. 1094: # 1095: sub calcsheet { 1096: my $self = shift; 1097: $self->sync_safe_space(); 1098: $self->clear_errorlog(); 1099: $self->sett(); 1100: my $result = $self->{'safe'}->reval('&calc();'); 1101: # $self->logthis($self->get_errorlog()); 1102: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; 1103: # $self->logthis($self->get_errorlog()); 1104: return $result; 1105: } 1106: 1107: ########################################################### 1108: ## 1109: ## Output Helpers 1110: ## 1111: ########################################################### 1112: ############################################ 1113: ## HTML output routines ## 1114: ############################################ 1115: sub html_export_row { 1116: my $self = shift(); 1117: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1118: my $row_html; 1119: my @rowdata = $self->get_row(0); 1120: foreach my $cell (@rowdata) { 1121: if ($cell->{'name'} =~ /^[A-Z]/) { 1122: $row_html .= '<td bgcolor="#CCCCFF">'. 1123: &html_editable_cell($cell,'#CCCCFF',$allowed).'</td>'; 1124: } else { 1125: $row_html .= '<td bgcolor="#DDCCFF">'. 1126: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; 1127: } 1128: } 1129: return $row_html; 1130: } 1131: 1132: sub html_template_row { 1133: my $self = shift(); 1134: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1135: my ($num_uneditable) = @_; 1136: my $row_html; 1137: my @rowdata = $self->get_template_row(); 1138: my $count = 0; 1139: for (my $i = 0; $i<=$#rowdata; $i++) { 1140: my $cell = $rowdata[$i]; 1141: if ($i < $num_uneditable) { 1142: $row_html .= '<td bgcolor="#DDCCFF">'. 1143: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; 1144: } else { 1145: $row_html .= '<td bgcolor="#EOFFDD">'. 1146: &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>'; 1147: } 1148: } 1149: return $row_html; 1150: } 1151: 1152: sub html_editable_cell { 1153: my ($cell,$bgcolor,$allowed) = @_; 1154: my $result; 1155: my ($name,$formula,$value); 1156: if (defined($cell)) { 1157: $name = $cell->{'name'}; 1158: $formula = $cell->{'formula'}; 1159: $value = $cell->{'value'}; 1160: } 1161: $name = '' if (! defined($name)); 1162: $formula = '' if (! defined($formula)); 1163: if (! defined($value)) { 1164: $value = '<font color="'.$bgcolor.'">#</font>'; 1165: if ($formula ne '') { 1166: $value = '<i>undefined value</i>'; 1167: } 1168: } elsif ($value =~ /^\s*$/ ) { 1169: $value = '<font color="'.$bgcolor.'">#</font>'; 1170: } else { 1171: $value = &HTML::Entities::encode($value) if ($value !~/ /); 1172: } 1173: return $value if (! $allowed); 1174: # Make the formula safe for outputting 1175: $formula =~ s/\'/\"/g; 1176: # The formula will be parsed by the browser twice before being 1177: # displayed to the user for editing. 1178: $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula)); 1179: # Escape newlines so they make it into the edit window 1180: $formula =~ s/\n/\\n/gs; 1181: # Glue everything together 1182: $result .= "<a href=\"javascript:celledit(\'". 1183: $name."','".$formula."');\">".$value."</a>"; 1184: return $result; 1185: } 1186: 1187: sub html_uneditable_cell { 1188: my ($cell,$bgcolor) = @_; 1189: my $value = (defined($cell) ? $cell->{'value'} : ''); 1190: $value = &HTML::Entities::encode($value) if ($value !~/ /); 1191: return ' '.$value.' '; 1192: } 1193: 1194: sub html_row { 1195: my $self = shift(); 1196: my ($num_uneditable,$row) = @_; 1197: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1198: my @rowdata = $self->get_row($row); 1199: my $num_cols_output = 0; 1200: my $row_html; 1201: foreach my $cell (@rowdata) { 1202: if ($num_cols_output++ < $num_uneditable) { 1203: $row_html .= '<td bgcolor="#FFDDDD">'; 1204: $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); 1205: } else { 1206: $row_html .= '<td bgcolor="#EOFFDD">'; 1207: $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); 1208: } 1209: $row_html .= '</td>'; 1210: } 1211: return $row_html; 1212: } 1213: 1214: sub create_excel_spreadsheet { 1215: my $self = shift; 1216: my ($r) = @_; 1217: my $filename = '/prtspool/'. 1218: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 1219: time.'_'.rand(1000000000).'.xls'; 1220: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); 1221: if (! defined($workbook)) { 1222: $r->log_error("Error creating excel spreadsheet $filename: $!"); 1223: $r->print("Problems creating new Excel file. ". 1224: "This error has been logged. ". 1225: "Please alert your LON-CAPA administrator"); 1226: return undef; 1227: } 1228: # 1229: # The excel spreadsheet stores temporary data in files, then put them 1230: # together. If needed we should be able to disable this (memory only). 1231: # The temporary directory must be specified before calling 'addworksheet'. 1232: # File::Temp is used to determine the temporary directory. 1233: $workbook->set_tempdir('/home/httpd/perl/tmp'); 1234: # 1235: # Determine the name to give the worksheet 1236: return ($workbook,$filename); 1237: } 1238: 1239: ############################################ 1240: ## XML output routines ## 1241: ############################################ 1242: sub outsheet_xml { 1243: my $self = shift; 1244: my ($r) = @_; 1245: ## Someday XML 1246: ## Will be rendered for the user 1247: ## But not on this day 1248: my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n"; 1249: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 1250: if ($cell =~ /^template_(\d+)/) { 1251: my $col = $1; 1252: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n"; 1253: } else { 1254: my ($row,$col) = ($cell =~ /^([A-z])(\d+)/); 1255: next if (! defined($row) || ! defined($col)); 1256: $Str .= '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</cell>' 1257: ."\n"; 1258: } 1259: } 1260: $Str.="</spreadsheet>"; 1261: return $Str; 1262: } 1263: 1264: ############################################ 1265: ### Filesystem routines ### 1266: ############################################ 1267: sub parse_sheet { 1268: # $sheetxml is a scalar reference or a scalar 1269: my ($sheetxml) = @_; 1270: if (! ref($sheetxml)) { 1271: my $tmp = $sheetxml; 1272: $sheetxml = \$tmp; 1273: } 1274: my %formulas; 1275: my %sources; 1276: my $parser=HTML::TokeParser->new($sheetxml); 1277: my $token; 1278: while ($token=$parser->get_token) { 1279: if ($token->[0] eq 'S') { 1280: if ($token->[1] eq 'field') { 1281: my $cell = $token->[2]->{'col'}.$token->[2]->{'row'}; 1282: my $source = $token->[2]->{'source'}; 1283: my $formula = $parser->get_text('/field'); 1284: $formulas{$cell} = $formula; 1285: $sources{$cell} = $source if (defined($source)); 1286: $parser->get_text('/field'); 1287: } 1288: if ($token->[1] eq 'template') { 1289: $formulas{'template_'.$token->[2]->{'col'}}= 1290: $parser->get_text('/template'); 1291: } 1292: } 1293: } 1294: return (\%formulas,\%sources); 1295: } 1296: 1297: { 1298: 1299: my %spreadsheets; 1300: 1301: sub clear_spreadsheet_definition_cache { 1302: undef(%spreadsheets); 1303: } 1304: 1305: sub load { 1306: my $self = shift; 1307: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'}; 1308: # 1309: my $stype = $self->{'type'}; 1310: my $cnum = $self->{'cnum'}; 1311: my $cdom = $self->{'cdom'}; 1312: my $chome = $self->{'chome'}; 1313: my $filename = $self->{'filename'}; 1314: # 1315: my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); 1316: # 1317: # see if sheet is cached 1318: my ($formulas); 1319: if (exists($spreadsheets{$cachekey})) { 1320: $formulas = $spreadsheets{$cachekey}->{'formulas'}; 1321: } else { 1322: # Not cached, need to read 1323: if (! defined($self->filename())) { 1324: # load in the default defined spreadsheet 1325: my $sheetxml=''; 1326: my $fh; 1327: if ($fh=Apache::File->new($includedir.'/default.'.$filename)) { 1328: $sheetxml=join('',<$fh>); 1329: $fh->close(); 1330: } else { 1331: # $sheetxml='<field row="0" col="A">"Error"</field>'; 1332: $sheetxml='<field row="0" col="A"></field>'; 1333: } 1334: ($formulas,undef) = &parse_sheet(\$sheetxml); 1335: } elsif($self->filename() =~ /^\/*\.spreadsheet$/) { 1336: # Load a spreadsheet definition file 1337: my $sheetxml=&Apache::lonnet::getfile 1338: (&Apache::lonnet::filelocation('',$filename)); 1339: if ($sheetxml == -1) { 1340: $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' 1341: .$self->filename().'"</field>'; 1342: } 1343: ($formulas,undef) = &parse_sheet(\$sheetxml); 1344: } else { 1345: # Load the spreadsheet definition file from the save file 1346: my %tmphash = &Apache::lonnet::dump($self->filename(),$cdom,$cnum); 1347: my ($tmp) = keys(%tmphash); 1348: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 1349: while (my ($cell,$formula) = each(%tmphash)) { 1350: $formulas->{$cell}=$formula; 1351: } 1352: } else { 1353: # Unable to grab the specified spreadsheet, 1354: # so we get the default ones instead. 1355: $filename = 'default.'.$stype; 1356: $self->filename($filename); 1357: my $sheetxml; 1358: if (my $fh=Apache::File->new($includedir.'/'.$filename)) { 1359: $sheetxml = join('',<$fh>); 1360: $fh->close(); 1361: } else { 1362: $sheetxml='<field row="0" col="A">'. 1363: '"Unable to load spreadsheet"</field>'; 1364: } 1365: ($formulas,undef) = &parse_sheet(\$sheetxml); 1366: $self->formulas($formulas); 1367: } 1368: } 1369: $cachekey = join('_',($cnum,$cdom,$stype,$filename)); 1370: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; 1371: } 1372: $self->formulas($formulas); 1373: $self->set_row_sources(); 1374: $self->set_row_numbers(); 1375: } 1376: 1377: sub set_row_sources { 1378: my $self = shift; 1379: while (my ($cell,$value) = each(%{$self->{'formulas'}})) { 1380: next if ($cell !~ /^A(\d+)/ && $1 > 0); 1381: my $row = $1; 1382: $self->{'row_source'}->{$row} = $value; 1383: } 1384: return; 1385: } 1386: 1387: ## 1388: ## exportrow is *not* used to get the export row from a computed sub-sheet. 1389: ## 1390: sub exportrow { 1391: my $self = shift; 1392: my @exportarray; 1393: foreach my $column (@UC_Columns) { 1394: push(@exportarray,$self->value($column.'0')); 1395: } 1396: return @exportarray; 1397: } 1398: 1399: sub save { 1400: my $self = shift; 1401: my ($makedef)=@_; 1402: my $cid=$self->{'cid'}; 1403: if (&Apache::lonnet::allowed('opa',$cid)) { 1404: my %f=$self->formulas(); 1405: my $stype = $self->{'type'}; 1406: my $cnum = $self->{'cnum'}; 1407: my $cdom = $self->{'cdom'}; 1408: my $chome = $self->{'chome'}; 1409: my $fn = $self->{'filename'}; 1410: # Cache new sheet 1411: $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); 1412: # Write sheet 1413: foreach (keys(%f)) { 1414: delete($f{$_}) if ($f{$_} eq 'import'); 1415: } 1416: my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum); 1417: return $reply if ($reply ne 'ok'); 1418: $reply = &Apache::lonnet::put($stype.'_spreadsheets', 1419: {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, 1420: $cdom,$cnum); 1421: return $reply if ($reply ne 'ok'); 1422: if ($makedef) { 1423: $reply = &Apache::lonnet::put('environment', 1424: {'spreadsheet_default_'.$stype => $fn }, 1425: $cdom,$cnum); 1426: return $reply if ($reply ne 'ok'); 1427: } 1428: if ($self->is_default()) { 1429: &Apache::lonnet::expirespread('','',$self->{'type'},''); 1430: } 1431: return $reply; 1432: } 1433: return 'unauthorized'; 1434: } 1435: 1436: } # end of scope for %spreadsheets 1437: 1438: sub save_tmp { 1439: my $self = shift; 1440: my $fn=$ENV{'user.name'}.'_'. 1441: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. 1442: $self->{'filename'}; 1443: $fn=~s/\W/\_/g; 1444: $fn=$Apache::lonnet::tmpdir.$fn.'.tmp'; 1445: my $fh; 1446: if ($fh=Apache::File->new('>'.$fn)) { 1447: my %f = $self->formulas(); 1448: while( my ($cell,$formula) = each(%f)) { 1449: next if ($formula eq 'import'); 1450: print $fh &Apache::lonnet::escape($cell)."=". 1451: &Apache::lonnet::escape($formula)."\n"; 1452: } 1453: $fh->close(); 1454: } 1455: } 1456: 1457: sub load_tmp { 1458: my $self = shift; 1459: my $filename=$ENV{'user.name'}.'_'. 1460: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'. 1461: $self->{'filename'}; 1462: $filename=~s/\W/\_/g; 1463: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; 1464: my %formulas = (); 1465: if (my $spreadsheet_file = Apache::File->new($filename)) { 1466: while (<$spreadsheet_file>) { 1467: chomp; 1468: my ($cell,$formula) = split(/=/); 1469: $cell = &Apache::lonnet::unescape($cell); 1470: $formula = &Apache::lonnet::unescape($formula); 1471: $formulas{$cell} = $formula; 1472: } 1473: $spreadsheet_file->close(); 1474: } 1475: $self->formulas(\%formulas); 1476: $self->set_row_sources(); 1477: $self->set_row_numbers(); 1478: return; 1479: } 1480: 1481: sub modify_cell { 1482: # studentcalc overrides this 1483: my $self = shift; 1484: my ($cell,$formula) = @_; 1485: if ($cell =~ /([A-z])\-/) { 1486: $cell = 'template_'.$1; 1487: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) { 1488: return; 1489: } 1490: $self->set_formula($cell,$formula); 1491: $self->rebuild_stats(); 1492: return; 1493: } 1494: 1495: ########################################### 1496: # othersheets: Returns the list of other spreadsheets available 1497: ########################################### 1498: sub othersheets { 1499: my $self = shift(); 1500: my ($stype) = @_; 1501: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); 1502: # 1503: my @alternatives=(); 1504: my %results=&Apache::lonnet::dump($stype.'_spreadsheets', 1505: $self->{'cdom'}, $self->{'cnum'}); 1506: my ($tmp) = keys(%results); 1507: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) { 1508: @alternatives = ('Default'); 1509: } else { 1510: @alternatives = sort (keys(%results)); 1511: } 1512: return @alternatives; 1513: } 1514: 1515: sub blackout { 1516: my $self = shift; 1517: $self->{'blackout'} = $_[0] if (@_); 1518: return $self->{'blackout'}; 1519: } 1520: 1521: sub get_row { 1522: my $self = shift; 1523: my ($n)=@_; 1524: my @cols=(); 1525: foreach my $col (@UC_Columns,@LC_Columns) { 1526: my $cell = $col.$n; 1527: push(@cols,{ name => $cell, 1528: formula => $self->formula($cell), 1529: value => $self->value($cell)}); 1530: } 1531: return @cols; 1532: } 1533: 1534: sub get_template_row { 1535: my $self = shift; 1536: my @cols=(); 1537: foreach my $col (@UC_Columns,@LC_Columns) { 1538: my $cell = 'template_'.$col; 1539: push(@cols,{ name => $cell, 1540: formula => $self->formula($cell), 1541: value => $self->formula($cell) }); 1542: } 1543: return @cols; 1544: } 1545: 1546: sub set_row_numbers { 1547: my $self = shift; 1548: my %f=$self->formulas(); 1549: while (my ($cell,$value) = each(%{$self->{'formulas'}})) { 1550: next if ($cell !~ /^A(\d+)$/); 1551: next if (! defined($value)); 1552: $self->{'row_numbers'}->{$value} = $1; 1553: } 1554: } 1555: 1556: sub get_row_number_from_key { 1557: my $self = shift; 1558: my ($key) = @_; 1559: if (! exists($self->{'row_numbers'}->{$key}) || 1560: ! defined($self->{'row_numbers'}->{$key})) { 1561: # I used to set $f here to the new value, but the key passed for lookup 1562: # may not be the key we need to save 1563: $self->{'maxrow'}++; 1564: $self->{'row_numbers'}->{$key} = $self->{'maxrow'}; 1565: } 1566: return $self->{'row_numbers'}->{$key}; 1567: } 1568: 1569: 1; 1570: 1571: __END__