--- loncom/xml/lonplot.pm 2001/12/19 22:14:20 1.9 +++ loncom/xml/lonplot.pm 2001/12/20 19:20:43 1.10 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Dynamic plot # -# $Id: lonplot.pm,v 1.9 2001/12/19 22:14:20 matthew Exp $ +# $Id: lonplot.pm,v 1.10 2001/12/20 19:20:43 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,17 +26,44 @@ # http://www.lon-capa.org/ # # 12/15/01 Matthew -# 12/18 Matthew +# 12/18 12/19 12/20 Matthew package Apache::lonplot; + use strict; +use Apache::File; use Apache::response; use Apache::lonxml; + use Digest::MD5 qw(md5 md5_hex md5_base64); sub BEGIN { &Apache::lonxml::register('Apache::lonplot',('plot')); } +## +## Description of data structures: +## +## %plot %key %axis +## -------------------------- +## height title color +## width box xmin +## bgcolor pos xmax +## fgcolor ymin +## transparent ymax +## grid +## border +## font +## +## @labels: $labels[$i] = \%label +## %label: text, xpos, ypos, justify +## +## @curves: $curves[$i] = \%curve +## %curve: name, linestyle, ( function | data ) +## +## $curves[$i]->{'data'} = [ [x1,x2,x3,x4], +## [y1,y2,y3,y4] ] +## +##------------------------------------------------------------ ## ## Tests used in checking the validitity of input ## @@ -47,41 +74,40 @@ my $onoff_test = sub {$_[0]=~/^(on|o 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+\b*)+$/}; +my $words_test = sub {$_[0]=~/^(\w+ *)+$/}; ## ## Default values for attributes of elements ## my %plot_defaults = ( - height => {default => 200, test => $int_test }, - width => {default => 200, test => $int_test }, - bgcolor => {default => 'xffffff', test => $color_test}, - fgcolor => {default => 'x000000', test => $color_test}, - transparent => {default => 'off', test => $onoff_test}, - grid => {default => 'off', test => $onoff_test}, - border => {default => 'on', test => $onoff_test}, - font => {default => 'medium', test => $sml_test } + height => {default => 200, test => $int_test }, + width => {default => 200, test => $int_test }, + bgcolor => {default => 'xffffff', test => $color_test }, + fgcolor => {default => 'x000000', test => $color_test }, + transparent => {default => 'off', test => $onoff_test }, + grid => {default => 'off', test => $onoff_test }, + border => {default => 'on', test => $onoff_test }, + font => {default => 'medium', test => $sml_test } ); my %key_defaults = ( - title => { default => '', test => $words_test }, - box => { default => 'off', test => $onoff_test }, - pos => { default => 'top right', test => $key_pos_test} + title => { default => '', test => $words_test }, + box => { default => 'off', test => $onoff_test }, + pos => { default => 'top right', test => $key_pos_test } ); my %label_defaults = ( - xpos => {default => 0, test => $real_test }, - ypos => {default => 0, test => $real_test }, + xpos => {default => 0, test => $real_test }, + ypos => {default => 0, test => $real_test }, justify => {default => 'left', - test => sub {$_[0]=~/^(left|right|center)$/}} + test => sub {$_[0]=~/^(left|right|center)$/} } ); my %axis_defaults = ( color => {default => 'x000000', test => $color_test}, -# thickness => {default => 1, test => $int_test }, xmin => {default => -10.0, test => $real_test }, xmax => {default => 10.0, test => $real_test }, ymin => {default => -10.0, test => $real_test }, @@ -90,9 +116,9 @@ my %axis_defaults = my %curve_defaults = ( - color => {default => 'x000000', test => $color_test }, + color => {default => 'x000000', test => $color_test }, name => {default => 'x000000', test => sub {$_[0]=~/^[\w ]*$/} }, - linestyle => {default => 'lines', test => $linestyle_test } + linestyle => {default => 'lines', test => $linestyle_test } ); ## @@ -101,13 +127,13 @@ my %curve_defaults = my (%plot,%key,%axis,$title,$xlabel,$ylabel,@labels,@curves); sub start_plot { - %plot = ''; %key=''; %axis=''; - $title=''; $xlabel=''; $ylabel=''; - @labels = ''; @curves=''; + %plot = undef; %key = undef; %axis = undef; + $title = undef; $xlabel = undef; $ylabel = undef; + $#labels = -1; $#curves = -1; # my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - &Apache::lonxml::register('Apache::plot', + &Apache::lonxml::register('Apache::lonplot', ('title','xlabel','ylabel','key','axis','label','curve')); push (@Apache::lonxml::namespace,'plot'); ## Always evaluate the insides of the tags @@ -115,7 +141,7 @@ sub start_plot { $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); &Apache::lonxml::newparser($parser,\$inside); ##------------------------------------------------------- - &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot'); + &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,$tagstack); if ($target eq 'web') { } return ''; @@ -134,12 +160,15 @@ sub end_plot { 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'}; ## Write the plot description to the file - my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname); - &write_gnuplot_file($fh); + my $fh=Apache::File->new('/home/httpd/perl/tmp/'.$filename); + $result .= '
';
+	$result .= &write_gnuplot_file($fh);
+	$result .= '
'; ## return image tag for the plot - $result = '{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]); + &get_attributes(\%label,\%label_defaults,$parstack,$safeeval,$tagstack); + $label{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]); + if (! &$words_test($label{'text'})) { + # I should probably warn about it, too. + $label{'text'} = 'Illegal text'; + } push(@labels,\%label); if ($target eq 'web') { # This routine should never return anything. @@ -248,8 +281,8 @@ sub start_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my %curve; - &get_attributes($curve,\%curve_defaults,$parstack,$safeeval,$tagstack); - push (@curves,$curve); + &get_attributes(\%curve,\%curve_defaults,$parstack,$safeeval,$tagstack); + push (@curves,\%curve); &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); if ($target eq 'web') { @@ -272,9 +305,9 @@ sub end_curve { sub start_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - if (exists($curves[-1]->{'data'}) { + if (exists($curves[-1]->{'data'})) { &Apache::lonxml::warning('Use of precludes use of . The will be omitted in favor of the declaration.'); - delete($curves[-1]->{'data'}); + delete $curves[-1]->{'data'} ; } $curves[-1]->{'function'} = &Apache::lonxml::get_all_text("/function",$$parser[-1]); @@ -297,12 +330,14 @@ sub start_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if (exists($curves[-1]->{'function'})) { - &Apache::lonxml::warning('Use of precludes use of . The will be omitted in favor of the declaration.'); + &Apache::lonxml::warning('Use of precludes use of .'. + ' The will be omitted in favor of the '. + ' declaration.'); delete($curves[-1]->{'function'}); } my $datatext = &Apache::lonxml::get_all_text("/data",$$parser[-1]); - $datatext =~ s/(\s+$|^\s+)//g; - $datatext =~ s/\s+/ /g; + $datatext =~ s/\s+//g; # No whitespace, numbers must be seperated + # by commas if ($datatext !~ /^(([+-]?\d*\.?\d*)[, ]?)+$/) { &Apache::lonxml::warning('Malformed data: '.$datatext); $datatext = ''; @@ -310,8 +345,14 @@ sub start_data { # Need to do some error checking on the @data array - # make sure it's all numbers and make sure each array # is of the same length. - my @data = split /[, ]/,$datatext; - push( @{$curves[-1]->{'data'}},\@data; + my @data = split /,/,$datatext; + for (my $i=0;$i<=$#data;$i++) { + # Check that it's non-empty + # Check that it's a number + # Maybe I need a 'debug=on' switch to list the data set + # out in a warning? + } + push @{$curves[-1]->{'data'}},\@data; if ($target eq 'web') { # This routine should never return anything. } @@ -349,31 +390,34 @@ sub end_axis { ##------------------------------------------------------------------- misc sub get_attributes{ - %values = %{shift}; - %defaults = %{shift}; - $parstack = shift; - $safeeval = shift; - $tag = shift; + my $values = shift; + my $defaults = shift; + my $parstack = shift; + my $safeeval = shift; + my $tag = shift; my $attr; - foreach $attr (keys %defaults) { - $values{$attr} = &Apache::lonxml::get_param($attr,$parstack,$safeeval); - if ($values{$attr} eq '' | !defined($values{$attr})) { - $values{$attr} = $defaults{$attr}; + foreach $attr (keys %{$defaults}) { + $values->{$attr} = + &Apache::lonxml::get_param($attr,$parstack,$safeeval); + if ($values->{$attr} eq '' | !defined($values->{$attr})) { + $values->{$attr} = $defaults->{$attr}; next; } - my $test = $defaults{$attr}->{'test'}; - if (! &$test($values{$attr})) { + 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} ); + $values->{$attr} = $defaults->{$attr}; + } + return ; } - return ; } sub write_gnuplot_file { my $fh = shift; my $gnuplot_input = ''; + my $curve; # Collect all the colors my @Colors; push @Colors, $plot{'bgcolor'}; @@ -389,20 +433,17 @@ sub write_gnuplot_file { $gnuplot_input .= 'set term gif '; $gnuplot_input .= 'transparent ' if ($plot{'transparent'} eq 'on'); $gnuplot_input .= $plot{'font'} . ' '; - $gnuplot_input .= 'size ' . $plot{'width'} . ','; - $gnuplot_input .= $plot{'height'} . ' '; + $gnuplot_input .= 'size '.$plot{'width'}.','.$plot{'height'}.' '; $gnuplot_input .= "@Colors\n"; # grid - $gnuplot_input .= ($plot{'grid'} eq 'on' ? - 'set grid'.$/ : - '' ); + $gnuplot_input .= 'set grid'.$/ if ($plot{'grid'} eq 'on'); # border $gnuplot_input .= ($plot{'border'} eq 'on'? 'set border'.$/ : 'set noborder'.$/ ); # title, xlabel, ylabel { $gnuplot_input .= <<"ENDLABELS"; -set output "tmp.gif" +set output "-" set title "$title" set xlabel "$xlabel" set ylabel "$ylabel" @@ -423,6 +464,7 @@ ENDLABELS $gnuplot_input .= 'set nokey'.$/; } # labels + my $label; foreach $label (@labels) { $gnuplot_input .= 'set label "'.$label->{'text'}.'" at '. $label->{'xpos'}.','.$label->{'ypos'}.' '.$label->{'justify'}.$/ ; @@ -445,6 +487,7 @@ ENDLABELS my @Data = @{$curve->{'data'}}; my @Data0 = @{$Data[0]}; for (my $i =0; $i<=$#Data0; $i++) { + my $dataset; foreach $dataset (@Data) { $datatext .= $dataset->[$i] . ' '; } @@ -454,7 +497,8 @@ ENDLABELS } } $gnuplot_input .= $/.$datatext; - print $fh $gnuplot_input; + return $gnuplot_input; +# print $fh $gnuplot_input; } 1;