[BACK]Return to lonplot.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonplot.pm between versions 1.10 and 1.11

version 1.10, 2001/12/20 19:20:43 version 1.11, 2001/12/20 20:24:36
Line 67  sub BEGIN { Line 67  sub BEGIN {
 ##  ##
 ## Tests used in checking the validitity of input  ## Tests used in checking the validitity of input
 ##  ##
 my $int_test       = sub {$_[0]=~/^\d+$/};  my $int_test       = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
 my $real_test      = sub {$_[0]=~/^[+-]?\d*\.?\d*$/};  my $real_test      = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*$/};
 my $color_test     = sub {$_[0]=~/^x[\da-f]{6}$/};  my $color_test     = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
 my $onoff_test     = sub {$_[0]=~/^(on|off)$/};  my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
 my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};  my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/};
 my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};  my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
 my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};  my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
 my $words_test     = sub {$_[0]=~/^(\w+ *)+$/};  my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^(\w+ ?)+$/};
 ##  ##
 ## Default values for attributes of elements  ## Default values for attributes of elements
 ##  ##
Line 108  my %label_defaults = Line 108  my %label_defaults =
 my %axis_defaults =   my %axis_defaults = 
     (      (
      color     => {default => 'x000000', test => $color_test},       color     => {default => 'x000000', test => $color_test},
      xmin      => {default => -10.0,     test => $real_test },       xmin      => {default => '-10.0',   test => $real_test },
      xmax      => {default =>  10.0,     test => $real_test },       xmax      => {default => ' 10.0',   test => $real_test },
      ymin      => {default => -10.0,     test => $real_test },       ymin      => {default => '-10.0',   test => $real_test },
      ymax      => {default =>  10.0,     test => $real_test }       ymax      => {default => ' 10.0',   test => $real_test }
      );       );
   
 my %curve_defaults =   my %curve_defaults = 
     (      (
      color     => {default => 'x000000', test => $color_test             },       color     => {default => 'x000000', test => $color_test             },
      name      => {default => 'x000000', test => sub {$_[0]=~/^[\w ]*$/} },       name      => {default => 'x000000', test => sub {1} },#sub {$_[0]=~/^[\w ]*$/} },
      linestyle => {default => 'lines',   test => $linestyle_test         }       linestyle => {default => 'lines',   test => $linestyle_test         }
      );       );
   
Line 141  sub start_plot { Line 141  sub start_plot {
     $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);      $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
     &Apache::lonxml::newparser($parser,\$inside);      &Apache::lonxml::newparser($parser,\$inside);
     ##-------------------------------------------------------      ##-------------------------------------------------------
     &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,$tagstack);      &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
     if ($target eq 'web') {      if ($target eq 'web') {
     }      }
     return '';      return '';
Line 160  sub end_plot { Line 161  sub end_plot {
  my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.   my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
     '_plot.data';      '_plot.data';
  my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});   my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});
 # my $usersees=$filename.'_'.$ENV{'REMOTE_ADDR'};  
   
  ## Write the plot description to the file   ## Write the plot description to the file
  my $fh=Apache::File->new('/home/httpd/perl/tmp/'.$filename);   my $fh=Apache::File->new('/home/httpd/perl/tmp/'.$filename);
  $result .= '<pre>';   $result .= '<pre>';
  $result .= &write_gnuplot_file($fh);   $result .= &write_gnuplot_file($fh);
  $result .= '</pre>';   $result .= '</pre>'.$/;
  ## return image tag for the plot   ## return image tag for the plot
 # $result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';   $result .= '<img src="/cgi-bin/plot.cgi?'.$usersees.'"/>';
     }      }
     return $result;      return $result;
 }  }
Line 177  sub end_plot { Line 177  sub end_plot {
 sub start_key {  sub start_key {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,$tagstack);      &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.   # This routine should never return anything.
     }      }
Line 254  sub start_label { Line 255  sub start_label {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     my %label;      my %label;
     &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,$tagstack);      &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
     $label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);      $label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);
     if (! &$words_test($label{'text'})) {      if (! &$words_test($label{'text'})) {
  # I should probably warn about it, too.   # I should probably warn about it, too.
Line 281  sub start_curve { Line 283  sub start_curve {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     my %curve;      my %curve;
     &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,$tagstack);      &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
     push (@curves,\%curve);      push (@curves,\%curve);
     &Apache::lonxml::register('Apache::lonplot',('function','data'));      &Apache::lonxml::register('Apache::lonplot',('function','data'));
     push (@Apache::lonxml::namespace,'curve');      push (@Apache::lonxml::namespace,'curve');
Line 372  sub end_data { Line 375  sub end_data {
 sub start_axis {  sub start_axis {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,$tagstack);      &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval,
       $tagstack->[-1]);
     if ($target eq 'web') {      if ($target eq 'web') {
  # This routine should never return anything.   # This routine should never return anything.
     }      }
Line 400  sub get_attributes{ Line 404  sub get_attributes{
  $values->{$attr} =    $values->{$attr} = 
              &Apache::lonxml::get_param($attr,$parstack,$safeeval);               &Apache::lonxml::get_param($attr,$parstack,$safeeval);
  if ($values->{$attr} eq '' | !defined($values->{$attr})) {   if ($values->{$attr} eq '' | !defined($values->{$attr})) {
     $values->{$attr} = $defaults->{$attr};      $values->{$attr} = $defaults->{$attr}->{'default'};
     next;      next;
  }   }
  my $test = $defaults->{$attr}->{'test'};   my $test = $defaults->{$attr}->{'test'};
  if (! &$test($values->{$attr})) {   if (! &$test($values->{$attr})) {
     &Apache::lonxml::warning      &Apache::lonxml::warning
  ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '   ($tag.':'.$attr.': Bad value.'.'Replacing your value with : '
  .$defaults->{$attr} );   .$defaults->{$attr}->{'default'} );
     $values->{$attr} = $defaults->{$attr};      $values->{$attr} = $defaults->{$attr}->{'default'};
  }   }
  return ;  
     }      }
       return ;
 }  }
   
 sub write_gnuplot_file {  sub write_gnuplot_file {
Line 443  sub write_gnuplot_file { Line 447  sub write_gnuplot_file {
        'set noborder'.$/         );    # title, xlabel, ylabel         'set noborder'.$/         );    # title, xlabel, ylabel
     {      {
     $gnuplot_input .= <<"ENDLABELS";      $gnuplot_input .= <<"ENDLABELS";
 set output "-"  set output 
 set title  "$title"  set title  "$title"
 set xlabel "$xlabel"  set xlabel "$xlabel"
 set ylabel "$ylabel"  set ylabel "$ylabel"
Line 454  ENDLABELS Line 458  ENDLABELS
     # Key      # Key
     if (defined($key{'pos'})) {      if (defined($key{'pos'})) {
  $gnuplot_input .= 'set key '.$key{'pos'}.' ';   $gnuplot_input .= 'set key '.$key{'pos'}.' ';
  $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ');  
  if ($key{'title'} ne '') {   if ($key{'title'} ne '') {
     $gnuplot_input .= 'title "'.$key{'title'}.'"'.$/;      $gnuplot_input .= 'title "'.$key{'title'}.'" ';
  } else {   } 
     $gnuplot_input .= $/;   $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/;
  }  
     } else {      } else {
  $gnuplot_input .= 'set nokey'.$/;   $gnuplot_input .= 'set nokey'.$/;
     }          }    
Removed from v.1.10  
changed lines
  Added in v.1.11

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