--- loncom/xml/lonplot.pm 2001/12/20 19:20:43 1.10 +++ loncom/xml/lonplot.pm 2001/12/21 16:59:01 1.14 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Dynamic plot # -# $Id: lonplot.pm,v 1.10 2001/12/20 19:20:43 matthew Exp $ +# $Id: lonplot.pm,v 1.14 2001/12/21 16:59:01 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,7 +26,7 @@ # http://www.lon-capa.org/ # # 12/15/01 Matthew -# 12/18 12/19 12/20 Matthew +# 12/17 12/18 12/19 12/20 12/21 Matthew package Apache::lonplot; use strict; @@ -34,7 +34,7 @@ use Apache::File; use Apache::response; use Apache::lonxml; -use Digest::MD5 qw(md5 md5_hex md5_base64); +use Digest::MD5 qw(md5_base64); sub BEGIN { &Apache::lonxml::register('Apache::lonplot',('plot')); @@ -56,9 +56,9 @@ sub BEGIN { ## ## @labels: $labels[$i] = \%label ## %label: text, xpos, ypos, justify -## +## ## @curves: $curves[$i] = \%curve -## %curve: name, linestyle, ( function | data ) +## %curve: name, linestyle, ( function | data ) ## ## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], ## [y1,y2,y3,y4] ] @@ -67,14 +67,14 @@ sub BEGIN { ## ## Tests used in checking the validitity of input ## -my $int_test = sub {$_[0]=~/^\d+$/}; -my $real_test = sub {$_[0]=~/^[+-]?\d*\.?\d*$/}; -my $color_test = sub {$_[0]=~/^x[\da-f]{6}$/}; +my $int_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/}; +my $real_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*$/}; +my $color_test = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/}; my $onoff_test = sub {$_[0]=~/^(on|off)$/}; my $key_pos_test = sub {$_[0]=~/^(top|bottom|right|left|outside|below)+$/}; my $sml_test = sub {$_[0]=~/^(small|medium|large)$/}; 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 ## @@ -108,17 +108,17 @@ my %label_defaults = my %axis_defaults = ( color => {default => 'x000000', test => $color_test}, - xmin => {default => -10.0, test => $real_test }, - xmax => {default => 10.0, test => $real_test }, - ymin => {default => -10.0, test => $real_test }, - ymax => {default => 10.0, test => $real_test } + xmin => {default => '-10.0', test => $real_test }, + xmax => {default => ' 10.0', test => $real_test }, + ymin => {default => '-10.0', test => $real_test }, + ymax => {default => ' 10.0', test => $real_test } ); my %curve_defaults = ( - color => {default => 'x000000', test => $color_test }, - name => {default => 'x000000', test => sub {$_[0]=~/^[\w ]*$/} }, - linestyle => {default => 'lines', test => $linestyle_test } + color => {default => 'x000000', test => $color_test }, + name => {default => '', test => $words_test }, + linestyle => {default => 'lines', test => $linestyle_test } ); ## @@ -141,7 +141,8 @@ sub start_plot { $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); &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') { } return ''; @@ -154,21 +155,40 @@ sub end_plot { ('title','xlabel','ylabel','key','axis','label','curve')); my $result = ''; 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) { + &Apache::lonxml::warning("No curves specified for plot!!!!"); + return ''; + } + my $curve; + foreach $curve (@curves) { + if (!defined($curve->{'function'})&&!defined($curve->{'data'})){ + &Apache::lonxml::warning("One of the curves specified did not contain any or declarations\n"); + return ''; + } + } + ## + ## Determine filename my $tmpdir = '/home/httpd/perl/tmp/'; - my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}. - '_plot.data'; - my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'}); -# my $usersees=$filename.'_'.$ENV{'REMOTE_ADDR'}; - + my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}. + '_'.time.'_'.$$.'_plot.data'; ## Write the plot description to the file - my $fh=Apache::File->new('/home/httpd/perl/tmp/'.$filename); - $result .= '
';
-	$result .= &write_gnuplot_file($fh);
-	$result .= '
'; + my $fh=Apache::File->new(">$tmpdir$filename"); + print $fh &write_gnuplot_file(); + close($fh); ## return image tag for the plot -# $result = '/cgi-bin/plot.gif?$filename +ENDIMAGE } return $result; } @@ -177,7 +197,8 @@ sub end_plot { sub start_key { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - &get_attributes(\%key,\%key_defaults,$parstack,$safeeval,$tagstack); + &get_attributes(\%key,\%key_defaults,$parstack,$safeeval, + $tagstack->[-1]); if ($target eq 'web') { # This routine should never return anything. } @@ -254,7 +275,8 @@ sub start_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; 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]); if (! &$words_test($label{'text'})) { # I should probably warn about it, too. @@ -281,7 +303,8 @@ sub start_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my %curve; - &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,$tagstack); + &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval, + $tagstack->[-1]); push (@curves,\%curve); &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); @@ -372,7 +395,8 @@ sub end_data { sub start_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,$tagstack); + &get_attributes(\%axis,\%axis_defaults,$parstack,$safeeval, + $tagstack->[-1]); if ($target eq 'web') { # This routine should never return anything. } @@ -388,6 +412,16 @@ sub end_axis { 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 sub get_attributes{ my $values = shift; @@ -400,34 +434,33 @@ sub get_attributes{ $values->{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval); if ($values->{$attr} eq '' | !defined($values->{$attr})) { - $values->{$attr} = $defaults->{$attr}; + $values->{$attr} = $defaults->{$attr}->{'default'}; next; } my $test = $defaults->{$attr}->{'test'}; if (! &$test($values->{$attr})) { &Apache::lonxml::warning ($tag.':'.$attr.': Bad value.'.'Replacing your value with : ' - .$defaults->{$attr} ); - $values->{$attr} = $defaults->{$attr}; + .$defaults->{$attr}->{'default'} ); + $values->{$attr} = $defaults->{$attr}->{'default'}; } - return ; } + return ; } sub write_gnuplot_file { - my $fh = shift; my $gnuplot_input = ''; my $curve; # Collect all the colors my @Colors; push @Colors, $plot{'bgcolor'}; push @Colors, $plot{'fgcolor'}; - push @Colors, $axis{'color'}; - push @Colors, $axis{'color'}; + push @Colors, (defined($axis{'color'})?$axis{'color'}:$plot{'fgcolor'}); + push @Colors, $Colors[-1]; # Redundancy foreach $curve (@curves) { push @Colors, ($curve->{'color'} ne '' ? $curve->{'color'} : - $plot{'fgcolor'} ); + $plot{'fgcolor'} ); } # set term $gnuplot_input .= 'set term gif '; @@ -441,28 +474,24 @@ sub write_gnuplot_file { $gnuplot_input .= ($plot{'border'} eq 'on'? 'set border'.$/ : 'set noborder'.$/ ); # title, xlabel, ylabel - { - $gnuplot_input .= <<"ENDLABELS"; -set output "-" -set title "$title" -set xlabel "$xlabel" -set ylabel "$ylabel" -set xrange \[$axis{'xmin'}:$axis{'xmax'}\] -set yrange \[$axis{'ymin'}:$axis{'ymax'}\] -ENDLABELS + $gnuplot_input .= "set output\n"; + $gnuplot_input .= "set title \"$title\"\n" if (defined($title)) ; + $gnuplot_input .= "set xlabel \"$xlabel\"\n" if (defined($xlabel)); + $gnuplot_input .= "set ylabel \"$ylabel\"\n" if (defined($ylabel)); + if (defined(%axis)) { + $gnuplot_input .= "set xrange \[$axis{'xmin'}:$axis{'xmax'}\]\n"; + $gnuplot_input .= "set yrange \[$axis{'ymin'}:$axis{'ymax'}\]\n"; } # Key - if (defined($key{'pos'})) { + if (defined(%key)) { $gnuplot_input .= 'set key '.$key{'pos'}.' '; - $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox '); if ($key{'title'} ne '') { - $gnuplot_input .= 'title "'.$key{'title'}.'"'.$/; - } else { - $gnuplot_input .= $/; - } + $gnuplot_input .= 'title "'.$key{'title'}.'" '; + } + $gnuplot_input .= ($key{'box'} eq 'on' ? 'box ' : 'nobox ').$/; } else { $gnuplot_input .= 'set nokey'.$/; - } + } # labels my $label; foreach $label (@labels) { @@ -498,7 +527,6 @@ ENDLABELS } $gnuplot_input .= $/.$datatext; return $gnuplot_input; -# print $fh $gnuplot_input; } 1;