[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.36 and 1.47

version 1.36, 2004/02/24 20:47:14 version 1.47, 2005/05/13 21:16:09
Line 86  sub new { Line 86  sub new {
     my ($stype) = ($class =~ /Apache::(.*)$/);      my ($stype) = ($class =~ /Apache::(.*)$/);
     #      #
     my ($name,$domain,$filename,$usymb)=@_;      my ($name,$domain,$filename,$usymb)=@_;
       if (defined($usymb) && ref($usymb)) {
           $usymb = $usymb->symb;
       }
     if (! defined($name) || $name eq '') {      if (! defined($name) || $name eq '') {
         $name = $ENV{'user.name'};          $name = $env{'user.name'};
     }      }
     if (! defined($domain) || $domain eq '') {      if (! defined($domain) || $domain eq '') {
         $domain = $ENV{'user.domain'};          $domain = $env{'user.domain'};
     }      }
     #      #
     my $self = {      my $self = {
Line 100  sub new { Line 103  sub new {
         symb     => $usymb,          symb     => $usymb,
         errorlog => '',          errorlog => '',
         maxrow   => 0,          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'},
         chome    => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},          chome    => $env{'course.'.$env{'request.course.id'}.'.home'},
         coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},          coursedesc => $env{'course.'.$env{'request.course.id'}.'.description'},
         coursefilename => $ENV{'request.course.fn'},          coursefilename => $env{'request.course.fn'},
         #          #
         # Flags          # Flags
         temporary => 0,  # true if this sheet has been modified but not saved          temporary => 0,  # true if this sheet has been modified but not saved
Line 129  sub new { Line 132  sub new {
     #      #
     # Load in the spreadsheet definition      # Load in the spreadsheet definition
     $self->filename($filename);      $self->filename($filename);
     if (exists($ENV{'form.workcopy'}) &&       if (exists($env{'form.workcopy'}) && 
         $self->{'type'} eq $ENV{'form.workcopy'}) {          $self->{'type'} eq $env{'form.workcopy'}) {
         $self->load_tmp();          $self->load_tmp();
     } else {      } else {
         $self->load();          $self->load();
Line 157  sub filename { Line 160  sub filename {
             $newfilename !~ /\w/ || $newfilename eq '') {              $newfilename !~ /\w/ || $newfilename eq '') {
             my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.              my $key = 'course.'.$self->{'cid'}.'.spreadsheet_default_'.
                 $self->{'type'};                  $self->{'type'};
             if (exists($ENV{$key}) && $ENV{$key} ne '') {              if (exists($env{$key}) && $env{$key} ne '') {
                 $newfilename = $ENV{$key};                  $newfilename = $env{$key};
             } else {              } else {
                 $newfilename = 'default_'.$self->{'type'};                  $newfilename = 'default_'.$self->{'type'};
             }              }
Line 256  sub initialize_spreadsheet_package { Line 259  sub initialize_spreadsheet_package {
   
 sub load_spreadsheet_expirationdates {  sub load_spreadsheet_expirationdates {
     undef %expiredates;      undef %expiredates;
     my $cid=$ENV{'request.course.id'};      my $cid=$env{'request.course.id'};
     my @tmp = &Apache::lonnet::dump('nohist_expirationdates',      my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
                                     $ENV{'course.'.$cid.'.domain'},                                      $env{'course.'.$cid.'.domain'},
                                     $ENV{'course.'.$cid.'.num'});                                      $env{'course.'.$cid.'.num'});
     if (lc($tmp[0]) !~ /^error/){      if (lc($tmp[0]) !~ /^error/){
         %expiredates = @tmp;          %expiredates = @tmp;
     }      }
Line 313  Returns the safe space required by a Spr Line 316  Returns the safe space required by a Spr
   
 sub initialize_safe_space {  sub initialize_safe_space {
   my $self = shift;    my $self = shift;
     my $usection = &Apache::lonnet::getsection($self->{'domain'},
                                                $self->{'name'},
                                                $env{'request.course.id'});
   if (! defined($safeeval)) {    if (! defined($safeeval)) {
       $safeeval = new Safe(shift);        $safeeval = new Safe(shift);
       my $safehole = new Safe::Hole;        my $safehole = new Safe::Hole;
Line 320  sub initialize_safe_space { Line 326  sub initialize_safe_space {
       $safeeval->permit(":base_math");        $safeeval->permit(":base_math");
       $safeeval->permit("sort");        $safeeval->permit("sort");
       $safeeval->deny(":base_io");        $safeeval->deny(":base_io");
       $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');        $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&Apache::lonnet::EXT');
       $safehole->wrap(\&mask,$safeeval,'&mask');        $safehole->wrap(\&mask,$safeeval,'&mask');
         $safehole->wrap(\&Apache::lonnet::logthis,$safeeval,'&logthis');
       $safeeval->share('$@');        $safeeval->share('$@');
       # Holds the (computed, final) values for the sheet
       # This is only written to by &calc, the spreadsheet computation routine.
       # It is read by many functions
         $safeeval->share('%sheet_values');
       my $code=<<'ENDDEFS';        my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
 #  #
Line 332  sub initialize_safe_space { Line 343  sub initialize_safe_space {
 # c: preloaded constants (A-column)  # c: preloaded constants (A-column)
 # rl: row label  # rl: row label
 # os: other spreadsheets (for student spreadsheet only)  # os: other spreadsheets (for student spreadsheet only)
 undef %sheet_values;   # Holds the (computed, final) values for the sheet  undef %t; # Holds the forumlas of the spreadsheet to be computed. Set in
     # This is only written to by &calc, the spreadsheet computation routine.      # &sett, which does the translation of strings like C5 into the value
     # It is read by many functions      # in C5. Used in &calc - %t holds the values that are actually eval'd.
 undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,   
     # which does the translation of strings like C5 into the value in C5.  
     # Used in &calc - %t holds the values that are actually eval'd.  
 undef %f;    # Holds the formulas for each cell.  This is the users  undef %f;    # Holds the formulas for each cell.  This is the users
     # (spreadsheet authors) data for each cell.      # (spreadsheet authors) data for each cell.
 undef %c; # Holds the constants for a sheet.  In the assessment  undef %c; # Holds the constants for a sheet.  In the assessment
Line 379  $errormsg = ''; Line 387  $errormsg = '';
   
 =pod  =pod
   
   =item EXT(parameter)
   
   Calls the system EXT function to determine the value of the given parameter.
   
   =cut
   
   #-------------------------------------------------------
   sub EXT {
       my ($parameter) = @_;
       return '' if (! defined($parameter) || $parameter eq '');
       $parameter =~ s/^parameter\./resource\./;
       my $value = &Apache::lonnet::EXT($parameter,$symb,$domain,$name,$usection);
       return $value;
   }
   
   #-------------------------------------------------------
   
   =pod
   
 =item NUM(range)  =item NUM(range)
   
 returns the number of items in the range.  returns the number of items in the range.
Line 387  returns the number of items in the range Line 414  returns the number of items in the range
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub NUM {  sub NUM {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $num= $#{@{grep(eval("/$mask/"),keys(%sheet_values))}}+1;      my $num= scalar(@$values);
     return $num;         return $num;   
 }  }
   
Line 403  sub NUM { Line 430  sub NUM {
 #-------------------------------------------------------  #-------------------------------------------------------
 sub BIN {  sub BIN {
     my ($low,$high,$lower,$upper)=@_;      my ($low,$high,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $values=&get_values($lower,$upper);
     my $num=0;      my $num=0;
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {          if (($_>=$low) && ($_<=$high)) {
             $num++;              $num++;
         }          }
     }      }
Line 425  returns the sum of items in the range. Line 452  returns the sum of items in the range.
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub SUM {  sub SUM {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $sum=0;      my $sum=0;
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         $sum+=$sheet_values{$_};          $sum+=$_;
     }      }
     return $sum;         return $sum;   
 }  }
Line 445  compute the average of the items in the Line 472  compute the average of the items in the
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub MEAN {  sub MEAN {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $sum=0;       my $sum=0; 
     my $num=0;      my $num=0;
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         $sum+=$sheet_values{$_};          $sum+=$_;
         $num++;          $num++;
     }      }
     if ($num) {      if ($num) {
Line 471  compute the standard deviation of the it Line 498  compute the standard deviation of the it
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub STDDEV {  sub STDDEV {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         $sum+=$sheet_values{$_};          $sum+=$_;
         $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 eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         $sum+=($sheet_values{$_}-$mean)**2;          $sum+=($_-$mean)**2;
     }      }
     return sqrt($sum/($num-1));          return sqrt($sum/($num-1));    
 }  }
Line 498  compute the product of the items in the Line 525  compute the product of the items in the
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub PROD {  sub PROD {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $prod=1;      my $prod=1;
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         $prod*=$sheet_values{$_};          $prod*=$_;
     }      }
     return $prod;         return $prod;   
 }  }
Line 518  compute the maximum of the items in the Line 545  compute the maximum of the items in the
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub MAX {  sub MAX {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $max='-';      my $max='-';
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         unless ($max) { $max=$sheet_values{$_}; }          if (($_>$max) || ($max eq '-')) { 
         if (($sheet_values{$_}>$max) || ($max eq '-')) {               $max=$_; 
             $max=$sheet_values{$_};   
         }          }
     }       } 
     return $max;         return $max;   
Line 541  compute the minimum of the items in the Line 567  compute the minimum of the items in the
   
 #-------------------------------------------------------  #-------------------------------------------------------
 sub MIN {  sub MIN {
     my $mask=&mask(@_);      my $values=&get_values(@_);
     my $min='-';      my $min='-';
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (@$values) {
         unless ($max) { $max=$sheet_values{$_}; }          if (($_<$min) || ($min eq '-')) { 
         if (($sheet_values{$_}<$min) || ($min eq '-')) {               $min=$_; 
             $min=$sheet_values{$_};   
         }          }
     }      }
     return $min;         return $min;   
Line 566  compute the sum of the largest 'num' ite Line 591  compute the sum of the largest 'num' ite
 #-------------------------------------------------------  #-------------------------------------------------------
 sub SUMMAX {  sub SUMMAX {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $values=&get_values($lower,$upper);
     my @inside=();      my @inside=sort {$a <=> $b} (@$values);
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {  
  push (@inside,$sheet_values{$_});  
     }  
     @inside=sort(@inside);  
     my $sum=0; my $i;      my $sum=0; my $i;
     for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {       for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
         $sum+=$inside[$i];          $sum+=$inside[$i];
Line 593  compute the sum of the smallest 'num' it Line 614  compute the sum of the smallest 'num' it
 #-------------------------------------------------------  #-------------------------------------------------------
 sub SUMMIN {  sub SUMMIN {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=&mask($lower,$upper);      my $values=&get_values($lower,$upper);
     my @inside=();      my @inside=sort {$a <=> $b} (@$values);
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {  
  $inside[$#inside+1]=$sheet_values{$_};  
     }  
     @inside=sort(@inside);  
     my $sum=0; my $i;      my $sum=0; my $i;
     for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {       for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
         $sum+=$inside[$i];          $sum+=$inside[$i];
Line 654  sub MAXPARM { Line 671  sub MAXPARM {
     return $max;      return $max;
 }  }
   
   #-------------------------------------------------------
   
   =pod
   
   =item  &get_values($lower,$upper)
   
   Inputs: $lower and $upper, cell names ("X12" or "a150") or globs ("X*").
   
   Returns: an array ref of the values of the cells that exist in the 
            speced range
   
   =cut
   
   #-------------------------------------------------------
   sub get_values {
       my ($lower,$upper)=@_;
       $upper = $lower if (! defined($upper));
       my @values;
       my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);
       my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);
       my ($alpha,$num);
       if ($ld ne '*' && $ud ne '*') {
    my @alpha;
    if (($la eq '*') || ($ua eq '*')) {
       @alpha=('A'..'z');
    } else {
       if ($la gt $ua) { ($la,$ua)=($ua,$la); }
       if ((lc($la) ne $la) && (lc($ua) eq $ua)) {
    @alpha=($la..'Z','a'..$ua);
       } else {
    @alpha=($la..$ua);
               }
    }
    my @num=($ld..$ud);
    foreach my $a (@alpha) {
       foreach my $n (@num) {
    if (exists($sheet_values{$a.$n})) {
       push(@values,$sheet_values{$a.$n});
    }
       }
    }
    return \@values;
       } else {
    $num = '(\d+)';
       }
       if (($la eq '*') || ($ua eq '*')) {
           $alpha='[A-z]';
       } else {
    if ($la gt $ua) { ($la,$ua)=($ua,$la); }
           $alpha=qq/[$la-$ua]/;
       }
       my $expression = '^'.$alpha.$num.'$';
       foreach (grep /$expression/,keys(%sheet_values)) {
    push(@values,$sheet_values{$_});
       }
       return \@values;
   }
   
 sub calc {  sub calc {
     %sheet_values = %t;  
     my $notfinished = 1;      my $notfinished = 1;
     my $lastcalc = '';      my $lastcalc = '';
     my $depth = 0;      my $depth = 0;
Line 696  ENDDEFS Line 769  ENDDEFS
     # Place some of the %$self  items into the safe space except the safe space      # Place some of the %$self  items into the safe space except the safe space
     # itself      # itself
     my $initstring = '';      my $initstring = '';
     foreach (qw/name domain type usymb cid csec coursefilename      foreach (qw/name domain type symb cid csec coursefilename
              cnum cdom chome uhome/) {               cnum cdom chome uhome/) {
         $initstring.= qq{\$$_="$self->{$_}";};          $initstring.= qq{\$$_="$self->{$_}";};
     }      }
       $initstring.=qq{\$usection="$usection";};
     $self->{'safe'}->reval($initstring);      $self->{'safe'}->reval($initstring);
     return $self;      return $self;
 }  }
Line 716  ENDDEFS Line 790  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  
   
 ######################################################  
 {  
   
 my %memoizer;  
   
 sub mask {  
     my ($lower,$upper)=@_;  
     my $key = $lower.'_'.$upper;  
     if (exists($memoizer{$key})) {  
         return $memoizer{$key};  
     }  
     $upper = $lower if (! defined($upper));  
     #  
     my ($la,$ld) = ($lower=~/([A-z]|\*)(\d+|\*)/);  
     my ($ua,$ud) = ($upper=~/([A-z]|\*)(\d+|\*)/);  
     #  
     my $alpha='';  
     my $num='';  
     #  
     # Do not put parenthases around $alpha.  
     # $num depends on the value in $1.  
     if (($la eq '*') || ($ua eq '*')) {  
         $alpha='[A-z]';  
     } else {  
         if ($la gt $ua) {  
             my $tmp = $ua;  
             $ua = $la;  
             $la = $ua;  
         }  
         $alpha=qq/[$la-$ua]/;  
     }  
     if ($ld ne '*' && $ud ne '*') {  
         # Make sure $ld <= $ud  
         if ($ld > $ud) {  
             my $tmp = $ud;  
             $ud = $ld;  
             $ld = $tmp;  
         }  
         # 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 {  
         $num = '(\d+)';  
     }  
     my $expression = '^'.$alpha.$num.'$';  
     $memoizer{$key} = $expression;  
     return $expression;  
 }  
   
 #  
 # Debugging routine  
 sub dump_memoized_values {  
     while (my ($key,$value) = each(%memoizer)) {  
         &Apache::lonnet::logthis('memoizer: '.$key.' = '.$value);  
     }  
     return;  
 }  
   
 }  
   
 ##  ##
 ## sub add_hash_to_safe {} # spreadsheet, would like to destroy  ## sub add_hash_to_safe {} # spreadsheet, would like to destroy
 ##  ##
Line 881  sub expandnamed { Line 869  sub expandnamed {
 sub sett {  sub sett {
     my $self = shift;      my $self = shift;
     my %t=();      my %t=();
       undef(%Apache::Spreadsheet::sheet_values);
     #      #
     # Deal with the template row      # Deal with the template row
     foreach my $col ($self->template_cells()) {      foreach my $col ($self->template_cells()) {
Line 911  sub sett { Line 900  sub sett {
             $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;              $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
             $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;              $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
         } elsif  ( $col  =~ /^[A-Z]$/  ) {          } elsif  ( $col  =~ /^[A-Z]$/  ) {
             if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})) {              if ($formula !~ /^\!/ && exists($self->{'constants'}->{$cell})
                 my $data = $self->{'constants'}->{$cell};   && $self->{'constants'}->{$cell} ne '') {
                 $t{$cell} = $data;   $Apache::Spreadsheet::sheet_values{$cell}=
       eval($self->{'constants'}->{$cell});
             }              }
         } else { # $row > 1 and $col =~ /[a-z]          } else { # $row > 1 and $col =~ /[a-z]
             $t{$cell}=$formula;              $t{$cell}=$formula;
Line 932  sub sett { Line 922  sub sett {
 sub sync_safe_space {  sub sync_safe_space {
     my $self = shift;      my $self = shift;
     # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.      # Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
     %{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};      #%{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
     # 'constants' leads a peaceful hidden life of 'c'.      # 'constants' leads a peaceful hidden life of 'c'.
     %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};      %{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
     # 'othersheets' hides as 'os', a disguise few can penetrate.      # 'othersheets' hides as 'os', a disguise few can penetrate.
     @{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};      #@{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
 }  }
   
 ##  ##
Line 1196  sub display { Line 1186  sub display {
     my ($r) = @_;      my ($r) = @_;
     my $outputmode = 'html';      my $outputmode = 'html';
     foreach ($self->output_options()) {      foreach ($self->output_options()) {
         if ($ENV{'form.output_format'} eq $_->{'value'}) {          if ($env{'form.output_format'} eq $_->{'value'}) {
             $outputmode = $_->{'value'};              $outputmode = $_->{'value'};
             last;              last;
         }          }
Line 1240  sub html_export_row { Line 1230  sub html_export_row {
     my $self = shift();      my $self = shift();
     my ($color) = @_;      my ($color) = @_;
     $color = '#CCCCFF' if (! defined($color));      $color = '#CCCCFF' if (! defined($color));
     my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});      my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
     my $row_html;      my $row_html;
     my @rowdata = $self->get_row(0);      my @rowdata = $self->get_row(0);
     foreach my $cell (@rowdata) {      foreach my $cell (@rowdata) {
Line 1257  sub html_export_row { Line 1247  sub html_export_row {
   
 sub html_template_row {  sub html_template_row {
     my $self = shift();      my $self = shift();
     my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});      my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
     my ($num_uneditable,$importcolor) = @_;      my ($num_uneditable,$importcolor) = @_;
     my $row_html;      my $row_html;
     my @rowdata = $self->get_template_row();      my @rowdata = $self->get_template_row();
Line 1294  sub html_editable_cell { Line 1284  sub html_editable_cell {
     } elsif ($value =~ /^\s*$/ ) {      } elsif ($value =~ /^\s*$/ ) {
         $value = '<font color="'.$bgcolor.'">#</font>';          $value = '<font color="'.$bgcolor.'">#</font>';
     } else {      } else {
         $value = &HTML::Entities::encode($value) if ($value !~/&nbsp;/);          $value = &HTML::Entities::encode($value,'<>&"') if ($value !~/&nbsp;/);
     }      }
     return $value if (! $allowed);      return $value if (! $allowed);
     #      #
Line 1317  sub html_editable_cell { Line 1307  sub html_editable_cell {
 sub html_uneditable_cell {  sub html_uneditable_cell {
     my ($cell,$bgcolor) = @_;      my ($cell,$bgcolor) = @_;
     my $value = (defined($cell) ? $cell->{'value'} : '');      my $value = (defined($cell) ? $cell->{'value'} : '');
     $value = &HTML::Entities::encode($value) if ($value !~/&nbsp;/);      $value = &HTML::Entities::encode($value,'<>&"') if ($value !~/&nbsp;/);
     return '&nbsp;'.$value.'&nbsp;';      return '&nbsp;'.$value.'&nbsp;';
 }  }
   
 sub html_row {  sub html_row {
     my $self = shift();      my $self = shift();
     my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;      my ($num_uneditable,$row,$exportcolor,$importcolor) = @_;
     my $allowed = &Apache::lonnet::allowed('mgr',$ENV{'request.course.id'});      my $allowed = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
     my @rowdata = $self->get_row($row);      my @rowdata = $self->get_row($row);
     my $num_cols_output = 0;      my $num_cols_output = 0;
     my $row_html;      my $row_html;
Line 1348  sub html_row { Line 1338  sub html_row {
   
 sub html_header {  sub html_header {
     my $self = shift;      my $self = shift;
     return '' if (! $ENV{'request.role.adv'});      return '' if (! $env{'request.role.adv'});
     return "<table>\n".      return "<table>\n".
         '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".          '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
         '<tr><td>'.$self->output_selector()."</td></tr>\n".          '<tr><td>'.$self->output_selector()."</td></tr>\n".
Line 1373  sub output_selector { Line 1363  sub output_selector {
     my $self = shift();      my $self = shift();
     my $output_selector = '<select name="output_format" size="3">'."\n";      my $output_selector = '<select name="output_format" size="3">'."\n";
     my $default = 'html';      my $default = 'html';
     if (exists($ENV{'form.output_format'})) {      if (exists($env{'form.output_format'})) {
         $default = $ENV{'form.output_format'}           $default = $env{'form.output_format'} 
     } else {      } else {
         $ENV{'form.output_format'} = $default;          $env{'form.output_format'} = $default;
     }      }
     foreach  ($self->output_options()) {      foreach  ($self->output_options()) {
         $output_selector.='<option value="'.$_->{'value'}.'"';          $output_selector.='<option value="'.$_->{'value'}.'"';
Line 1407  sub excel_output_row { Line 1397  sub excel_output_row {
     return;      return;
 }  }
   
 sub create_excel_spreadsheet {  
     my $self = shift;  
     my ($r) = @_;  
     my $filename = '/prtspool/'.  
         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.  
         time.'_'.rand(1000000000).'.xls';  
     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);  
     if (! defined($workbook)) {  
         $r->log_error("Error creating excel spreadsheet $filename: $!");  
         $r->print(&mt("Problems creating new Excel file.  ".  
                   "This error has been logged.  ".  
                   "Please alert your LON-CAPA administrator"));  
         return undef;  
     }  
     #  
     # The excel spreadsheet stores temporary data in files, then put them  
     # together.  If needed we should be able to disable this (memory only).  
     # The temporary directory must be specified before calling 'addworksheet'.  
     # File::Temp is used to determine the temporary directory.  
     $workbook->set_tempdir('/home/httpd/perl/tmp');  
     #  
     # Determine the name to give the worksheet  
     return ($workbook,$filename);  
 }  
   
 #  #
 # This routine is just a stub   # This routine is just a stub 
 sub outsheet_htmlclasslist {  sub outsheet_htmlclasslist {
Line 1452  sub outsheet_excel { Line 1417  sub outsheet_excel {
     #      #
     $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");      $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
     #      #
     # Create excel worksheet      # Create excel workbook
     my ($workbook,$filename) = $self->create_excel_spreadsheet($r);      my ($workbook,$filename,$format)=&Apache::loncommon::create_workbook($r);
     return if (! defined($workbook));      return if (! defined($workbook));
     #      #
     # Create main worksheet      # Create main worksheet
Line 1464  sub outsheet_excel { Line 1429  sub outsheet_excel {
     # Write excel header      # Write excel header
     foreach my $value ($self->get_title()) {      foreach my $value ($self->get_title()) {
         $cols_output = 0;          $cols_output = 0;
         $worksheet->write($rows_output++,$cols_output,$value);          $worksheet->write($rows_output++,$cols_output,$value,$format->{'h1'});
     }      }
     $rows_output++;    # skip a line      $rows_output++;    # skip a line
     #      #
     # Write summary/export row      # Write summary/export row
     $cols_output = 0;      $cols_output = 0;
     $self->excel_output_row($worksheet,0,$rows_output++,'Summary');      $self->excel_output_row($worksheet,0,$rows_output++,'Summary',
                               $format->{'b'});
     $rows_output++;    # skip a line      $rows_output++;    # skip a line
     #      #
     $self->excel_rows($connection,$worksheet,$cols_output,$rows_output);      $self->excel_rows($connection,$worksheet,$cols_output,$rows_output,
                         $format);
     #      #
     #      #
     # Close the excel file      # Close the excel file
Line 1501  sub outsheet_csv   { Line 1468  sub outsheet_csv   {
     #      #
     # Open the csv file      # Open the csv file
     my $filename = '/prtspool/'.      my $filename = '/prtspool/'.
         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.          $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
         time.'_'.rand(1000000000).'.csv';          time.'_'.rand(1000000000).'.csv';
     my $file;      my $file;
     unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {      unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
Line 1750  sub save { Line 1717  sub save {
         my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);          my $reply = &Apache::lonnet::put($filename,\%f,$cdom,$cnum);
         return $reply if ($reply ne 'ok');          return $reply if ($reply ne 'ok');
         $reply = &Apache::lonnet::put($stype.'_spreadsheets',          $reply = &Apache::lonnet::put($stype.'_spreadsheets',
                      {$filename => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},                       {$filename => $env{'user.name'}.'@'.$env{'user.domain'}},
                                       $cdom,$cnum);                                        $cdom,$cnum);
         return $reply if ($reply ne 'ok');          return $reply if ($reply ne 'ok');
         if ($makedef) {           if ($makedef) { 
Line 1776  sub save { Line 1743  sub save {
   
 sub save_tmp {  sub save_tmp {
     my $self = shift;      my $self = shift;
     my $filename=$ENV{'user.name'}.'_'.      my $filename=$env{'user.name'}.'_'.
         $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.          $env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
            $self->{'filename'};             $self->{'filename'};
     $filename=~s/\W/\_/g;      $filename=~s/\W/\_/g;
     $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';      $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
Line 1796  sub save_tmp { Line 1763  sub save_tmp {
   
 sub load_tmp {  sub load_tmp {
     my $self = shift;      my $self = shift;
     my $filename=$ENV{'user.name'}.'_'.      my $filename=$env{'user.name'}.'_'.
         $ENV{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.          $env{'user.domain'}.'_spreadsheet_'.$self->{'symb'}.'_'.
             $self->{'filename'};              $self->{'filename'};
     $filename=~s/\W/\_/g;      $filename=~s/\W/\_/g;
     $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';      $filename=$Apache::lonnet::tmpdir.$filename.'.tmp';
Removed from v.1.36  
changed lines
  Added in v.1.47

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