[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.13 and 1.21

version 1.13, 2003/06/18 15:32:37 version 1.21, 2003/08/26 19:14:06
Line 248  sub load_spreadsheet_expirationdates { Line 248  sub load_spreadsheet_expirationdates {
 sub check_expiration_time {  sub check_expiration_time {
     my $self = shift;      my $self = shift;
     my ($time)=@_;      my ($time)=@_;
     my ($key1,$key2,$key3,$key4);      my ($key1,$key2,$key3,$key4,$key5);
       # Description of keys
       #
       # key1: all sheets of this type have expired
       # key2: all sheets of this type for this student
       # key3: all sheets of this type in this map for this student
       # key4: this assessment sheet for this student
       # key5: this assessment sheet for all students
     $key1 = '::'.$self->{'type'}.':';      $key1 = '::'.$self->{'type'}.':';
     $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';      $key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
     $key3 = $key2.$self->{'container'} if (defined($self->{'container'}));      $key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
     $key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'}));      $key4 = $key2.$self->{'symb'} if (defined($self->{'symb'}));
     foreach my $key ($key1,$key2,$key3,$key4) {      $key5 = $key1.$self->{'symb'} if (defined($self->{'symb'}));
       my $returnvalue = 1; # default to okay
       foreach my $key ($key1,$key2,$key3,$key4,$key5) {
         next if (! defined($key));          next if (! defined($key));
         if (exists($expiredates{$key}) &&$expiredates{$key} > $time) {          if (exists($expiredates{$key}) && $expiredates{$key} > $time) {
             return 0;              $returnvalue = 0; # need to recompute
         }          }
     }      }
     return 1;      return $returnvalue;
 }  }
   
 ######################################################  ######################################################
Line 785  sub expandnamed { Line 794  sub expandnamed {
  my @vars=split(/\W+/,$formula);   my @vars=split(/\W+/,$formula);
         my %values=();          my %values=();
  foreach my $varname ( @vars ) {   foreach my $varname ( @vars ) {
             if ($varname=~/\D/) {              if ($varname=~/^(parameter|stores|timestamp)/) {
                $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;                  $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
                $varname=~s/$var/\([\\w:\\- ]\+\)/g;                 $varname=~s/$var/\([\\w:\\- ]\+\)/g;
        foreach (keys(%{$self->{'constants'}})) {         foreach (keys(%{$self->{'constants'}})) {
   if ($_=~/$varname/) {    if ($_=~/$varname/) {
Line 816  sub expandnamed { Line 825  sub expandnamed {
         #    4. If there is a collision, return 'bad parameter name error'          #    4. If there is a collision, return 'bad parameter name error'
         my $returnvalue = '';          my $returnvalue = '';
         my @matches = ();          my @matches = ();
           my @values = ();
         $#matches = -1;          $#matches = -1;
         study $expression;          study $expression;
         my $parameter;          while (my($parameter,$value) = each(%{$self->{'constants'}})) {
         foreach $parameter (keys(%{$self->{'constants'}})) {              next if ($parameter !~ /$expression/);
             push @matches,$parameter if ($parameter =~ /$expression/);              push(@matches,$parameter);
               push(@values,$value);
         }          }
         if (scalar(@matches) == 0) {          if (scalar(@matches) == 0) {
             $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';              $returnvalue = '""';#'"unmatched parameter: '.$parameter.'"';
         } elsif (scalar(@matches) == 1) {          } elsif (scalar(@matches) == 1) {
             # why do we not do this lookup here, instead of delaying it?              # why do we not do this lookup here, instead of delaying it?
             $returnvalue = '$c{\''.$matches[0].'\'}';              $returnvalue = $values[0];
         } elsif (scalar(@matches) > 0) {          } elsif (scalar(@matches) > 0) {
             # more than one match.  Look for a concise one              # more than one match.  Look for a concise one
             $returnvalue =  "'non-unique parameter name : $expression'";              $returnvalue =  "'non-unique parameter name : $expression'";
             foreach (@matches) {              for (my $i=0; $i<=$#matches;$i++) {
                 if (/^$expression$/) {                  if ($matches[$i] =~ /^$expression$/) {
                     # why do we not do this lookup here?                      # why do we not do this lookup here?
                     $returnvalue = '$c{\''.$_.'\'}';                      $returnvalue = $values[$i];
                 }                  }
             }              }
         } else {          } else {
             # There was a negative number of matches, which indicates               # There was a negative number of matches, which indicates 
             # something is wrong with reality.  Better warn the user.              # something is wrong with reality.  Better warn the user.
             $returnvalue = '"bizzare parameter: '.$parameter.'"';              $returnvalue = '"bizzare parameter: '.$expression.'"';
         }          }
         return $returnvalue;          return $returnvalue;
     }      }
Line 1141  sub display { Line 1152  sub display {
 ############################################  ############################################
 sub html_export_row {  sub html_export_row {
     my $self = shift();      my $self = shift();
       my ($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) {
         if ($cell->{'name'} =~ /^[A-Z]/) {          if ($cell->{'name'} =~ /^[A-Z]/) {
     $row_html .= '<td bgcolor="#CCCCFF">'.      $row_html .= '<td bgcolor="'.$color.'">'.
                 &html_editable_cell($cell,'#CCCCFF',$allowed).'</td>';                  &html_editable_cell($cell,$color,$allowed).'</td>';
         } else {          } else {
     $row_html .= '<td bgcolor="#DDCCFF">'.      $row_html .= '<td bgcolor="#DDCCFF">'.
                 &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';                  &html_editable_cell($cell,'#DDCCFF',$allowed).'</td>';
Line 1159  sub html_export_row { Line 1172  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) = @_;      my ($num_uneditable,$importcolor) = @_;
     my $row_html;      my $row_html;
     my @rowdata = $self->get_template_row();      my @rowdata = $self->get_template_row();
     my $count = 0;      my $count = 0;
     for (my $i = 0; $i<=$#rowdata; $i++) {      for (my $i = 0; $i<=$#rowdata; $i++) {
         my $cell = $rowdata[$i];          my $cell = $rowdata[$i];
         if ($i < $num_uneditable) {          if ($i < $num_uneditable) {
     $row_html .= '<td bgcolor="#FFDDDD">'.      $row_html .= '<td bgcolor="'.$importcolor.'">'.
                 &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';                  &html_uneditable_cell($cell,'#FFDDDD',$allowed).'</td>';
         } else {          } else {
     $row_html .= '<td bgcolor="#EOFFDD">'.      $row_html .= '<td bgcolor="#EOFFDD">'.
Line 1198  sub html_editable_cell { Line 1211  sub html_editable_cell {
         $value = &HTML::Entities::encode($value) if ($value !~/&nbsp;/);          $value = &HTML::Entities::encode($value) if ($value !~/&nbsp;/);
     }      }
     return $value if (! $allowed);      return $value if (! $allowed);
     # Make the formula safe for outputting      #
     $formula =~ s/\'/\"/g;  
     # The formula will be parsed by the browser twice before being       # The formula will be parsed by the browser twice before being 
     # displayed to the user for editing.      # displayed to the user for editing. 
     $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula));      #
     # Escape newlines so they make it into the edit window      # The encoding string "^A-blah" is placed in []'s inside a regexp, so 
     $formula =~ s/\n/\\n/gs;      # we specify the characters we want left alone by putting a '^' in front.
       $formula = &HTML::Entities::encode($formula,'^A-z0-9 !#$%-;=?~');
       # HTML::Entities::encode does not catch everything - we need '\' encoded
       $formula =~ s/\\/&\#092/g;
       # Escape it again - this time the only encodable character is '&'
       $formula =~ s/\&/\&amp;/g;
     # Glue everything together      # Glue everything together
     $result .= "<a href=\"javascript:celledit(\'".      $result .= "<a href=\"javascript:celledit(\'".
         $name."','".$formula."');\">".$value."</a>";          $name."','".$formula."');\">".$value."</a>";
Line 1220  sub html_uneditable_cell { Line 1237  sub html_uneditable_cell {
   
 sub html_row {  sub html_row {
     my $self = shift();      my $self = shift();
     my ($num_uneditable,$row) = @_;      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;
       my $color = $importcolor;
       if ($row == 0) {
           $color = $exportcolor;
       }
       $color = '#FFDDDD' if (! defined($color));
     foreach my $cell (@rowdata) {      foreach my $cell (@rowdata) {
  if ($num_cols_output++ < $num_uneditable) {   if ($num_cols_output++ < $num_uneditable) {
     $row_html .= '<td bgcolor="#FFDDDD">';      $row_html .= '<td bgcolor="'.$color.'">';
     $row_html .= &html_uneditable_cell($cell,'#FFDDDD');      $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
  } else {   } else {
     $row_html .= '<td bgcolor="#EOFFDD">';      $row_html .= '<td bgcolor="#EOFFDD">';
Line 1529  sub load { Line 1551  sub load {
             } else {              } else {
                 $self->filename($newfilename);                  $self->filename($newfilename);
             }              }
         } elsif ($filename =~ /^default\.$self->{'type'}/) {  
             # if there is an Original_$stype, load it instead  
             $formulas = $self->load_system_default_sheet();  
         } else {          } else {
             # Load the spreadsheet definition file from the save file              # Load the spreadsheet definition file from the save file
             my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);              my %tmphash = &Apache::lonnet::dump($filename,$cdom,$cnum);
Line 1619  sub save { Line 1638  sub save {
         }           } 
         if ($self->is_default()) {          if ($self->is_default()) {
             &Apache::lonnet::expirespread('','',$self->{'type'},'');              &Apache::lonnet::expirespread('','',$self->{'type'},'');
               if ($self->{'type'} eq 'assesscalc') {
                   &Apache::lonnet::expirespread('','','studentcalc','');
               }
         }          }
         return $reply;          return $reply;
     }      }
Line 1630  sub save { Line 1652  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->{'usymb'}.'_'.          $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 1650  sub save_tmp { Line 1672  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->{'usymb'}.'_'.          $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.13  
changed lines
  Added in v.1.21

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