Annotation of loncom/interface/spreadsheet/Spreadsheet.pm, revision 1.87

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>