[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.32 and 1.39

version 1.32, 2003/12/08 19:43:03 version 1.39, 2005/03/03 17:52:36
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 160  sub filename { Line 169  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 306  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 313  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 372  $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 614  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 639  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 691  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 845  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 1209  sub display { Line 1239  sub display {
     } elsif ($outputmode eq 'csv') {      } elsif ($outputmode eq 'csv') {
         $self->compute($r);          $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 1287  sub html_editable_cell { Line 1320  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 1310  sub html_editable_cell { Line 1343  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 1356  sub output_options { Line 1389  sub output_options {
               description => 'HTML'},                description => 'HTML'},
              {value       => 'excel',               {value       => 'excel',
               description => 'Excel'},                description => 'Excel'},
   #             {value       => 'xml',
   #              description => 'XML'},
              {value       => 'csv',               {value       => 'csv',
               description => 'Comma Separated Values'},);                description => 'Comma Separated Values'},);
 }  }
Line 1551  sub outsheet_xml   { Line 1586  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 1588  sub parse_sheet { Line 1626  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 1643  sub load { Line 1680  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));
Removed from v.1.32  
changed lines
  Added in v.1.39

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