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

version 1.10, 2001/12/20 19:20:43 version 1.13, 2001/12/21 15:27:29
Line 34  use Apache::File; Line 34  use Apache::File;
 use Apache::response;  use Apache::response;
 use Apache::lonxml;  use Apache::lonxml;
   
 use Digest::MD5  qw(md5 md5_hex md5_base64);  use Digest::MD5 qw(md5_base64);
   
 sub BEGIN {  sub BEGIN {
   &Apache::lonxml::register('Apache::lonplot',('plot'));    &Apache::lonxml::register('Apache::lonplot',('plot'));
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 => '',        test => $words_test     },
      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 154  sub end_plot { Line 155  sub end_plot {
  ('title','xlabel','ylabel','key','axis','label','curve'));   ('title','xlabel','ylabel','key','axis','label','curve'));
     my $result = '';      my $result = '';
     if ($target eq 'web') {      if ($target eq 'web') {
  ## Determine filename -- Need to use the 'id' thingy that Gerd    ##
  ## mentioned.   ## Make sure we have all the input we need:
    if (! defined(%plot  )) { &set_defaults(\%plot,\%plot_defaults); }
    if (! defined(%key   )) {} # No key for this plot 
    if (! defined(%axis  )) { &set_defaults(\%axis,\%axis_defaults); }
    if (! defined($title )) {} # No title for this plot 
    if (! defined($xlabel)) {} # No xlabel for this plot 
    if (! defined($ylabel)) {} # No ylabel for this plot 
    if ($#labels < 0) { } # No labels for this plot
    if ($#curves < 0) { } # This is an error
    ##
    ## Determine filename
  my $tmpdir = '/home/httpd/perl/tmp/';   my $tmpdir = '/home/httpd/perl/tmp/';
  my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.   my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
     '_plot.data';      '_'.time.'_'.$$.'_plot.data';
  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(">$tmpdir$filename");
  $result .= '<pre>';   $result .= '<pre>';
  $result .= &write_gnuplot_file($fh);   $result .= $filename.$/;
  $result .= '</pre>';   print $fh &write_gnuplot_file();
    $result .= '</pre>'.$/;
  ## return image tag for the plot   ## return image tag for the plot
 # $result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';   $result .= <<"ENDIMAGE";
   <img src = "/cgi-bin/plot.gif?$filename" 
        alt = "/cgi-bin/plot.gif?$filename" />
   ENDIMAGE
     }      }
     return $result;      return $result;
 }  }
Line 177  sub end_plot { Line 189  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 267  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 295  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 387  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 388  sub end_axis { Line 404  sub end_axis {
     return $result;      return $result;
 }  }
   
   ##----------------------------------------------------------- set_defaults
   sub set_defaults {
       my $var      = shift;
       my $defaults = shift;
       my $key;
       foreach $key (keys %$defaults) {
    $var->{$key} = $defaults->{$key}->{'default'};
       }
   }
   
 ##------------------------------------------------------------------- misc  ##------------------------------------------------------------------- misc
 sub get_attributes{  sub get_attributes{
     my $values   = shift;      my $values   = shift;
Line 400  sub get_attributes{ Line 426  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 {
     my $fh = shift;  
     my $gnuplot_input = '';      my $gnuplot_input = '';
     my $curve;      my $curve;
     # Collect all the colors      # Collect all the colors
     my @Colors;      my @Colors;
     push @Colors, $plot{'bgcolor'};      push @Colors, $plot{'bgcolor'};
     push @Colors, $plot{'fgcolor'};       push @Colors, $plot{'fgcolor'}; 
     push @Colors, $axis{'color'};      push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'});
     push @Colors, $axis{'color'};       push @Colors, $Colors[-1];  # Redundancy
     foreach $curve (@curves) {      foreach $curve (@curves) {
  push @Colors, ($curve->{'color'} ne '' ?    push @Colors, ($curve->{'color'} ne '' ? 
        $curve->{'color'}       :          $curve->{'color'}       : 
        $plot{'fgcolor'}      );         $plot{'fgcolor'}        );
     }      }
     # set term      # set term
     $gnuplot_input .= 'set term gif ';      $gnuplot_input .= 'set term gif ';
Line 441  sub write_gnuplot_file { Line 466  sub write_gnuplot_file {
     $gnuplot_input .= ($plot{'border'} eq 'on'?      $gnuplot_input .= ($plot{'border'} eq 'on'?
        'set border'.$/           :         'set border'.$/           :
        'set noborder'.$/         );    # title, xlabel, ylabel         'set noborder'.$/         );    # title, xlabel, ylabel
     {      $gnuplot_input .= "set output\n";
     $gnuplot_input .= <<"ENDLABELS";      $gnuplot_input .= "set title  \"$title\"\n"  if (defined($title)) ;
 set output "-"      $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel));
 set title  "$title"      $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel));
 set xlabel "$xlabel"      if (defined(%axis)) {
 set ylabel "$ylabel"   $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n";
 set xrange \[$axis{'xmin'}:$axis{'xmax'}\]   $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n";
 set yrange \[$axis{'ymin'}:$axis{'ymax'}\]  
 ENDLABELS  
     }      }
     # Key      # Key
     if (defined($key{'pos'})) {      if (defined(%key)) {
  $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'.$/;
     }          }
     # labels      # labels
     my $label;      my $label;
     foreach $label (@labels) {      foreach $label (@labels) {
Line 498  ENDLABELS Line 519  ENDLABELS
     }      }
     $gnuplot_input .= $/.$datatext;      $gnuplot_input .= $/.$datatext;
     return $gnuplot_input;      return $gnuplot_input;
 #    print $fh $gnuplot_input;  
 }  }
   
 1;  1;
Removed from v.1.10  
changed lines
  Added in v.1.13

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