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

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

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