loncom/interface/spreadsheet/Spreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / Spreadsheet.pm
Revision 1.4: download - view: text, annotated - select for diffs
Fri May 23 14:52:51 2003 UTC (21 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD

No longer save the results of computation of temporary spreadsheets.
Added Spreadsheet->temporary() to handle the getting and setting of the flag
which indicates a spreadsheet is temporary.  studentcalc.pm and assesscalc.pm
check this flag before saving their export rows.

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