[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.23 and 1.38

version 1.23, 2003/09/05 01:57:54 version 1.38, 2005/02/03 23:59:41
Line 48  Spreadsheet Line 48  Spreadsheet
 package Apache::Spreadsheet;  package Apache::Spreadsheet;
   
 use strict;  use strict;
 use warnings FATAL=>'all';  #use warnings FATAL=>'all';
 no warnings 'uninitialized';  #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 59  use HTML::Entities(); Line 59  use HTML::Entities();
 use HTML::TokeParser;  use HTML::TokeParser;
 use Spreadsheet::WriteExcel;  use Spreadsheet::WriteExcel;
 use Time::HiRes;  use Time::HiRes;
   use Apache::lonlocal;
   
 ##  ##
 ## Package Variables  ## Package Variables
Line 85  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($name) || $name eq '') {
           $name = $ENV{'user.name'};
       }
       if (! defined($domain) || $domain eq '') {
           $domain = $ENV{'user.domain'};
       }
     #      #
     my $self = {      my $self = {
         name     => $name,          name     => $name,
Line 159  sub filename { Line 166  sub filename {
         if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) {          if ($newfilename !~ /\w/ || $newfilename =~ /^\W*$/) {
             $newfilename = 'default_'.$self->{'type'};              $newfilename = 'default_'.$self->{'type'};
         }          }
         if ($newfilename !~ /^default\.$self->{'type'}$/ ) {          if ($newfilename !~ /^default\.$self->{'type'}$/ &&
               $newfilename !~ /^\/res\/(.*)spreadsheet$/) {
             if ($newfilename !~ /_$self->{'type'}$/) {              if ($newfilename !~ /_$self->{'type'}$/) {
                 $newfilename =~ s/[\s_]*$//;                  $newfilename =~ s/[\s_]*$//;
                 $newfilename .= '_'.$self->{'type'};                  $newfilename .= '_'.$self->{'type'};
Line 299  Returns the safe space required by a Spr Line 307  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);    my $usection = &Apache::lonnet::getsection($self->{'domain'},
     my $safehole = new Safe::Hole;                                               $self->{'name'},
     $safeeval->permit("entereval");                                               $ENV{'request.course.id'});
     $safeeval->permit(":base_math");    if (! defined($safeeval)) {
     $safeeval->permit("sort");        $safeeval = new Safe(shift);
     $safeeval->deny(":base_io");        my $safehole = new Safe::Hole;
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');        $safeeval->permit("entereval");
     $safehole->wrap(\&mask,$safeeval,'&mask');        $safeeval->permit(":base_math");
     $safeeval->share('$@');        $safeeval->permit("sort");
     my $code=<<'ENDDEFS';        $safeeval->deny(":base_io");
         $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&Apache::lonnet::EXT');
         $safehole->wrap(\&mask,$safeeval,'&mask');
         $safeeval->share('$@');
         my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
 #  #
 # f: formulas  # f: formulas
Line 366  $errormsg = ''; Line 382  $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 375  returns the number of items in the range Line 410  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 392  sub BIN { Line 427  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 414  returns the sum of items in the range. Line 449  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 435  sub MEAN { Line 470  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 460  compute the standard deviation of the it Line 495  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 487  compute the product of the items in the Line 522  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 507  compute the maximum of the items in the Line 542  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 530  compute the minimum of the items in the Line 565  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 555  sub SUMMAX { Line 590  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 582  sub SUMMIN { Line 617  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 608  parametername should be a string such as Line 643  parametername should be a string such as
 sub MINPARM {  sub MINPARM {
     my ($expression) = @_;      my ($expression) = @_;
     my $min = undef;      my $min = undef;
     study($expression);  
     foreach $parameter (keys(%c)) {      foreach $parameter (keys(%c)) {
         next if ($parameter !~ /$expression/);          next if ($parameter !~ /$expression/);
         if ((! defined($min)) || ($min > $c{$parameter})) {          if ((! defined($min)) || ($min > $c{$parameter})) {
Line 633  parametername should be a string such as Line 667  parametername should be a string such as
 sub MAXPARM {  sub MAXPARM {
     my ($expression) = @_;      my ($expression) = @_;
     my $max = undef;      my $max = undef;
     study($expression);  
     foreach $parameter (keys(%c)) {      foreach $parameter (keys(%c)) {
         next if ($parameter !~ /$expression/);          next if ($parameter !~ /$expression/);
         if ((! defined($min)) || ($max < $c{$parameter})) {          if ((! defined($min)) || ($max < $c{$parameter})) {
Line 672  sub calc { Line 705  sub calc {
             return $lastcalc.': Maximum calculation depth exceeded';              return $lastcalc.': Maximum calculation depth exceeded';
         }          }
     }      }
     return '';      return 'okay';
 }  }
   
 # ------------------------------------------- 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();
     #      #
     # 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;
 }  }
   
   }
   
 ######################################################  ######################################################
   
 =pod  =pod
Line 704  ENDDEFS Line 742  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 718  sub mask { Line 767  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]/) ||          if ($la gt $ua) {
            ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {              my $tmp = $ua;
           $alpha='['.$la.'-'.$ua.']';              $ua = $la;
        } else {              $la = $ua;
           $alpha='['.$la.'-Za-'.$ua.']';          }
        }          $alpha=qq/[$la-$ua]/;
     }         }
     if (($ld eq '*') || ($ud eq '*')) {      if ($ld ne '*' && $ud ne '*') {
  $num='\d+';          # 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 {      } 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 840  sub expandnamed { Line 873  sub expandnamed {
         my @matches = ();          my @matches = ();
         my @values = ();          my @values = ();
         $#matches = -1;          $#matches = -1;
         study $expression;  
         while (my($parameter,$value) = each(%{$self->{'constants'}})) {          while (my($parameter,$value) = each(%{$self->{'constants'}})) {
             next if ($parameter !~ /$expression/);              next if ($parameter !~ /$expression/);
             push(@matches,$parameter);              push(@matches,$parameter);
Line 1134  sub calcsheet { Line 1166  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 1145  sub calcsheet { Line 1217  sub calcsheet {
 sub display {  sub display {
     my $self = shift;      my $self = shift;
     my ($r) = @_;      my ($r) = @_;
     $self->compute($r);  
     my $outputmode = 'html';      my $outputmode = 'html';
     if ($ENV{'form.output_format'} =~ /^(html|excel|csv)$/) {      foreach ($self->output_options()) {
         $outputmode = $ENV{'form.output_format'};          if ($ENV{'form.output_format'} eq $_->{'value'}) {
               $outputmode = $_->{'value'};
               last;
           }
     }      }
     if ($outputmode eq 'html') {      if ($outputmode eq 'html') {
           $self->compute($r);
         $self->outsheet_html($r);          $self->outsheet_html($r);
       } elsif ($outputmode eq 'htmlclasslist') {
           # No computation neccessary...  This is kludgy
           $self->outsheet_htmlclasslist($r);
     } elsif ($outputmode eq 'excel') {      } elsif ($outputmode eq 'excel') {
           $self->compute($r);
         $self->outsheet_excel($r);          $self->outsheet_excel($r);
     } elsif ($outputmode eq 'csv') {      } elsif ($outputmode eq 'csv') {
           $self->compute($r);
         $self->outsheet_csv($r);          $self->outsheet_csv($r);
       } elsif ($outputmode eq 'xml') {
   #        $self->compute($r);
           $self->outsheet_xml($r);
     }      }
     $self->cleanup();      $self->cleanup();
     return;      return;
Line 1164  sub display { Line 1247  sub display {
 ############################################  ############################################
 ##         HTML output routines           ##  ##         HTML output routines           ##
 ############################################  ############################################
   sub html_report_error {
       my $self = shift();
       my $Str = '';
       if ($self->badcalc()) {
           $Str = '<h3 style="color:red">'.
               &mt('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 1222  sub html_editable_cell { Line 1317  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 1245  sub html_editable_cell { Line 1340  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;';
 }  }
   
Line 1278  sub html_header { Line 1373  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">Output Format</th><tr>'."\n".          '<tr><th align="center">'.&mt('Output Format').'</th></tr>'."\n".
         '<tr><td>'.&output_selector()."</td></tr>\n".          '<tr><td>'.$self->output_selector()."</td></tr>\n".
         "</table>\n";          "</table>\n";
 }  }
   
   ##
   ## Default output types are HTML, Excel, and CSV
   sub output_options {
       my $self = shift();
       return  ({value       => 'html',
                 description => 'HTML'},
                {value       => 'excel',
                 description => 'Excel'},
   #             {value       => 'xml',
   #              description => 'XML'},
                {value       => 'csv',
                 description => 'Comma Separated Values'},);
   }
   
 sub output_selector {  sub output_selector {
       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'})) {
Line 1291  sub output_selector { Line 1401  sub output_selector {
     } else {      } else {
         $ENV{'form.output_format'} = $default;          $ENV{'form.output_format'} = $default;
     }      }
     foreach (['html','HTML'],      foreach  ($self->output_options()) {
              ['excel','Excel'],          $output_selector.='<option value="'.$_->{'value'}.'"';
              ['csv','Comma Seperated Values']) {          if ($_->{'value'} eq $default) {
         my ($name,$description) = @{$_};  
         $output_selector.=qq{<option value="$name"};  
         if ($name eq $default) {  
             $output_selector .= ' selected';              $output_selector .= ' selected';
         }          }
         $output_selector .= ">$description</option>\n";          $output_selector .= ">".&mt($_->{'description'})."</option>\n";
     }      }
     $output_selector .= "</select>\n";      $output_selector .= "</select>\n";
     return $output_selector;      return $output_selector;
Line 1332  sub create_excel_spreadsheet { Line 1439  sub create_excel_spreadsheet {
     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);      my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
     if (! defined($workbook)) {      if (! defined($workbook)) {
         $r->log_error("Error creating excel spreadsheet $filename: $!");          $r->log_error("Error creating excel spreadsheet $filename: $!");
         $r->print("Problems creating new Excel file.  ".          $r->print(&mt("Problems creating new Excel file.  ".
                   "This error has been logged.  ".                    "This error has been logged.  ".
                   "Please alert your LON-CAPA administrator");                    "Please alert your LON-CAPA administrator"));
         return undef;          return undef;
     }      }
     #      #
Line 1348  sub create_excel_spreadsheet { Line 1455  sub create_excel_spreadsheet {
     return ($workbook,$filename);      return ($workbook,$filename);
 }  }
   
   #
   # This routine is just a stub 
   sub outsheet_htmlclasslist {
       my $self = shift;
       my ($r) = @_;
       $r->print('<h2>'.&mt("This output is not supported").'</h2>');
       $r->rflush();
       return;
   }
   
 sub outsheet_excel {  sub outsheet_excel {
     my $self = shift;      my $self = shift;
     my ($r) = @_;      my ($r) = @_;
     my $connection = $r->connection();      my $connection = $r->connection();
     $r->print("<h2>Preparing Excel Spreadsheet</h2>");      #
       $r->print($self->html_report_error());
       $r->rflush();
       #
       $r->print("<h2>".&mt('Preparing Excel Spreadsheet')."</h2>");
     #      #
     # Create excel worksheet      # Create excel worksheet
     my ($workbook,$filename) = $self->create_excel_spreadsheet($r);      my ($workbook,$filename) = $self->create_excel_spreadsheet($r);
Line 1394  sub outsheet_csv   { Line 1515  sub outsheet_csv   {
     my $self = shift;      my $self = shift;
     my ($r) = @_;      my ($r) = @_;
     my $connection = $r->connection();      my $connection = $r->connection();
       #
       $r->print($self->html_report_error());
       $r->rflush();
       #
     my $csvdata = '';      my $csvdata = '';
     my @Values;      my @Values;
     #      #
Line 1404  sub outsheet_csv   { Line 1529  sub outsheet_csv   {
     my $file;      my $file;
     unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {      unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
         $r->log_error("Couldn't open $filename for output $!");          $r->log_error("Couldn't open $filename for output $!");
         $r->print("Problems occured in writing the csv file.  ".          $r->print(&mt("Problems occured in writing the csv file.  ".
                   "This error has been logged.  ".                    "This error has been logged.  ".
                   "Please alert your LON-CAPA administrator.");                    "Please alert your LON-CAPA administrator."));
         $r->print("<pre>\n".$csvdata."</pre>\n");          $r->print("<pre>\n".$csvdata."</pre>\n");
         return 0;          return 0;
     }      }
Line 1422  sub outsheet_csv   { Line 1547  sub outsheet_csv   {
     # Close the csv file      # Close the csv file
     close($file);      close($file);
     $r->print('<br /><br />'.      $r->print('<br /><br />'.
               '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");                '<a href="'.$filename.'">'.&mt('Your CSV spreadsheet.').'</a>'."\n");
     #      #
     return 1;      return 1;
 }  }
Line 1458  sub outsheet_xml   { Line 1583  sub outsheet_xml   {
     ## But not on this day      ## But not on this day
     my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";      my $Str = '<spreadsheet type="'.$self->{'type'}.'">'."\n";
     while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {      while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
         if ($cell =~ /^template_(\d+)/) {          if ($cell =~ /^template_(\w+)/) {
             my $col = $1;              my $col = $1;
             $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";              $Str .= '<template col="'.$col.'">'.$formula.'</template>'."\n";
         } else {          } else {
             my ($row,$col) = ($cell =~ /^([A-z])(\d+)/);              my ($col,$row) = ($cell =~ /^([A-z])(\d+)/);
             next if (! defined($row) || ! defined($col));              next if (! defined($row) || ! defined($col));
             $Str .= '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</cell>'              next if ($row != 0);
               $Str .= 
                   '<field row="'.$row.'" col="'.$col.'" >'.$formula.'</field>'
                 ."\n";                  ."\n";
         }          }
     }      }
     $Str.="</spreadsheet>";      $Str.="</spreadsheet>";
       $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
     return $Str;      return $Str;
 }  }
   
Line 1495  sub parse_sheet { Line 1623  sub parse_sheet {
                 $formulas{$cell} = $formula;                  $formulas{$cell} = $formula;
                 $sources{$cell}  = $source if (defined($source));                  $sources{$cell}  = $source if (defined($source));
                 $parser->get_text('/field');                  $parser->get_text('/field');
             }              } elsif ($token->[1] eq 'template') {
             if ($token->[1] eq 'template') {  
                 $formulas{'template_'.$token->[2]->{'col'}}=                  $formulas{'template_'.$token->[2]->{'col'}}=
                     $parser->get_text('/template');                      $parser->get_text('/template');
             }              }
Line 1550  sub load { Line 1677  sub load {
         # Not cached, need to read          # Not cached, need to read
         if (! defined($filename)) {          if (! defined($filename)) {
             $formulas = $self->load_system_default_sheet();              $formulas = $self->load_system_default_sheet();
         } elsif($self->filename() =~ /^\/res\/.*\.spreadsheet$/) {          } elsif($filename =~ /^\/res\/.*\.spreadsheet$/) {
             # Load a spreadsheet definition file              # Load a spreadsheet definition file
             my $sheetxml=&Apache::lonnet::getfile              my $sheetxml=&Apache::lonnet::getfile
                 (&Apache::lonnet::filelocation('',$filename));                  (&Apache::lonnet::filelocation('',$filename));
Line 1613  sub set_row_numbers { Line 1740  sub set_row_numbers {
 ##  ##
 sub exportrow {  sub exportrow {
     my $self = shift;      my $self = shift;
       if (exists($self->{'badcalc'}) && $self->{'badcalc'}) {
           return ();
       }
     my @exportarray;      my @exportarray;
     foreach my $column (@UC_Columns) {      foreach my $column (@UC_Columns) {
         push(@exportarray,$self->value($column.'0'));          push(@exportarray,$self->value($column.'0'));
Line 1748  sub othersheets { Line 1878  sub othersheets {
                                       $self->{'cdom'}, $self->{'cnum'});                                        $self->{'cdom'}, $self->{'cnum'});
     my ($tmp) = keys(%results);      my ($tmp) = keys(%results);
     if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {      if ($tmp =~ /^(con_lost|error|no_such_host)/i ) {
         @alternatives = ('Default');          @alternatives = (&mt('Default'));
     } else {      } else {
         @alternatives = ('Default', sort (keys(%results)));          @alternatives = (&mt('Default'), sort (keys(%results)));
     }      }
     return @alternatives;       return @alternatives; 
 }  }
Removed from v.1.23  
changed lines
  Added in v.1.38

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