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