[BACK]Return to Spreadsheet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface / spreadsheet

Diff for /loncom/interface/spreadsheet/Spreadsheet.pm between versions 1.21.2.1 and 1.26

version 1.21.2.1, 2003/12/05 22:24:20 version 1.26, 2003/09/15 20:31:01
Line 48  Spreadsheet Line 48  Spreadsheet
 package Apache::Spreadsheet;  package Apache::Spreadsheet;
   
 use strict;  use strict;
   #use warnings FATAL=>'all';
   #no warnings 'uninitialized';
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet;  use Apache::lonnet;
 use Safe;  use Safe;
Line 90  sub new { Line 92  sub new {
         type     => $stype,          type     => $stype,
         symb     => $usymb,          symb     => $usymb,
         errorlog => '',          errorlog => '',
         maxrow   => '',          maxrow   => 0,
         cid      => $ENV{'request.course.id'},          cid      => $ENV{'request.course.id'},
         cnum     => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},          cnum     => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
         cdom     => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},          cdom     => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
Line 229  sub initialize { Line 231  sub initialize {
     # the descendents of the spreadsheet class.      # the descendents of the spreadsheet class.
 }  }
   
   sub clear_package {
       # This method is here to remind you that it will be overridden by
       # the descendents of the spreadsheet class.
   }
   
   sub cleanup {
       my $self = shift();
       $self->clear_package();
   }
   
 sub initialize_spreadsheet_package {  sub initialize_spreadsheet_package {
     &load_spreadsheet_expirationdates();      &load_spreadsheet_expirationdates();
     &clear_spreadsheet_definition_cache();      &clear_spreadsheet_definition_cache();
Line 248  sub load_spreadsheet_expirationdates { Line 260  sub load_spreadsheet_expirationdates {
 sub check_expiration_time {  sub check_expiration_time {
     my $self = shift;      my $self = shift;
     my ($time)=@_;      my ($time)=@_;
       return 0 if (! defined($time));
     my ($key1,$key2,$key3,$key4,$key5);      my ($key1,$key2,$key3,$key4,$key5);
     # Description of keys      # Description of keys
     #      #
Line 286  Returns the safe space required by a Spr Line 299  Returns the safe space required by a Spr
 =cut  =cut
   
 ######################################################  ######################################################
   { 
   
       my $safeeval;
   
 sub initialize_safe_space {  sub initialize_safe_space {
     my $self = shift;    my $self = shift;
     my $safeeval = new Safe(shift);    if (! defined($safeeval)) {
     my $safehole = new Safe::Hole;        $safeeval = new Safe(shift);
     $safeeval->permit("entereval");        my $safehole = new Safe::Hole;
     $safeeval->permit(":base_math");        $safeeval->permit("entereval");
     $safeeval->permit("sort");        $safeeval->permit(":base_math");
     $safeeval->deny(":base_io");        $safeeval->permit("sort");
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');        $safeeval->deny(":base_io");
     $safehole->wrap(\&mask,$safeeval,'&mask');        $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
     $safeeval->share('$@');        $safehole->wrap(\&mask,$safeeval,'&mask');
     my $code=<<'ENDDEFS';        $safeeval->share('$@');
         my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
 #  #
 # f: formulas  # f: formulas
Line 362  returns the number of items in the range Line 380  returns the number of items in the range
 #-------------------------------------------------------  #-------------------------------------------------------
 sub NUM {  sub NUM {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;      my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;
     return $num;         return $num;   
 }  }
   
Line 379  sub BIN { Line 397  sub BIN {
     my ($low,$high,$lower,$upper)=@_;      my ($low,$high,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $mask=&mask($lower,$upper);
     my $num=0;      my $num=0;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {          if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
             $num++;              $num++;
         }          }
Line 401  returns the sum of items in the range. Line 419  returns the sum of items in the range.
 sub SUM {  sub SUM {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $sum=0;      my $sum=0;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         $sum+=$sheet_values{$_};          $sum+=$sheet_values{$_};
     }      }
     return $sum;         return $sum;   
Line 422  sub MEAN { Line 440  sub MEAN {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $sum=0;       my $sum=0; 
     my $num=0;      my $num=0;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         $sum+=$sheet_values{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     }      }
Line 447  compute the standard deviation of the it Line 465  compute the standard deviation of the it
 sub STDDEV {  sub STDDEV {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         $sum+=$sheet_values{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     }      }
     unless ($num>1) { return undef; }      unless ($num>1) { return undef; }
     my $mean=$sum/$num;      my $mean=$sum/$num;
     $sum=0;      $sum=0;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         $sum+=($sheet_values{$_}-$mean)**2;          $sum+=($sheet_values{$_}-$mean)**2;
     }      }
     return sqrt($sum/($num-1));          return sqrt($sum/($num-1));    
Line 474  compute the product of the items in the Line 492  compute the product of the items in the
 sub PROD {  sub PROD {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $prod=1;      my $prod=1;
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         $prod*=$sheet_values{$_};          $prod*=$sheet_values{$_};
     }      }
     return $prod;         return $prod;   
Line 494  compute the maximum of the items in the Line 512  compute the maximum of the items in the
 sub MAX {  sub MAX {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $max='-';      my $max='-';
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         unless ($max) { $max=$sheet_values{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($sheet_values{$_}>$max) || ($max eq '-')) {           if (($sheet_values{$_}>$max) || ($max eq '-')) { 
             $max=$sheet_values{$_};               $max=$sheet_values{$_}; 
Line 517  compute the minimum of the items in the Line 535  compute the minimum of the items in the
 sub MIN {  sub MIN {
     my $mask=&mask(@_);      my $mask=&mask(@_);
     my $min='-';      my $min='-';
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
         unless ($max) { $max=$sheet_values{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($sheet_values{$_}<$min) || ($min eq '-')) {           if (($sheet_values{$_}<$min) || ($min eq '-')) { 
             $min=$sheet_values{$_};               $min=$sheet_values{$_}; 
Line 542  sub SUMMAX { Line 560  sub SUMMAX {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $mask=&mask($lower,$upper);
     my @inside=();      my @inside=();
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
  push (@inside,$sheet_values{$_});   push (@inside,$sheet_values{$_});
     }      }
     @inside=sort(@inside);      @inside=sort(@inside);
Line 569  sub SUMMIN { Line 587  sub SUMMIN {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $mask=&mask($lower,$upper);
     my @inside=();      my @inside=();
     foreach (grep /$mask/,keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
  $inside[$#inside+1]=$sheet_values{$_};   $inside[$#inside+1]=$sheet_values{$_};
     }      }
     @inside=sort(@inside);      @inside=sort(@inside);
Line 659  sub calc { Line 677  sub calc {
             return $lastcalc.': Maximum calculation depth exceeded';              return $lastcalc.': Maximum calculation depth exceeded';
         }          }
     }      }
     return 'okay';      return '';
 }  }
   
 # ------------------------------------------- End of "Inside of the safe space"  # ------------------------------------------- End of "Inside of the safe space"
 ENDDEFS  ENDDEFS
     $safeeval->reval($code);          $safeeval->reval($code);
       }
     $self->{'safe'} = $safeeval;      $self->{'safe'} = $safeeval;
     $self->{'root'} = $self->{'safe'}->root();      $self->{'root'} = $self->{'safe'}->root();
     #      #
Line 678  ENDDEFS Line 697  ENDDEFS
     $self->{'safe'}->reval($initstring);      $self->{'safe'}->reval($initstring);
     return $self;      return $self;
 }  }
   
   }
   
 ######################################################  ######################################################
   
 =pod  =pod
Line 691  ENDDEFS Line 713  ENDDEFS
   
 ######################################################  ######################################################
   
   =pod
   
   =item  &mask($lower,$upper)
   
   Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").
   
   Returns:  Regular expression matching spreadsheet cells that are within
   the rectangle defined by $lower and $upper.  Due to the nature of the
   regular expression this result must be used inside an eval().
   
   =cut
   
 ######################################################  ######################################################
 {  {
Line 705  sub mask { Line 738  sub mask {
     }      }
     $upper = $lower if (! defined($upper));      $upper = $lower if (! defined($upper));
     #      #
     my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/);      my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);
     my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/);      my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);
     #      #
     my $alpha='';      my $alpha='';
     my $num='';      my $num='';
     #      #
       # Do not put parenthases around $alpha.
       # $num depends on the value in $1.
     if (($la eq '*') || ($ua eq '*')) {      if (($la eq '*') || ($ua eq '*')) {
         $alpha='[A-Za-z]';          $alpha='[A-z]';
     } else {      } else {
        if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||          $alpha=qq/[$la-$ua]/;
            ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {      }
           $alpha='['.$la.'-'.$ua.']';      if ($ld ne '*' && $ud ne '*') {
        } else {          # Make sure $ld <= $ud
           $alpha='['.$la.'-Za-'.$ua.']';          if ($ld > $ud) {
        }              my $tmp = $ud;
     }                 $ud = $ld;
     if (($ld eq '*') || ($ud eq '*')) {              $ld = $tmp;
  $num='\d+';          }
           # Here we make a regular expression using some advanced regexp
           # abilities.
           # (\d+) will match the digits of the cell name and dump them in
           #     to $1
           # (?(?{ ... code ...} pattern_if_true | pattern_if_false)) will
           #     choose pattern_if_true if { ... code ... } is true and
           #     pattern_if_false if { ... code ... } is false.
           # In this case, pattern_if_true is empty.  pattern_if_false is 
           #     'donotmatch' and will not match our cells because none of 
           #     them end with donotmatch.  
           # Unfortunately, the use of this type of regular expression 
           #     requires that each match be wrapped in an eval().  Search for
           #     $mask in this module for examples
           $num = '(\d+)(?(?{$1>= '.$ld.' && $1<='.$ud.'})|donotmatch)';
     } else {      } else {
         if (length($ld)!=length($ud)) {          $num = '(\d+)';
            $num.='(';  
    foreach ($ld=~m/\d/g) {  
               $num.='['.$_.'-9]';  
    }  
            if (length($ud)-length($ld)>1) {  
               $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';  
    }  
            $num.='|';  
            foreach ($ud=~m/\d/g) {  
                $num.='[0-'.$_.']';  
            }  
            $num.=')';  
        } else {  
            my @lda=($ld=~m/\d/g);  
            my @uda=($ud=~m/\d/g);  
            my $i;   
            my $j=0;   
            my $notdone=1;  
            for ($i=0;($i<=$#lda)&&($notdone);$i++) {  
                if ($lda[$i]==$uda[$i]) {  
    $num.=$lda[$i];  
                    $j=$i;  
                } else {  
                    $notdone=0;  
                }  
            }  
            if ($j<$#lda-1) {  
        $num.='('.$lda[$j+1];  
                for ($i=$j+2;$i<=$#lda;$i++) {  
                    $num.='['.$lda[$i].'-9]';  
                }  
                if ($uda[$j+1]-$lda[$j+1]>1) {  
    $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.  
                    ($#lda-$j-1).'}';  
                }  
        $num.='|'.$uda[$j+1];  
                for ($i=$j+2;$i<=$#uda;$i++) {  
                    $num.='[0-'.$uda[$i].']';  
                }  
                $num.=')';  
            } else {  
                if ($lda[-1]!=$uda[-1]) {  
                   $num.='['.$lda[-1].'-'.$uda[-1].']';  
        }  
            }  
        }  
     }      }
     my $expression ='^'.$alpha.$num."\$";      my $expression = '^'.$alpha.$num.'$';
     $memoizer{$key} = $expression;      $memoizer{$key} = $expression;
     return $expression;      return $expression;
 }  }
   
   #
   # Debugging routine
   sub dump_memoized_values {
       while (my ($key,$value) = each(%memoizer)) {
           &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value);
       }
       return;
   }
   
 }  }
   
 ##  ##
Line 1121  sub calcsheet { Line 1133  sub calcsheet {
 #    $self->logthis($self->get_errorlog());  #    $self->logthis($self->get_errorlog());
     %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};      %{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
 #    $self->logthis($self->get_errorlog());  #    $self->logthis($self->get_errorlog());
     if ($result ne 'okay') {  
         $self->set_calcerror($result);  
     }  
     return $result;      return $result;
 }  }
   
   
 sub set_badcalc {  
     my $self = shift();  
     $self->{'badcalc'} =1;  
     return;  
 }  
   
 sub badcalc {  
     my $self = shift;  
     if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {  
         return 1;  
     } else {  
         return 0;  
     }  
 }  
   
 sub set_calcerror {  
     my $self = shift;  
     if (@_) {  
         $self->set_badcalc();  
         if (exists($self->{'calcerror'})) {  
             $self->{'calcerror'}.="\n".$_[0];  
         } else {  
             $self->{'calcerror'}.=$_[0];  
         }  
     }  
 }  
   
 sub calcerror {  
     my $self = shift;  
     if ($self->badcalc()) {  
         if (exists($self->{'calcerror'})) {  
             return $self->{'calcerror'};  
         }  
     }  
     return;  
 }  
   
   
 ###########################################################  ###########################################################
 ##  ##
 ## Output Helpers  ## Output Helpers
Line 1186  sub display { Line 1156  sub display {
     } elsif ($outputmode eq 'csv') {      } elsif ($outputmode eq 'csv') {
         $self->outsheet_csv($r);          $self->outsheet_csv($r);
     }      }
       $self->cleanup();
     return;      return;
 }  }
   
 ############################################  ############################################
 ##         HTML output routines           ##  ##         HTML output routines           ##
 ############################################  ############################################
 sub html_report_error {  
     my $self = shift();  
     my $Str = '';  
     if ($self->badcalc()) {  
         $Str = '<h3 style="color:red">'.  
             'An error occurred while calculating this spreadsheet'.  
             "</h3>\n".  
             '<pre>'.$self->calcerror()."</pre>\n";  
     }  
     return $Str;  
 }  
   
 sub html_export_row {  sub html_export_row {
     my $self = shift();      my $self = shift();
     my ($color) = @_;      my ($color) = @_;
Line 1391  sub create_excel_spreadsheet { Line 1350  sub create_excel_spreadsheet {
 sub outsheet_excel {  sub outsheet_excel {
     my $self = shift;      my $self = shift;
     my ($r) = @_;      my ($r) = @_;
       my $connection = $r->connection();
     $r->print("<h2>Preparing Excel Spreadsheet</h2>");      $r->print("<h2>Preparing Excel Spreadsheet</h2>");
     #      #
     # Create excel worksheet      # Create excel worksheet
Line 1414  sub outsheet_excel { Line 1374  sub outsheet_excel {
     $self->excel_output_row($worksheet,0,$rows_output++,'Summary');      $self->excel_output_row($worksheet,0,$rows_output++,'Summary');
     $rows_output++;    # skip a line      $rows_output++;    # skip a line
     #      #
     $self->excel_rows($worksheet,$cols_output,$rows_output);      $self->excel_rows($connection,$worksheet,$cols_output,$rows_output);
     #      #
     #      #
     # Close the excel file      # Close the excel file
     $workbook->close();      $workbook->close();
     $r->print($self->html_report_error());  
     #      #
     # Write a link to allow them to download it      # Write a link to allow them to download it
     $r->print('<br />'.      $r->print('<br />'.
Line 1433  sub outsheet_excel { Line 1392  sub outsheet_excel {
 sub outsheet_csv   {  sub outsheet_csv   {
     my $self = shift;      my $self = shift;
     my ($r) = @_;      my ($r) = @_;
       my $connection = $r->connection();
     my $csvdata = '';      my $csvdata = '';
     my @Values;      my @Values;
     #      #
Line 1456  sub outsheet_csv   { Line 1416  sub outsheet_csv   {
     }      }
     #      #
     # Output the body of the spreadsheet      # Output the body of the spreadsheet
     $self->csv_rows($file);      $self->csv_rows($connection,$file);
     #      #
     # Close the csv file      # Close the csv file
     close($file);      close($file);
     $r->print($self->html_report_error());  
     $r->print('<br /><br />'.      $r->print('<br /><br />'.
               '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");                '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");
     #      #
Line 1631  sub load { Line 1590  sub load {
 sub set_row_sources {  sub set_row_sources {
     my $self = shift;      my $self = shift;
     while (my ($cell,$value) = each(%{$self->{'formulas'}})) {      while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
         next if ($cell !~ /^A(\d+)/ && $1 > 0);          next if ($cell !~ /^A(\d+)/ || $1 < 1);
         my $row = $1;          my $row = $1;
         $self->{'row_source'}->{$row} = $value;          $self->{'row_source'}->{$row} = $value;
     }      }
Line 1693  sub save { Line 1652  sub save {
             return $reply if ($reply ne 'ok');              return $reply if ($reply ne 'ok');
         }           } 
         if ($self->is_default()) {          if ($self->is_default()) {
             &Apache::lonnet::expirespread('','',$self->{'type'},'');              if ($self->{'type'} eq 'studentcalc') {
             if ($self->{'type'} eq 'assesscalc') {                  &Apache::lonnet::expirespread('','','studentcalc','');
               } elsif ($self->{'type'} eq 'assesscalc') {
                   &Apache::lonnet::expirespread('','','assesscalc','');
                 &Apache::lonnet::expirespread('','','studentcalc','');                  &Apache::lonnet::expirespread('','','studentcalc','');
             }              }
         }          }
Removed from v.1.21.2.1  
changed lines
  Added in v.1.26

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