[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.25 and 1.37.2.1

version 1.25, 2003/09/12 18:59:48 version 1.37.2.1, 2005/04/21 17:30:24
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 380  returns the number of items in the range Line 388  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 397  sub BIN { Line 405  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 419  returns the sum of items in the range. Line 427  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 440  sub MEAN { Line 448  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 465  compute the standard deviation of the it Line 473  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 492  compute the product of the items in the Line 500  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 512  compute the maximum of the items in the Line 520  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 535  compute the minimum of the items in the Line 543  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 560  sub SUMMAX { Line 568  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 587  sub SUMMIN { Line 595  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 613  parametername should be a string such as Line 621  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 638  parametername should be a string such as Line 645  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 677  sub calc { Line 683  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"
Line 713  ENDDEFS Line 719  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 727  sub mask { Line 744  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 849  sub expandnamed { Line 850  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 911  sub sett { Line 911  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})
    && $self->{'constants'}->{$cell} ne '') {
                 my $data = $self->{'constants'}->{$cell};                  my $data = $self->{'constants'}->{$cell};
                 $t{$cell} = $data;                  $t{$cell} = $data;
             }              }
Line 1143  sub calcsheet { Line 1144  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 1154  sub calcsheet { Line 1195  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 1173  sub display { Line 1225  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 1231  sub html_editable_cell { Line 1295  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 1254  sub html_editable_cell { Line 1318  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 1287  sub html_header { Line 1351  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 1300  sub output_selector { Line 1379  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 1341  sub create_excel_spreadsheet { Line 1417  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 1357  sub create_excel_spreadsheet { Line 1433  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 1403  sub outsheet_csv   { Line 1493  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 1413  sub outsheet_csv   { Line 1507  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 1431  sub outsheet_csv   { Line 1525  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 1467  sub outsheet_xml   { Line 1561  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 1504  sub parse_sheet { Line 1601  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 1559  sub load { Line 1655  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 1622  sub set_row_numbers { Line 1718  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 1757  sub othersheets { Line 1856  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.25  
changed lines
  Added in v.1.37.2.1

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