loncom/interface/spreadsheet/Spreadsheet.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / Spreadsheet.pm
Revision 1.36: download - view: text, annotated - select for diffs
Tue Feb 24 20:47:14 2004 UTC (20 years, 4 months ago) by matthew
Branches: MAIN
CVS tags: version_1_1_X, version_1_1_3, version_1_1_2, HEAD

These fixes should go on S10 as soon as possible.

Spreadsheet.pm: Fix to handle the case when a spreadsheet object is
created without a valid username/domain passed to new().

assesscalc.pm: Fix to ignore stored data which does not contain the username
and domain.

lonspreadsheet.pm: Fix to not do stupid things that got us in this mess
in the first place (only accept form parameters which have values and do not
send out form parameters without values).

1: # 2: # $Id: Spreadsheet.pm,v 1.36 2004/02/24 20:47:14 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 warnings FATAL=>'all'; 52: #no warnings 'uninitialized'; 53: use Apache::Constants qw(:common :http); 54: use Apache::lonnet; 55: use Safe; 56: use Safe::Hole; 57: use Opcode; 58: use HTML::Entities(); 59: use HTML::TokeParser; 60: use Spreadsheet::WriteExcel; 61: use Time::HiRes; 62: use Apache::lonlocal; 63: 64: ## 65: ## Package Variables 66: ## 67: my %expiredates; 68: 69: my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 70: my @LC_Columns = split(//,'abcdefghijklmnopqrstuvwxyz'); 71: 72: ###################################################### 73: 74: =pod 75: 76: =item &new 77: 78: Returns a new spreadsheet object. 79: 80: =cut 81: 82: ###################################################### 83: sub new { 84: my $this = shift; 85: my $class = ref($this) || $this; 86: my ($stype) = ($class =~ /Apache::(.*)$/); 87: # 88: my ($name,$domain,$filename,$usymb)=@_; 89: if (! defined($name) || $name eq '') { 90: $name = $ENV{'user.name'}; 91: } 92: if (! defined($domain) || $domain eq '') { 93: $domain = $ENV{'user.domain'}; 94: } 95: # 96: my $self = { 97: name => $name, 98: domain => $domain, 99: type => $stype, 100: symb => $usymb, 101: errorlog => '', 102: maxrow => 0, 103: cid => $ENV{'request.course.id'}, 104: cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, 105: cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 106: chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'}, 107: coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, 108: coursefilename => $ENV{'request.course.fn'}, 109: # 110: # Flags 111: temporary => 0, # true if this sheet has been modified but not saved 112: new_rows => 0, # true if this sheet has new rows 113: # 114: # blackout is used to determine if any data needs to be hidden from the 115: # student. 116: blackout => 0, 117: # 118: # Data storage 119: formulas => {}, 120: constants => {}, 121: rows => [], 122: row_source => {}, 123: othersheets => [], 124: }; 125: # 126: $self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain); 127: # 128: bless($self,$class); 129: # 130: # Load in the spreadsheet definition 131: $self->filename($filename); 132: if (exists($ENV{'form.workcopy'}) && 133: $self->{'type'} eq $ENV{'form.workcopy'}) { 134: $self->load_tmp(); 135: } else { 136: $self->load(); 137: } 138: return $self; 139: } 140: 141: ###################################################### 142: 143: =pod 144: 145: =item &filename 146: 147: get or set the filename for a spreadsheet. 148: 149: =cut 150: 151: ###################################################### 152: sub filename { 153: my $self = shift(); 154: if (@_) { 155: my ($newfilename) = @_; 156: if (! defined($newfilename) || $newfilename eq 'Default' || 157: $newfilename !~ /\w/ || $newfilename eq '') { 158: my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'. 159: $self->{'type'}; 160: if (exists($ENV{$key}) && $ENV{$key} ne '') { 161: $newfilename = $ENV{$key}; 162: } else { 163: $newfilename = 'default_'.$self->{'type'}; 164: } 165: } 166: if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) { 167: $newfilename = 'default_'.$self->{'type'}; 168: } 169: if ($newfilename !~ /^default\.$self->{'type'}$/ && 170: $newfilename !~ /^\/res\/(.*)spreadsheet$/) { 171: if ($newfilename !~ /_$self->{'type'}$/) { 172: $newfilename =~ s/[\s_]*$//; 173: $newfilename .= '_'.$self->{'type'}; 174: } 175: } 176: $self->{'filename'} = $newfilename; 177: return; 178: } 179: return $self->{'filename'}; 180: } 181: 182: ###################################################### 183: 184: =pod 185: 186: =item &make_default() 187: 188: Make the current spreadsheet file the default for the course. Expires all the 189: default spreadsheets.......! 190: 191: =cut 192: 193: ###################################################### 194: sub make_default { 195: my $self = shift(); 196: my $result = &Apache::lonnet::put('environment', 197: {'spreadsheet_default_'.$self->{'type'} => $self->filename()}, 198: $self->{'cdom'},$self->{'cnum'}); 199: return $result if ($result ne 'ok'); 200: my $symb = $self->{'symb'}; 201: $symb = '' if (! defined($symb)); 202: &Apache::lonnet::expirespread('','',$self->{'type'},$symb); 203: } 204: 205: ###################################################### 206: 207: =pod 208: 209: =item &is_default() 210: 211: Returns 1 if the current spreadsheet is the default as specified in the 212: course environment. Returns 0 otherwise. 213: 214: =cut 215: 216: ###################################################### 217: sub is_default { 218: my $self = shift; 219: # Check to find out if we are the default spreadsheet (filenames match) 220: my $default_filename = ''; 221: my %tmphash = &Apache::lonnet::get('environment', 222: ['spreadsheet_default_'. 223: $self->{'type'}], 224: $self->{'cdom'}, 225: $self->{'cnum'}); 226: my ($tmp) = keys(%tmphash); 227: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 228: $default_filename = $tmphash{'spreadsheet_default_'.$self->{'type'}}; 229: } 230: if ($default_filename =~ /^\s*$/) { 231: $default_filename = 'default_'.$self->{'type'}; 232: } 233: return 1 if ($self->filename() eq $default_filename); 234: return 0; 235: } 236: 237: sub initialize { 238: # This method is here to remind you that it will be overridden by 239: # the descendents of the spreadsheet class. 240: } 241: 242: sub clear_package { 243: # This method is here to remind you that it will be overridden by 244: # the descendents of the spreadsheet class. 245: } 246: 247: sub cleanup { 248: my $self = shift(); 249: $self->clear_package(); 250: } 251: 252: sub initialize_spreadsheet_package { 253: &load_spreadsheet_expirationdates(); 254: &clear_spreadsheet_definition_cache(); 255: } 256: 257: sub load_spreadsheet_expirationdates { 258: undef %expiredates; 259: my $cid=$ENV{'request.course.id'}; 260: my @tmp = &Apache::lonnet::dump('nohist_expirationdates', 261: $ENV{'course.'.$cid.'.domain'}, 262: $ENV{'course.'.$cid.'.num'}); 263: if (lc($tmp[0]) !~ /^error/){ 264: %expiredates = @tmp; 265: } 266: } 267: 268: sub check_expiration_time { 269: my $self = shift; 270: my ($time)=@_; 271: return 0 if (! defined($time)); 272: my ($key1,$key2,$key3,$key4,$key5); 273: # Description of keys 274: # 275: # key1: all sheets of this type have expired 276: # key2: all sheets of this type for this student 277: # key3: all sheets of this type in this map for this student 278: # key4: this assessment sheet for this student 279: # key5: this assessment sheet for all students 280: $key1 = '::'.$self->{'type'}.':'; 281: $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':'; 282: $key3 = $key2.$self->{'container'} if (defined($self->{'container'})); 283: $key4 = $key2.$self->{'symb'} if (defined($self->{'symb'})); 284: $key5 = $key1.$self->{'symb'} if (defined($self->{'symb'})); 285: my $returnvalue = 1; # default to okay 286: foreach my $key ($key1,$key2,$key3,$key4,$key5) { 287: next if (! defined($key)); 288: if (exists($expiredates{$key}) && $expiredates{$key} > $time) { 289: $returnvalue = 0; # need to recompute 290: } 291: } 292: return $returnvalue; 293: } 294: 295: ###################################################### 296: 297: =pod 298: 299: =item &initialize_safe_space 300: 301: Returns the safe space required by a Spreadsheet object. 302: 303: =head 2 Safe Space Functions 304: 305: =over 4 306: 307: =cut 308: 309: ###################################################### 310: { 311: 312: my $safeeval; 313: 314: sub initialize_safe_space { 315: my $self = shift; 316: if (! defined($safeeval)) { 317: $safeeval = new Safe(shift); 318: my $safehole = new Safe::Hole; 319: $safeeval->permit("entereval"); 320: $safeeval->permit(":base_math"); 321: $safeeval->permit("sort"); 322: $safeeval->deny(":base_io"); 323: $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); 324: $safehole->wrap(\&mask,$safeeval,'&mask'); 325: $safeeval->share('$@'); 326: my $code=<<'ENDDEFS'; 327: # ---------------------------------------------------- Inside of the safe space 328: # 329: # f: formulas 330: # t: intermediate format (variable references expanded) 331: # v: output values 332: # c: preloaded constants (A-column) 333: # rl: row label 334: # os: other spreadsheets (for student spreadsheet only) 335: undef %sheet_values; # Holds the (computed, final) values for the sheet 336: # This is only written to by &calc, the spreadsheet computation routine. 337: # It is read by many functions 338: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, 339: # which does the translation of strings like C5 into the value in C5. 340: # Used in &calc - %t holds the values that are actually eval'd. 341: undef %f; # Holds the formulas for each cell. This is the users 342: # (spreadsheet authors) data for each cell. 343: undef %c; # Holds the constants for a sheet. In the assessment 344: # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, 345: # &sett, and &constants. There is no &getconstants. 346: # &constants is called by &loadstudent, &loadcourse, &load assessment, 347: undef @os; # Holds the names of other spreadsheets - this is used to specify 348: # the spreadsheets that are available for the assessment sheet. 349: # Set by &setothersheets. &setothersheets is called by &handler. A 350: # related subroutine is &othersheets. 351: $errorlog = ''; 352: # 353: $maxrow = 0; 354: $type = ''; 355: # 356: # filename/reference of the sheet 357: $filename = ''; 358: # 359: # user data 360: $name = ''; 361: $uhome = ''; 362: $domain = ''; 363: # 364: # course data 365: $csec = ''; 366: $chome= ''; 367: $cnum = ''; 368: $cdom = ''; 369: $cid = ''; 370: $coursefilename = ''; 371: # 372: # symb 373: $usymb = ''; 374: # 375: # error messages 376: $errormsg = ''; 377: # 378: #------------------------------------------------------- 379: 380: =pod 381: 382: =item NUM(range) 383: 384: returns the number of items in the range. 385: 386: =cut 387: 388: #------------------------------------------------------- 389: sub NUM { 390: my $mask=&mask(@_); 391: my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1; 392: return $num; 393: } 394: 395: #------------------------------------------------------- 396: 397: =pod 398: 399: =item BIN(low,high,lower,upper) 400: 401: =cut 402: 403: #------------------------------------------------------- 404: sub BIN { 405: my ($low,$high,$lower,$upper)=@_; 406: my $mask=&mask($lower,$upper); 407: my $num=0; 408: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 409: if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { 410: $num++; 411: } 412: } 413: return $num; 414: } 415: 416: #------------------------------------------------------- 417: 418: =pod 419: 420: =item SUM(range) 421: 422: returns the sum of items in the range. 423: 424: =cut 425: 426: #------------------------------------------------------- 427: sub SUM { 428: my $mask=&mask(@_); 429: my $sum=0; 430: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 431: $sum+=$sheet_values{$_}; 432: } 433: return $sum; 434: } 435: 436: #------------------------------------------------------- 437: 438: =pod 439: 440: =item MEAN(range) 441: 442: compute the average of the items in the range. 443: 444: =cut 445: 446: #------------------------------------------------------- 447: sub MEAN { 448: my $mask=&mask(@_); 449: my $sum=0; 450: my $num=0; 451: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 452: $sum+=$sheet_values{$_}; 453: $num++; 454: } 455: if ($num) { 456: return $sum/$num; 457: } else { 458: return undef; 459: } 460: } 461: 462: #------------------------------------------------------- 463: 464: =pod 465: 466: =item STDDEV(range) 467: 468: compute the standard deviation of the items in the range. 469: 470: =cut 471: 472: #------------------------------------------------------- 473: sub STDDEV { 474: my $mask=&mask(@_); 475: my $sum=0; my $num=0; 476: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 477: $sum+=$sheet_values{$_}; 478: $num++; 479: } 480: unless ($num>1) { return undef; } 481: my $mean=$sum/$num; 482: $sum=0; 483: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 484: $sum+=($sheet_values{$_}-$mean)**2; 485: } 486: return sqrt($sum/($num-1)); 487: } 488: 489: #------------------------------------------------------- 490: 491: =pod 492: 493: =item PROD(range) 494: 495: compute the product of the items in the range. 496: 497: =cut 498: 499: #------------------------------------------------------- 500: sub PROD { 501: my $mask=&mask(@_); 502: my $prod=1; 503: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 504: $prod*=$sheet_values{$_}; 505: } 506: return $prod; 507: } 508: 509: #------------------------------------------------------- 510: 511: =pod 512: 513: =item MAX(range) 514: 515: compute the maximum of the items in the range. 516: 517: =cut 518: 519: #------------------------------------------------------- 520: sub MAX { 521: my $mask=&mask(@_); 522: my $max='-'; 523: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 524: unless ($max) { $max=$sheet_values{$_}; } 525: if (($sheet_values{$_}>$max) || ($max eq '-')) { 526: $max=$sheet_values{$_}; 527: } 528: } 529: return $max; 530: } 531: 532: #------------------------------------------------------- 533: 534: =pod 535: 536: =item MIN(range) 537: 538: compute the minimum of the items in the range. 539: 540: =cut 541: 542: #------------------------------------------------------- 543: sub MIN { 544: my $mask=&mask(@_); 545: my $min='-'; 546: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 547: unless ($max) { $max=$sheet_values{$_}; } 548: if (($sheet_values{$_}<$min) || ($min eq '-')) { 549: $min=$sheet_values{$_}; 550: } 551: } 552: return $min; 553: } 554: 555: #------------------------------------------------------- 556: 557: =pod 558: 559: =item SUMMAX(num,lower,upper) 560: 561: compute the sum of the largest 'num' items in the range from 562: 'lower' to 'upper' 563: 564: =cut 565: 566: #------------------------------------------------------- 567: sub SUMMAX { 568: my ($num,$lower,$upper)=@_; 569: my $mask=&mask($lower,$upper); 570: my @inside=(); 571: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 572: push (@inside,$sheet_values{$_}); 573: } 574: @inside=sort(@inside); 575: my $sum=0; my $i; 576: for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 577: $sum+=$inside[$i]; 578: } 579: return $sum; 580: } 581: 582: #------------------------------------------------------- 583: 584: =pod 585: 586: =item SUMMIN(num,lower,upper) 587: 588: compute the sum of the smallest 'num' items in the range from 589: 'lower' to 'upper' 590: 591: =cut 592: 593: #------------------------------------------------------- 594: sub SUMMIN { 595: my ($num,$lower,$upper)=@_; 596: my $mask=&mask($lower,$upper); 597: my @inside=(); 598: foreach (grep eval("/$mask/"),keys(%sheet_values)) { 599: $inside[$#inside+1]=$sheet_values{$_}; 600: } 601: @inside=sort(@inside); 602: my $sum=0; my $i; 603: for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 604: $sum+=$inside[$i]; 605: } 606: return $sum; 607: } 608: 609: #------------------------------------------------------- 610: 611: =pod 612: 613: =item MINPARM(parametername) 614: 615: Returns the minimum value of the parameters matching the parametername. 616: parametername should be a string such as 'duedate'. 617: 618: =cut 619: 620: #------------------------------------------------------- 621: sub MINPARM { 622: my ($expression) = @_; 623: my $min = undef; 624: foreach $parameter (keys(%c)) { 625: next if ($parameter !~ /$expression/); 626: if ((! defined($min)) || ($min > $c{$parameter})) { 627: $min = $c{$parameter} 628: } 629: } 630: return $min; 631: } 632: 633: #------------------------------------------------------- 634: 635: =pod 636: 637: =item MAXPARM(parametername) 638: 639: Returns the maximum value of the parameters matching the input parameter name. 640: parametername should be a string such as 'duedate'. 641: 642: =cut 643: 644: #------------------------------------------------------- 645: sub MAXPARM { 646: my ($expression) = @_; 647: my $max = undef; 648: foreach $parameter (keys(%c)) { 649: next if ($parameter !~ /$expression/); 650: if ((! defined($min)) || ($max < $c{$parameter})) { 651: $max = $c{$parameter} 652: } 653: } 654: return $max; 655: } 656: 657: 658: sub calc { 659: %sheet_values = %t; 660: my $notfinished = 1; 661: my $lastcalc = ''; 662: my $depth = 0; 663: while ($notfinished) { 664: $notfinished=0; 665: while (my ($cell,$value) = each(%t)) { 666: my $old=$sheet_values{$cell}; 667: $sheet_values{$cell}=eval $value; 668: # $errorlog .= $cell.' = '.$old.'->'.$sheet_values{$cell}."\n"; 669: if ($@) { 670: undef %sheet_values; 671: return $cell.': '.$@; 672: } 673: if ($sheet_values{$cell} ne $old) { 674: $notfinished=1; 675: $lastcalc=$cell; 676: } 677: } 678: # $errorlog.="------------------------------------------------"; 679: 680: $depth++; 681: if ($depth>100) { 682: undef %sheet_values; 683: return $lastcalc.': Maximum calculation depth exceeded'; 684: } 685: } 686: return 'okay'; 687: } 688: 689: # ------------------------------------------- End of "Inside of the safe space" 690: ENDDEFS 691: $safeeval->reval($code); 692: } 693: $self->{'safe'} = $safeeval; 694: $self->{'root'} = $self->{'safe'}->root(); 695: # 696: # Place some of the %$self items into the safe space except the safe space 697: # itself 698: my $initstring = ''; 699: foreach (qw/name domain type usymb cid csec coursefilename 700: cnum cdom chome uhome/) { 701: $initstring.= qq{\$$_="$self->{$_}";}; 702: } 703: $self->{'safe'}->reval($initstring); 704: return $self; 705: } 706: 707: } 708: 709: ###################################################### 710: 711: =pod 712: 713: =back 714: 715: =cut 716: 717: ###################################################### 718: 719: 720: ###################################################### 721: 722: =pod 723: 724: =item &mask($lower,$upper) 725: 726: Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*"). 727: 728: Returns: Regular expression matching spreadsheet cells that are within 729: the rectangle defined by $lower and $upper. Due to the nature of the 730: regular expression this result must be used inside an eval(). 731: 732: =cut 733: 734: ###################################################### 735: { 736: 737: my %memoizer; 738: 739: sub mask { 740: my ($lower,$upper)=@_; 741: my $key = $lower.'_'.$upper; 742: if (exists($memoizer{$key})) { 743: return $memoizer{$key}; 744: } 745: $upper = $lower if (! defined($upper)); 746: # 747: my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/); 748: my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/); 749: # 750: my $alpha=''; 751: my $num=''; 752: # 753: # Do not put parenthases around $alpha. 754: # $num depends on the value in $1. 755: if (($la eq '*') || ($ua eq '*')) { 756: $alpha='[A-z]'; 757: } else { 758: if ($la gt $ua) { 759: my $tmp = $ua; 760: $ua = $la; 761: $la = $ua; 762: } 763: $alpha=qq/[$la-$ua]/; 764: } 765: if ($ld ne '*' && $ud ne '*') { 766: # Make sure $ld <= $ud 767: if ($ld > $ud) { 768: my $tmp = $ud; 769: $ud = $ld; 770: $ld = $tmp; 771: } 772: # Here we make a regular expression using some advanced regexp 773: # abilities. 774: # (\d+) will match the digits of the cell name and dump them in 775: # to $1 776: # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will 777: # choose pattern_if_true if { ... code ... } is true and 778: # pattern_if_false if { ... code ... } is false. 779: # In this case, pattern_if_true is empty. pattern_if_false is 780: # 'donotmatch' and will not match our cells because none of 781: # them end with donotmatch. 782: # Unfortunately, the use of this type of regular expression 783: # requires that each match be wrapped in an eval(). Search for 784: # $mask in this module for examples 785: $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)'; 786: } else { 787: $num = '(\d+)'; 788: } 789: my $expression = '^'.$alpha.$num.'$'; 790: $memoizer{$key} = $expression; 791: return $expression; 792: } 793: 794: # 795: # Debugging routine 796: sub dump_memoized_values { 797: while (my ($key,$value) = each(%memoizer)) { 798: &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value); 799: } 800: return; 801: } 802: 803: } 804: 805: ## 806: ## sub add_hash_to_safe {} # spreadsheet, would like to destroy 807: ## 808: 809: # 810: # expandnamed used to reside in the safe space 811: # 812: sub expandnamed { 813: my $self = shift; 814: my $expression=shift; 815: if ($expression=~/^\&/) { 816: my ($func,$var,$formula)=($expression=~/^\&(\w+)$([^\;]+)\;(.*)$/); 817: my @vars=split(/\W+/,$formula); 818: my %values=(); 819: foreach my $varname ( @vars ) { 820: if ($varname=~/^(parameter|stores|timestamp)/) { 821: $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; 822: $varname=~s/$var/$[\\w:\\- ]\+$/g; 823: foreach (keys(%{$self->{'constants'}})) { 824: if ($_=~/$varname/) { 825: $values{$1}=1; 826: } 827: } 828: } 829: } 830: if ($func eq 'EXPANDSUM') { 831: my $result=''; 832: foreach (keys(%values)) { 833: my $thissum=$formula; 834: $thissum=~s/$var/$_/g; 835: $result.=$thissum.'+'; 836: } 837: $result=~s/\+$//; 838: return $result; 839: } else { 840: return 0; 841: } 842: } else { 843: # it is not a function, so it is a parameter name 844: # We should do the following: 845: # 1. Take the list of parameter names 846: # 2. look through the list for ones that match the parameter we want 847: # 3. If there are no collisions, return the one that matches 848: # 4. If there is a collision, return 'bad parameter name error' 849: my $returnvalue = ''; 850: my @matches = (); 851: my @values = (); 852: $#matches = -1; 853: while (my($parameter,$value) = each(%{$self->{'constants'}})) { 854: next if ($parameter !~ /$expression/); 855: push(@matches,$parameter); 856: push(@values,$value); 857: } 858: if (scalar(@matches) == 0) { 859: $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"'; 860: } elsif (scalar(@matches) == 1) { 861: # why do we not do this lookup here, instead of delaying it? 862: $returnvalue = $values[0]; 863: } elsif (scalar(@matches) > 0) { 864: # more than one match. Look for a concise one 865: $returnvalue = "'non-unique parameter name : $expression'"; 866: for (my $i=0; $i<=$#matches;$i++) { 867: if ($matches[$i] =~ /^$expression$/) { 868: # why do we not do this lookup here? 869: $returnvalue = $values[$i]; 870: } 871: } 872: } else { 873: # There was a negative number of matches, which indicates 874: # something is wrong with reality. Better warn the user. 875: $returnvalue = '"bizzare parameter: '.$expression.'"'; 876: } 877: return $returnvalue; 878: } 879: } 880: 881: sub sett { 882: my $self = shift; 883: my %t=(); 884: # 885: # Deal with the template row 886: foreach my $col ($self->template_cells()) { 887: next if ($col=~/^[A-Z]/); 888: foreach my $row ($self->rows()) { 889: # Get the name of this cell 890: my $cell=$col.$row; 891: # Grab the template declaration 892: $t{$cell}=$self->formula('template_'.$col); 893: # Replace '#' with the row number 894: $t{$cell}=~s/\#/$row/g; 895: # Replace '....' with ',' 896: $t{$cell}=~s/\.\.+/\,/g; 897: # Replace 'A0' with the value from 'A0' 898: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 899: # Replace parameters 900: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 901: } 902: } 903: # 904: # Deal with the normal cells 905: while (my($cell,$formula) = each(%{$self->{'formulas'}})) { 906: next if ($_=~/^template\_/); 907: my ($col,$row) = ($cell =~ /^([A-z])(\d+)$/); 908: if ($row eq '0') { 909: $t{$cell}=$formula; 910: $t{$cell}=~s/\.\.+/\,/g; 911: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 912: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 913: } elsif ( $col =~ /^[A-Z]$/ ) { 914: if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) { 915: my $data = $self->{'constants'}->{$cell}; 916: $t{$cell} = $data; 917: } 918: } else { # $row > 1 and $col =~ /[a-z] 919: $t{$cell}=$formula; 920: $t{$cell}=~s/\.\.+/\,/g; 921: $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; 922: $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; 923: } 924: } 925: %{$self->{'safe'}->varglob('t')}=%t; 926: } 927: 928: ## 929: ## sync_safe_space: Called by calcsheet to make sure all the data we 930: # need to calculate is placed into the safe space 931: ## 932: sub sync_safe_space { 933: my $self = shift; 934: # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'. 935: %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}}; 936: # 'constants' leads a peaceful hidden life of 'c'. 937: %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}}; 938: # 'othersheets' hides as 'os', a disguise few can penetrate. 939: @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}}; 940: } 941: 942: ## 943: ## Retrieve the error log from the safe space (used for debugging) 944: ## 945: sub get_errorlog { 946: my $self = shift; 947: $self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') }; 948: return $self->{'errorlog'}; 949: } 950: 951: ## 952: ## Clear the error log inside the safe space 953: ## 954: sub clear_errorlog { 955: my $self = shift; 956: $ {$self->{'safe'}->varglob('errorlog')} = ''; 957: $self->{'errorlog'} = ''; 958: } 959: 960: ## 961: ## constants: either set or get the constants 962: ## 963: sub constants { 964: my $self=shift; 965: my ($constants) = @_; 966: if (defined($constants)) { 967: if (! ref($constants)) { 968: my %tmp = @_; 969: $constants = \%tmp; 970: } 971: $self->{'constants'} = $constants; 972: return; 973: } else { 974: return %{$self->{'constants'}}; 975: } 976: } 977: 978: ## 979: ## formulas: either set or get the formulas 980: ## 981: sub formulas { 982: my $self=shift; 983: my ($formulas) = @_; 984: if (defined($formulas)) { 985: if (! ref($formulas)) { 986: my %tmp = @_; 987: $formulas = \%tmp; 988: } 989: $self->{'formulas'} = $formulas; 990: $self->{'rows'} = []; 991: $self->{'template_cells'} = []; 992: return; 993: } else { 994: return %{$self->{'formulas'}}; 995: } 996: } 997: 998: sub set_formula { 999: my $self = shift; 1000: my ($cell,$formula) = @_; 1001: $self->{'formulas'}->{$cell}=$formula; 1002: return; 1003: } 1004: 1005: ## 1006: ## formulas_keys: Return the keys to the formulas hash. 1007: ## 1008: sub formulas_keys { 1009: my $self = shift; 1010: my @keys = keys(%{$self->{'formulas'}}); 1011: return keys(%{$self->{'formulas'}}); 1012: } 1013: 1014: ## 1015: ## formula: Return the formula for a given cell in the spreadsheet 1016: ## returns '' if the cell does not have a formula or does not exist 1017: ## 1018: sub formula { 1019: my $self = shift; 1020: my $cell = shift; 1021: if (defined($cell) && exists($self->{'formulas'}->{$cell})) { 1022: return $self->{'formulas'}->{$cell}; 1023: } 1024: return ''; 1025: } 1026: 1027: ## 1028: ## logthis: write the input to lonnet.log 1029: ## 1030: sub logthis { 1031: my $self = shift; 1032: my $message = shift; 1033: &Apache::lonnet::logthis($self->{'type'}.':'. 1034: $self->{'name'}.':'.$self->{'domain'}.':'. 1035: $message); 1036: return; 1037: } 1038: 1039: ## 1040: ## dump_formulas_to_log: makes lonnet.log huge... 1041: ## 1042: sub dump_formulas_to_log { 1043: my $self =shift; 1044: $self->logthis("Spreadsheet formulas"); 1045: $self->logthis("--------------------------------------------------------"); 1046: while (my ($cell, $formula) = each(%{$self->{'formulas'}})) { 1047: $self->logthis(' '.$cell.' = '.$formula); 1048: } 1049: $self->logthis("--------------------------------------------------------");} 1050: 1051: ## 1052: ## value: returns the computed value of a particular cell 1053: ## 1054: sub value { 1055: my $self = shift; 1056: my $cell = shift; 1057: if (defined($cell) && exists($self->{'values'}->{$cell})) { 1058: return $self->{'values'}->{$cell}; 1059: } 1060: return ''; 1061: } 1062: 1063: ## 1064: ## dump_values_to_log: makes lonnet.log huge... 1065: ## 1066: sub dump_values_to_log { 1067: my $self =shift; 1068: $self->logthis("Spreadsheet Values"); 1069: $self->logthis("------------------------------------------------------"); 1070: while (my ($cell, $value) = each(%{$self->{'values'}})) { 1071: $self->logthis(' '.$cell.' = '.$value); 1072: } 1073: $self->logthis("------------------------------------------------------"); 1074: } 1075: 1076: ## 1077: ## Yet another debugging function 1078: ## 1079: sub dump_hash_to_log { 1080: my $self= shift(); 1081: my %tmp = @_; 1082: if (@_<2) { 1083: %tmp = %{$_[0]}; 1084: } 1085: $self->logthis('---------------------------- (begin hash dump)'); 1086: while (my ($key,$val) = each (%tmp)) { 1087: $self->logthis(' '.$key.' = '.$val.':'); 1088: } 1089: $self->logthis('---------------------------- (finished hash dump)'); 1090: } 1091: 1092: ## 1093: ## rebuild_stats: rebuilds the rows and template_cells arrays 1094: ## 1095: sub rebuild_stats { 1096: my $self = shift; 1097: $self->{'rows'}=[]; 1098: $self->{'template_cells'}=[]; 1099: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 1100: push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0); 1101: push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/); 1102: } 1103: return; 1104: } 1105: 1106: ## 1107: ## template_cells returns a list of the cells defined in the template row 1108: ## 1109: sub template_cells { 1110: my $self = shift; 1111: $self->rebuild_stats() if (! defined($self->{'template_cells'}) || 1112: ! @{$self->{'template_cells'}}); 1113: return @{$self->{'template_cells'}}; 1114: } 1115: 1116: ## 1117: ## Sigh.... 1118: ## 1119: sub setothersheets { 1120: my $self = shift; 1121: my @othersheets = @_; 1122: $self->{'othersheets'} = \@othersheets; 1123: } 1124: 1125: ## 1126: ## rows returns a list of the names of cells defined in the A column 1127: ## 1128: sub rows { 1129: my $self = shift; 1130: $self->rebuild_stats() if (!@{$self->{'rows'}}); 1131: return @{$self->{'rows'}}; 1132: } 1133: 1134: # 1135: # calcsheet: makes all the calls to compute the spreadsheet. 1136: # 1137: sub calcsheet { 1138: my $self = shift; 1139: $self->sync_safe_space(); 1140: $self->clear_errorlog(); 1141: $self->sett(); 1142: my $result = $self->{'safe'}->reval('&calc();'); 1143: # $self->logthis($self->get_errorlog()); 1144: %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')}; 1145: # $self->logthis($self->get_errorlog()); 1146: if ($result ne 'okay') { 1147: $self->set_calcerror($result); 1148: } 1149: return $result; 1150: } 1151: 1152: sub set_badcalc { 1153: my $self = shift(); 1154: $self->{'badcalc'} =1; 1155: return; 1156: } 1157: 1158: sub badcalc { 1159: my $self = shift; 1160: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { 1161: return 1; 1162: } else { 1163: return 0; 1164: } 1165: } 1166: 1167: sub set_calcerror { 1168: my $self = shift; 1169: if (@_) { 1170: $self->set_badcalc(); 1171: if (exists($self->{'calcerror'})) { 1172: $self->{'calcerror'}.="\n".$_[0]; 1173: } else { 1174: $self->{'calcerror'}.=$_[0]; 1175: } 1176: } 1177: } 1178: 1179: sub calcerror { 1180: my $self = shift; 1181: if ($self->badcalc()) { 1182: if (exists($self->{'calcerror'})) { 1183: return $self->{'calcerror'}; 1184: } 1185: } 1186: return; 1187: } 1188: 1189: ########################################################### 1190: ## 1191: ## Output Helpers 1192: ## 1193: ########################################################### 1194: sub display { 1195: my $self = shift; 1196: my ($r) = @_; 1197: my $outputmode = 'html'; 1198: foreach ($self->output_options()) { 1199: if ($ENV{'form.output_format'} eq $_->{'value'}) { 1200: $outputmode = $_->{'value'}; 1201: last; 1202: } 1203: } 1204: if ($outputmode eq 'html') { 1205: $self->compute($r); 1206: $self->outsheet_html($r); 1207: } elsif ($outputmode eq 'htmlclasslist') { 1208: # No computation neccessary... This is kludgy 1209: $self->outsheet_htmlclasslist($r); 1210: } elsif ($outputmode eq 'excel') { 1211: $self->compute($r); 1212: $self->outsheet_excel($r); 1213: } elsif ($outputmode eq 'csv') { 1214: $self->compute($r); 1215: $self->outsheet_csv($r); 1216: } elsif ($outputmode eq 'xml') { 1217: # $self->compute($r); 1218: $self->outsheet_xml($r); 1219: } 1220: $self->cleanup(); 1221: return; 1222: } 1223: 1224: ############################################ 1225: ## HTML output routines ## 1226: ############################################ 1227: sub html_report_error { 1228: my $self = shift(); 1229: my $Str = ''; 1230: if ($self->badcalc()) { 1231: $Str = '<h3 style="color:red">'. 1232: &mt('An error occurred while calculating this spreadsheet'). 1233: "</h3>\n". 1234: '<pre>'.$self->calcerror()."</pre>\n"; 1235: } 1236: return $Str; 1237: } 1238: 1239: sub html_export_row { 1240: my $self = shift(); 1241: my ($color) = @_; 1242: $color = '#CCCCFF' if (! defined($color)); 1243: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1244: my $row_html; 1245: my @rowdata = $self->get_row(0); 1246: foreach my $cell (@rowdata) { 1247: if ($cell->{'name'} =~ /^[A-Z]/) { 1248: $row_html .= '<td bgcolor="'.$color.'">'. 1249: &html_editable_cell($cell,$color,$allowed).'</td>'; 1250: } else { 1251: $row_html .= '<td bgcolor="#DDCCFF">'. 1252: &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>'; 1253: } 1254: } 1255: return $row_html; 1256: } 1257: 1258: sub html_template_row { 1259: my $self = shift(); 1260: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1261: my ($num_uneditable,$importcolor) = @_; 1262: my $row_html; 1263: my @rowdata = $self->get_template_row(); 1264: my $count = 0; 1265: for (my $i = 0; $i<=$#rowdata; $i++) { 1266: my $cell = $rowdata[$i]; 1267: if ($i < $num_uneditable) { 1268: $row_html .= '<td bgcolor="'.$importcolor.'">'. 1269: &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>'; 1270: } else { 1271: $row_html .= '<td bgcolor="#EOFFDD">'. 1272: &html_editable_cell($cell,'#EOFFDD',$allowed).'</td>'; 1273: } 1274: } 1275: return $row_html; 1276: } 1277: 1278: sub html_editable_cell { 1279: my ($cell,$bgcolor,$allowed) = @_; 1280: my $result; 1281: my ($name,$formula,$value); 1282: if (defined($cell)) { 1283: $name = $cell->{'name'}; 1284: $formula = $cell->{'formula'}; 1285: $value = $cell->{'value'}; 1286: } 1287: $name = '' if (! defined($name)); 1288: $formula = '' if (! defined($formula)); 1289: if (! defined($value)) { 1290: $value = '<font color="'.$bgcolor.'">#</font>'; 1291: if ($formula ne '') { 1292: $value = '<i>undefined value</i>'; 1293: } 1294: } elsif ($value =~ /^\s*$/ ) { 1295: $value = '<font color="'.$bgcolor.'">#</font>'; 1296: } else { 1297: $value = &HTML::Entities::encode($value) if ($value !~/ /); 1298: } 1299: return $value if (! $allowed); 1300: # 1301: # The formula will be parsed by the browser twice before being 1302: # displayed to the user for editing. 1303: # 1304: # The encoding string "^A-blah" is placed in []'s inside a regexp, so 1305: # we specify the characters we want left alone by putting a '^' in front. 1306: $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~'); 1307: # HTML::Entities::encode does not catch everything - we need '\' encoded 1308: $formula =~ s/\\/&\#092/g; 1309: # Escape it again - this time the only encodable character is '&' 1310: $formula =~ s/\&/\&/g; 1311: # Glue everything together 1312: $result .= "<a href=\"javascript:celledit(\'". 1313: $name."','".$formula."');\">".$value."</a>"; 1314: return $result; 1315: } 1316: 1317: sub html_uneditable_cell { 1318: my ($cell,$bgcolor) = @_; 1319: my $value = (defined($cell) ? $cell->{'value'} : ''); 1320: $value = &HTML::Entities::encode($value) if ($value !~/ /); 1321: return ' '.$value.' '; 1322: } 1323: 1324: sub html_row { 1325: my $self = shift(); 1326: my ($num_uneditable,$row,$exportcolor,$importcolor) = @_; 1327: my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}); 1328: my @rowdata = $self->get_row($row); 1329: my $num_cols_output = 0; 1330: my $row_html; 1331: my $color = $importcolor; 1332: if ($row == 0) { 1333: $color = $exportcolor; 1334: } 1335: $color = '#FFDDDD' if (! defined($color)); 1336: foreach my $cell (@rowdata) { 1337: if ($num_cols_output++ < $num_uneditable) { 1338: $row_html .= '<td bgcolor="'.$color.'">'; 1339: $row_html .= &html_uneditable_cell($cell,'#FFDDDD'); 1340: } else { 1341: $row_html .= '<td bgcolor="#EOFFDD">'; 1342: $row_html .= &html_editable_cell($cell,'#E0FFDD',$allowed); 1343: } 1344: $row_html .= '</td>'; 1345: } 1346: return $row_html; 1347: } 1348: 1349: sub html_header { 1350: my $self = shift; 1351: return '' if (! $ENV{'request.role.adv'}); 1352: return "<table>\n". 1353: '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n". 1354: '<tr><td>'.$self->output_selector()."</td></tr>\n". 1355: "</table>\n"; 1356: } 1357: 1358: ## 1359: ## Default output types are HTML, Excel, and CSV 1360: sub output_options { 1361: my $self = shift(); 1362: return ({value => 'html', 1363: description => 'HTML'}, 1364: {value => 'excel', 1365: description => 'Excel'}, 1366: # {value => 'xml', 1367: # description => 'XML'}, 1368: {value => 'csv', 1369: description => 'Comma Separated Values'},); 1370: } 1371: 1372: sub output_selector { 1373: my $self = shift(); 1374: my $output_selector = '<select name="output_format" size="3">'."\n"; 1375: my $default = 'html'; 1376: if (exists($ENV{'form.output_format'})) { 1377: $default = $ENV{'form.output_format'} 1378: } else { 1379: $ENV{'form.output_format'} = $default; 1380: } 1381: foreach ($self->output_options()) { 1382: $output_selector.='<option value="'.$_->{'value'}.'"'; 1383: if ($_->{'value'} eq $default) { 1384: $output_selector .= ' selected'; 1385: } 1386: $output_selector .= ">".&mt($_->{'description'})."</option>\n"; 1387: } 1388: $output_selector .= "</select>\n"; 1389: return $output_selector; 1390: } 1391: 1392: ################################################ 1393: ## Excel output routines ## 1394: ################################################ 1395: sub excel_output_row { 1396: my $self = shift; 1397: my ($worksheet,$rownum,$rows_output,@prepend) = @_; 1398: my $cols_output = 0; 1399: # 1400: my @rowdata = $self->get_row($rownum); 1401: foreach my $cell (@prepend,@rowdata) { 1402: my $value = $cell; 1403: $value = $cell->{'value'} if (ref($value)); 1404: $value =~ s/\ / /gi; 1405: $worksheet->write($rows_output,$cols_output++,$value); 1406: } 1407: return; 1408: } 1409: 1410: sub create_excel_spreadsheet { 1411: my $self = shift; 1412: my ($r) = @_; 1413: my $filename = '/prtspool/'. 1414: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 1415: time.'_'.rand(1000000000).'.xls'; 1416: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); 1417: if (! defined($workbook)) { 1418: $r->log_error("Error creating excel spreadsheet $filename: $!"); 1419: $r->print(&mt("Problems creating new Excel file. ". 1420: "This error has been logged. ". 1421: "Please alert your LON-CAPA administrator")); 1422: return undef; 1423: } 1424: # 1425: # The excel spreadsheet stores temporary data in files, then put them 1426: # together. If needed we should be able to disable this (memory only). 1427: # The temporary directory must be specified before calling 'addworksheet'. 1428: # File::Temp is used to determine the temporary directory. 1429: $workbook->set_tempdir('/home/httpd/perl/tmp'); 1430: # 1431: # Determine the name to give the worksheet 1432: return ($workbook,$filename); 1433: } 1434: 1435: # 1436: # This routine is just a stub 1437: sub outsheet_htmlclasslist { 1438: my $self = shift; 1439: my ($r) = @_; 1440: $r->print('<h2>'.&mt("This output is not supported").'</h2>'); 1441: $r->rflush(); 1442: return; 1443: } 1444: 1445: sub outsheet_excel { 1446: my $self = shift; 1447: my ($r) = @_; 1448: my $connection = $r->connection(); 1449: # 1450: $r->print($self->html_report_error()); 1451: $r->rflush(); 1452: # 1453: $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>"); 1454: # 1455: # Create excel worksheet 1456: my ($workbook,$filename) = $self->create_excel_spreadsheet($r); 1457: return if (! defined($workbook)); 1458: # 1459: # Create main worksheet 1460: my $worksheet = $workbook->addworksheet('main'); 1461: my $rows_output = 0; 1462: my $cols_output = 0; 1463: # 1464: # Write excel header 1465: foreach my $value ($self->get_title()) { 1466: $cols_output = 0; 1467: $worksheet->write($rows_output++,$cols_output,$value); 1468: } 1469: $rows_output++; # skip a line 1470: # 1471: # Write summary/export row 1472: $cols_output = 0; 1473: $self->excel_output_row($worksheet,0,$rows_output++,'Summary'); 1474: $rows_output++; # skip a line 1475: # 1476: $self->excel_rows($connection,$worksheet,$cols_output,$rows_output); 1477: # 1478: # 1479: # Close the excel file 1480: $workbook->close(); 1481: # 1482: # Write a link to allow them to download it 1483: $r->print('<br />'. 1484: '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n"); 1485: return; 1486: } 1487: 1488: ################################# 1489: ## CSV output routines ## 1490: ################################# 1491: sub outsheet_csv { 1492: my $self = shift; 1493: my ($r) = @_; 1494: my $connection = $r->connection(); 1495: # 1496: $r->print($self->html_report_error()); 1497: $r->rflush(); 1498: # 1499: my $csvdata = ''; 1500: my @Values; 1501: # 1502: # Open the csv file 1503: my $filename = '/prtspool/'. 1504: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. 1505: time.'_'.rand(1000000000).'.csv'; 1506: my $file; 1507: unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) { 1508: $r->log_error("Couldn't open $filename for output $!"); 1509: $r->print(&mt("Problems occured in writing the csv file. ". 1510: "This error has been logged. ". 1511: "Please alert your LON-CAPA administrator.")); 1512: $r->print("<pre>\n".$csvdata."</pre>\n"); 1513: return 0; 1514: } 1515: # 1516: # Output the title information 1517: foreach my $value ($self->get_title()) { 1518: print $file "'".&Apache::loncommon::csv_translate($value)."'\n"; 1519: } 1520: # 1521: # Output the body of the spreadsheet 1522: $self->csv_rows($connection,$file); 1523: # 1524: # Close the csv file 1525: close($file); 1526: $r->print('<br /><br />'. 1527: '<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n"); 1528: # 1529: return 1; 1530: } 1531: 1532: sub csv_output_row { 1533: my $self = shift; 1534: my ($filehandle,$rownum,@prepend) = @_; 1535: # 1536: my @rowdata = (); 1537: if (defined($rownum)) { 1538: @rowdata = $self->get_row($rownum); 1539: } 1540: my @output = (); 1541: foreach my $cell (@prepend,@rowdata) { 1542: my $value = $cell; 1543: $value = $cell->{'value'} if (ref($value)); 1544: $value =~ s/\ / /gi; 1545: $value = "'".$value."'"; 1546: push (@output,$value); 1547: } 1548: print $filehandle join(',',@output )."\n"; 1549: return; 1550: } 1551: 1552: ############################################ 1553: ## XML output routines ## 1554: ############################################ 1555: sub outsheet_xml { 1556: my $self = shift; 1557: my ($r) = @_; 1558: ## Someday XML 1559: ## Will be rendered for the user 1560: ## But not on this day 1561: my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n"; 1562: while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { 1563: if ($cell =~ /^template_(\w+)/) { 1564: my $col = $1; 1565: $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n"; 1566: } else { 1567: my ($col,$row) = ($cell =~ /^([A-z])(\d+)/); 1568: next if (! defined($row) || ! defined($col)); 1569: next if ($row != 0); 1570: $Str .= 1571: '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>' 1572: ."\n"; 1573: } 1574: } 1575: $Str.="</spreadsheet>"; 1576: $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>"); 1577: return $Str; 1578: } 1579: 1580: ############################################ 1581: ### Filesystem routines ### 1582: ############################################ 1583: sub parse_sheet { 1584: # $sheetxml is a scalar reference or a scalar 1585: my ($sheetxml) = @_; 1586: if (! ref($sheetxml)) { 1587: my $tmp = $sheetxml; 1588: $sheetxml = \$tmp; 1589: } 1590: my %formulas; 1591: my %sources; 1592: my $parser=HTML::TokeParser->new($sheetxml); 1593: my $token; 1594: while ($token=$parser->get_token) { 1595: if ($token->[0] eq 'S') { 1596: if ($token->[1] eq 'field') { 1597: my $cell = $token->[2]->{'col'}.$token->[2]->{'row'}; 1598: my $source = $token->[2]->{'source'}; 1599: my $formula = $parser->get_text('/field'); 1600: $formulas{$cell} = $formula; 1601: $sources{$cell} = $source if (defined($source)); 1602: $parser->get_text('/field'); 1603: } elsif ($token->[1] eq 'template') { 1604: $formulas{'template_'.$token->[2]->{'col'}}= 1605: $parser->get_text('/template'); 1606: } 1607: } 1608: } 1609: return (\%formulas,\%sources); 1610: } 1611: 1612: { 1613: 1614: my %spreadsheets; 1615: 1616: sub clear_spreadsheet_definition_cache { 1617: undef(%spreadsheets); 1618: } 1619: 1620: sub load_system_default_sheet { 1621: my $self = shift; 1622: my $includedir = $Apache::lonnet::perlvar{'lonIncludes'}; 1623: # load in the default defined spreadsheet 1624: my $sheetxml=''; 1625: my $fh; 1626: if ($fh=Apache::File->new($includedir.'/default_'.$self->{'type'})) { 1627: $sheetxml=join('',<$fh>); 1628: $fh->close(); 1629: } else { 1630: # $sheetxml='<field row="0" col="A">"Error"</field>'; 1631: $sheetxml='<field row="0" col="A"></field>'; 1632: } 1633: $self->filename('default_'); 1634: my ($formulas,undef) = &parse_sheet(\$sheetxml); 1635: return $formulas; 1636: } 1637: 1638: sub load { 1639: my $self = shift; 1640: # 1641: my $stype = $self->{'type'}; 1642: my $cnum = $self->{'cnum'}; 1643: my $cdom = $self->{'cdom'}; 1644: my $chome = $self->{'chome'}; 1645: # 1646: my $filename = $self->filename(); 1647: my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); 1648: # 1649: # see if sheet is cached 1650: my ($formulas); 1651: if (exists($spreadsheets{$cachekey})) { 1652: $formulas = $spreadsheets{$cachekey}->{'formulas'}; 1653: } else { 1654: # Not cached, need to read 1655: if (! defined($filename)) { 1656: $formulas = $self->load_system_default_sheet(); 1657: } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) { 1658: # Load a spreadsheet definition file 1659: my $sheetxml=&Apache::lonnet::getfile 1660: (&Apache::lonnet::filelocation('',$filename)); 1661: if ($sheetxml == -1) { 1662: $sheetxml='<field row="0" col="A">"Error loading spreadsheet ' 1663: .$self->filename().'"</field>'; 1664: } 1665: ($formulas,undef) = &parse_sheet(\$sheetxml); 1666: # Get just the filename and set the sheets filename 1667: my ($newfilename) = ($filename =~ /\/([^\/]*)\.spreadsheet$/); 1668: if ($self->is_default()) { 1669: $self->filename($newfilename); 1670: $self->make_default(); 1671: } else { 1672: $self->filename($newfilename); 1673: } 1674: } else { 1675: # Load the spreadsheet definition file from the save file 1676: my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum); 1677: my ($tmp) = keys(%tmphash); 1678: if ($tmp !~ /^(con_lost|error|no_such_host)/i) { 1679: while (my ($cell,$formula) = each(%tmphash)) { 1680: $formulas->{$cell}=$formula; 1681: } 1682: } else { 1683: $formulas = $self->load_system_default_sheet(); 1684: } 1685: } 1686: $filename=$self->filename(); # filename may have changed 1687: $cachekey = join('_',($cnum,$cdom,$stype,$filename)); 1688: %{$spreadsheets{$cachekey}->{'formulas'}} = %{$formulas}; 1689: } 1690: $self->formulas($formulas); 1691: $self->set_row_sources(); 1692: $self->set_row_numbers(); 1693: } 1694: 1695: sub set_row_sources { 1696: my $self = shift; 1697: while (my ($cell,$value) = each(%{$self->{'formulas'}})) { 1698: next if ($cell !~ /^A(\d+)/ || $1 < 1); 1699: my $row = $1; 1700: $self->{'row_source'}->{$row} = $value; 1701: } 1702: return; 1703: } 1704: 1705: sub set_row_numbers { 1706: my $self = shift; 1707: while (my ($cell,$value) = each(%{$self->{'formulas'}})) { 1708: next if ($cell !~ /^A(\d+)$/); 1709: next if (! defined($value)); 1710: $self->{'row_numbers'}->{$value} = $1; 1711: $self->{'maxrow'} = $1 if ($1 > $self->{'maxrow'}); 1712: } 1713: } 1714: 1715: ## 1716: ## exportrow is *not* used to get the export row from a computed sub-sheet. 1717: ## 1718: sub exportrow { 1719: my $self = shift; 1720: if (exists($self->{'badcalc'}) && $self->{'badcalc'}) { 1721: return (); 1722: } 1723: my @exportarray; 1724: foreach my $column (@UC_Columns) { 1725: push(@exportarray,$self->value($column.'0')); 1726: } 1727: return @exportarray; 1728: } 1729: 1730: sub save { 1731: my $self = shift; 1732: my ($makedef)=@_; 1733: my $cid=$self->{'cid'}; 1734: # If we are saving it, it must not be temporary 1735: $self->temporary(0); 1736: if (&Apache::lonnet::allowed('opa',$cid)) { 1737: my %f=$self->formulas(); 1738: my $stype = $self->{'type'}; 1739: my $cnum = $self->{'cnum'}; 1740: my $cdom = $self->{'cdom'}; 1741: my $chome = $self->{'chome'}; 1742: my $filename = $self->{'filename'}; 1743: my $cachekey = join('_',($cnum,$cdom,$stype,$filename)); 1744: # Cache new sheet 1745: %{$spreadsheets{$cachekey}->{'formulas'}}=%f; 1746: # Write sheet 1747: foreach (keys(%f)) { 1748: delete($f{$_}) if ($f{$_} eq 'import'); 1749: } 1750: my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum); 1751: return $reply if ($reply ne 'ok'); 1752: $reply = &Apache::lonnet::put($stype.'_spreadsheets', 1753: {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}}, 1754: $cdom,$cnum); 1755: return $reply if ($reply ne 'ok'); 1756: if ($makedef) { 1757: $reply = &Apache::lonnet::put('environment', 1758: {'spreadsheet_default_'.$stype => $filename }, 1759: $cdom,$cnum); 1760: return $reply if ($reply ne 'ok'); 1761: } 1762: if ($self->is_default()) { 1763: if ($self->{'type'} eq 'studentcalc') { 1764: &Apache::lonnet::expirespread('','','studentcalc',''); 1765: } elsif ($self->{'type'} eq 'assesscalc') { 1766: &Apache::lonnet::expirespread('','','assesscalc',''); 1767: &Apache::lonnet::expirespread('','','studentcalc',''); 1768: } 1769: } 1770: return $reply; 1771: } 1772: return 'unauthorized'; 1773: } 1774: 1775: } # end of scope for %spreadsheets 1776: 1777: sub save_tmp { 1778: my $self = shift; 1779: my $filename=$ENV{'user.name'}.'_'. 1780: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. 1781: $self->{'filename'}; 1782: $filename=~s/\W/\_/g; 1783: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; 1784: $self->temporary(1); 1785: my $fh; 1786: if ($fh=Apache::File->new('>'.$filename)) { 1787: my %f = $self->formulas(); 1788: while( my ($cell,$formula) = each(%f)) { 1789: next if ($formula eq 'import'); 1790: print $fh &Apache::lonnet::escape($cell)."=". 1791: &Apache::lonnet::escape($formula)."\n"; 1792: } 1793: $fh->close(); 1794: } 1795: } 1796: 1797: sub load_tmp { 1798: my $self = shift; 1799: my $filename=$ENV{'user.name'}.'_'. 1800: $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'. 1801: $self->{'filename'}; 1802: $filename=~s/\W/\_/g; 1803: $filename=$Apache::lonnet::tmpdir.$filename.'.tmp'; 1804: my %formulas = (); 1805: if (my $spreadsheet_file = Apache::File->new($filename)) { 1806: while (<$spreadsheet_file>) { 1807: chomp; 1808: my ($cell,$formula) = split(/=/); 1809: $cell = &Apache::lonnet::unescape($cell); 1810: $formula = &Apache::lonnet::unescape($formula); 1811: $formulas{$cell} = $formula; 1812: } 1813: $spreadsheet_file->close(); 1814: } 1815: # flag the sheet as temporary 1816: $self->temporary(1); 1817: $self->formulas(\%formulas); 1818: $self->set_row_sources(); 1819: $self->set_row_numbers(); 1820: return; 1821: } 1822: 1823: sub temporary { 1824: my $self=shift; 1825: if (@_) { 1826: ($self->{'temporary'})= @_; 1827: } 1828: return $self->{'temporary'}; 1829: } 1830: 1831: sub modify_cell { 1832: # studentcalc overrides this 1833: my $self = shift; 1834: my ($cell,$formula) = @_; 1835: if ($cell =~ /([A-z])\-/) { 1836: $cell = 'template_'.$1; 1837: } elsif ($cell !~ /^([A-z](\d+)|template_[A-z])$/) { 1838: return; 1839: } 1840: $self->set_formula($cell,$formula); 1841: $self->rebuild_stats(); 1842: return; 1843: } 1844: 1845: ########################################### 1846: # othersheets: Returns the list of other spreadsheets available 1847: ########################################### 1848: sub othersheets { 1849: my $self = shift(); 1850: my ($stype) = @_; 1851: $stype = $self->{'type'} if (! defined($stype) || $stype !~ /calc$/); 1852: # 1853: my @alternatives=(); 1854: my %results=&Apache::lonnet::dump($stype.'_spreadsheets', 1855: $self->{'cdom'}, $self->{'cnum'}); 1856: my ($tmp) = keys(%results); 1857: if ($tmp =~ /^(con_lost|error|no_such_host)/i ) { 1858: @alternatives = (&mt('Default')); 1859: } else { 1860: @alternatives = (&mt('Default'), sort (keys(%results))); 1861: } 1862: return @alternatives; 1863: } 1864: 1865: sub blackout { 1866: my $self = shift; 1867: $self->{'blackout'} = $_[0] if (@_); 1868: return $self->{'blackout'}; 1869: } 1870: 1871: sub get_row { 1872: my $self = shift; 1873: my ($n)=@_; 1874: my @cols=(); 1875: foreach my $col (@UC_Columns,@LC_Columns) { 1876: my $cell = $col.$n; 1877: push(@cols,{ name => $cell, 1878: formula => $self->formula($cell), 1879: value => $self->value($cell)}); 1880: } 1881: return @cols; 1882: } 1883: 1884: sub get_template_row { 1885: my $self = shift; 1886: my @cols=(); 1887: foreach my $col (@UC_Columns,@LC_Columns) { 1888: my $cell = 'template_'.$col; 1889: push(@cols,{ name => $cell, 1890: formula => $self->formula($cell), 1891: value => $self->formula($cell) }); 1892: } 1893: return @cols; 1894: } 1895: 1896: sub need_to_save { 1897: my $self = shift; 1898: if ($self->{'new_rows'} && ! $self->temporary()) { 1899: return 1; 1900: } 1901: return 0; 1902: } 1903: 1904: sub get_row_number_from_key { 1905: my $self = shift; 1906: my ($key) = @_; 1907: if (! exists($self->{'row_numbers'}->{$key}) || 1908: ! defined($self->{'row_numbers'}->{$key})) { 1909: # I used to set $f here to the new value, but the key passed for lookup 1910: # may not be the key we need to save 1911: $self->{'maxrow'}++; 1912: $self->{'row_numbers'}->{$key} = $self->{'maxrow'}; 1913: # $self->logthis('added row '.$self->{'row_numbers'}->{$key}. 1914: # ' for '.$key); 1915: $self->{'new_rows'} = 1; 1916: } 1917: return $self->{'row_numbers'}->{$key}; 1918: } 1919: 1920: 1; 1921: 1922: __END__