--- loncom/xml/lonplot.pm 2001/12/18 15:33:47 1.2 +++ loncom/xml/lonplot.pm 2001/12/18 22:29:42 1.5 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Dynamic plot # -# $Id: lonplot.pm,v 1.2 2001/12/18 15:33:47 matthew Exp $ +# $Id: lonplot.pm,v 1.5 2001/12/18 22:29:42 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,7 +25,8 @@ # # http://www.lon-capa.org/ # -# 2/21 Guy +# 12/15/01 Matthew +# 12/18 Matthew package Apache::lonplot; use strict; use Apache::response; @@ -47,7 +48,7 @@ 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*)+$/}; ## ## Default values for attributes of elements ## @@ -55,33 +56,33 @@ 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 } + 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 => "on" , test => $onoff_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 }, - color => {default => "x000000", test => $color_test }, - justify => {default => "left", + color => {default => 'x000000', test => $color_test }, + justify => {default => 'left', test => sub {$_[0]=~/^(left|right|center)$/}} ); my %axis_defaults = ( - color => {default => "x000000", test => $color_test}, + 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 }, @@ -91,9 +92,9 @@ my %axis_defaults = 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 => 'x000000', test => sub {$_[0]=~/^[\w ]*$/} }, + linestyle => {default => 'lines', test => $linestyle_test } ); ## @@ -111,36 +112,42 @@ sub start_plot { &Apache::lonxml::register('Apache::plot', ('title','xlabel','ylabel','key','axis','label','curve')); push (@Apache::lonxml::namespace,'plot'); - ##------------------------------------------------------- - ## How do I do this? I need to "eval" and I need to keep the info - ## available for the parser. - ## + ## Always evaluate the insides of the tags my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]); - my $eval=&Apache::lonxml::get_param('eval',$parstack,$safeeval); - if ($eval eq 'on') { - $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); - #&Apache::lonxml::debug("M is evaulated to:$inside:"); - } + $inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]); + &Apache::lonxml::newparser($parser,\$inside); ##------------------------------------------------------- &get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot'); + if ($target eq 'web') { + } return ''; } sub end_plot { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; pop @Apache::lonxml::namespace; - my $result; - ## 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'}); - - ## Write the plot description to the file - my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname); - ## Ack! - ## return image tag for the plot - $result = 'new('/home/httpd/perl/tmp/'.$realname); + # write plot values + # write title, xlabel, ylabel + # write key values + # write axis values + # write label values + # write curve values + ## Ack! + ## return image tag for the plot + $result = '{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]); - push(@labels,$label); + push(@labels,\%label); + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } sub end_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } @@ -217,19 +254,25 @@ sub end_label { sub start_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - my $curve = &newhashref(); - &get_attributes($curve,\%curve_defaults,$parstack,$safeeval,'curve'); + my %curve; + &get_attributes($curve,\%curve_defaults,$parstack,$safeeval,$tagstack); push (@curves,$curve); - - &Apache::lonxml::register('Apache::plot',('function','data')); + &Apache::lonxml::register('Apache::lonplot',('function','data')); push (@Apache::lonxml::namespace,'curve'); - + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } sub end_curve { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; + pop @Apache::lonxml::namespace; + &Apache::lonxml::deregister('Apache::lonplot',('function','data')); + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } @@ -237,15 +280,24 @@ sub end_curve { sub start_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - + 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'}); + } $curves[-1]->{'function'} = &Apache::lonxml::get_all_text("/function",$$parser[-1]); + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } sub end_function { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } @@ -253,14 +305,30 @@ sub end_function { sub start_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - push( @{$curves[-1]->{'data'}}, - &Apache::lonxml::get_all_text("/data",$$parser[-1])); + if (exists($curves[-1]->{'function'})) { + &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; + if ($datatext !~ /^(([+-]?\d*\.?\d*)[, ]?)+$/) { + &Apache::lonxml::warning('Malformed data: '.$datatext); + $datatext = ''; + } + push( @{$curves[-1]->{'data'}},$datatext; + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } sub end_data { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } @@ -268,22 +336,23 @@ sub end_data { sub start_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,'axis'); + &get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,$tagstack); + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } sub end_axis { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result = ''; + if ($target eq 'web') { + # This routine should never return anything. + } return $result; } ##------------------------------------------------------------------- misc -sub newhashref{ - my %hash; - return \%hash; -} - sub get_attributes{ %values = %{shift}; %defaults = %{shift}; @@ -303,3 +372,8 @@ sub get_attributes{ 1; __END__ + + + + +