[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.33 and 1.43

version 1.33, 2004/01/14 16:47:39 version 1.43, 2005/04/29 18:13:07
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 '') {
           $name = $env{'user.name'};
       }
       if (! defined($domain) || $domain eq '') {
           $domain = $env{'user.domain'};
       }
     #      #
     my $self = {      my $self = {
         name     => $name,          name     => $name,
Line 94  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 123  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 151  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 250  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 307  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 314  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');
       $safeeval->share('$@');        $safeeval->share('$@');
       my $code=<<'ENDDEFS';        my $code=<<'ENDDEFS';
Line 373  $errormsg = ''; Line 385  $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 565  sub SUMMAX { Line 596  sub SUMMAX {
     foreach (grep eval("/$mask/"),keys(%sheet_values)) {      foreach (grep eval("/$mask/"),keys(%sheet_values)) {
  push (@inside,$sheet_values{$_});   push (@inside,$sheet_values{$_});
     }      }
     @inside=sort(@inside);      @inside=sort {$a <=> $b} (@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 592  sub SUMMIN { Line 623  sub SUMMIN {
     foreach (grep eval("/$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 {$a <=> $b} (@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 615  parametername should be a string such as Line 646  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 640  parametername should be a string such as Line 670  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 692  ENDDEFS Line 721  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 846  sub expandnamed { Line 876  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 908  sub sett { Line 937  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 1193  sub display { Line 1223  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 1237  sub html_export_row { Line 1267  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 1254  sub html_export_row { Line 1284  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 1291  sub html_editable_cell { Line 1321  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 1314  sub html_editable_cell { Line 1344  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 1345  sub html_row { Line 1375  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 1370  sub output_selector { Line 1400  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 1404  sub excel_output_row { Line 1434  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 1449  sub outsheet_excel { Line 1454  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 1461  sub outsheet_excel { Line 1466  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 1498  sub outsheet_csv   { Line 1505  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 1557  sub outsheet_xml   { Line 1564  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 {
Line 1570  sub outsheet_xml   { Line 1577  sub outsheet_xml   {
         }          }
     }      }
     $Str.="</spreadsheet>";      $Str.="</spreadsheet>";
 #    $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");      $r->print("<pre>\n\n\n".$Str."\n\n\n</pre>");
     return $Str;      return $Str;
 }  }
   
Line 1597  sub parse_sheet { Line 1604  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 1748  sub save { Line 1754  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 1774  sub save { Line 1780  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 1794  sub save_tmp { Line 1800  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.33  
changed lines
  Added in v.1.43

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