loncom/xml/lonplot.pm - diff

Return to lonplot.pm CVS log

Up to [LON-CAPA] / loncom / xml

Diff for /loncom/xml/lonplot.pm between versions 1.2 and 1.5

version 1.2, 2001/12/18 15:33:47	version 1.5, 2001/12/18 22:29:42
Line 25	Line 25
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# 2/21 Guy	# 12/15/01 Matthew
	# 12/18 Matthew
package Apache::lonplot;	package Apache::lonplot;
use strict;	use strict;
use Apache::response;	use Apache::response;
Line 47 my $onoff_test = sub {$_[0]=~/^(on\|o	Line 48 my $onoff_test = sub {$_[0]=~/^(on\|o
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+\b*)+$/};
##	##
## Default values for attributes of elements	## Default values for attributes of elements
##	##
Line 55 my %plot_defaults =	Line 56 my %plot_defaults =
(	(
height => {default => 200, test => $int_test },	height => {default => 200, test => $int_test },
width => {default => 200, test => $int_test },	width => {default => 200, test => $int_test },
bgcolor => {default => "xffffff", test => $color_test},	bgcolor => {default => 'xffffff', test => $color_test},
fgcolor => {default => "x000000", test => $color_test},	fgcolor => {default => 'x000000', test => $color_test},
transparent => {default => "off", test => $onoff_test},	transparent => {default => 'off', test => $onoff_test},
grid => {default => "off", test => $onoff_test},	grid => {default => 'off', test => $onoff_test},
border => {default => "on" , test => $onoff_test},	border => {default => 'on', test => $onoff_test},
font => {default => "medium", test => $sml_test }	font => {default => 'medium', test => $sml_test }
);	);

my %key_defaults =	my %key_defaults =
(	(
title => { default => "on" , test => $onoff_test },	title => { default => '', test => $words_test },
box => { default => "off" , test => $onoff_test },	box => { default => 'off', test => $onoff_test },
pos => { default => "top right" , test => $key_pos_test}	pos => { default => 'top right', test => $key_pos_test}
);	);

my %label_defaults =	my %label_defaults =
(	(
xpos => {default => 0, test => $real_test },	xpos => {default => 0, test => $real_test },
ypos => {default => 0, test => $real_test },	ypos => {default => 0, test => $real_test },
color => {default => "x000000", test => $color_test },	color => {default => 'x000000', test => $color_test },
justify => {default => "left",	justify => {default => 'left',
test => sub {$_[0]=~/^(left\|right\|center)$/}}	test => sub {$_[0]=~/^(left\|right\|center)$/}}
);	);

my %axis_defaults =	my %axis_defaults =
(	(
color => {default => "x000000", test => $color_test},	color => {default => 'x000000', test => $color_test},
thickness => {default => 1, test => $int_test },	thickness => {default => 1, test => $int_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 },
Line 91 my %axis_defaults =	Line 92 my %axis_defaults =

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 {$_[0]=~/^[\w ]*$/} },
linestyle => {default => "lines", test => $linestyle_test }	linestyle => {default => 'lines', test => $linestyle_test }
);	);

##	##
Line 111 sub start_plot {	Line 112 sub start_plot {
&Apache::lonxml::register('Apache::plot',	&Apache::lonxml::register('Apache::plot',
('title','xlabel','ylabel','key','axis','label','curve'));	('title','xlabel','ylabel','key','axis','label','curve'));
push (@Apache::lonxml::namespace,'plot');	push (@Apache::lonxml::namespace,'plot');
##-------------------------------------------------------	## Always evaluate the insides of the <plot></plot> tags
## How do I do this? I need to "eval" and I need to keep the info
## available for the parser.
##
my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);	my $inside = &Apache::lonxml::get_all_text("/plot",$$parser[-1]);
my $eval=&Apache::lonxml::get_param('eval',$parstack,$safeeval);	$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
if ($eval eq 'on') {	&Apache::lonxml::newparser($parser,\$inside);
$inside=&Apache::run::evaluate($inside,$safeeval,$$parstack[-1]);
#&Apache::lonxml::debug("M is evaulated to:$inside:");
}
##-------------------------------------------------------	##-------------------------------------------------------
&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot');	&get_attributes(\%plot,\%plot_defaults,$parstack,$safeeval,'plot');
	if ($target eq 'web') {
	}
return '';	return '';
}	}

sub end_plot {	sub end_plot {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
pop @Apache::lonxml::namespace;	pop @Apache::lonxml::namespace;
my $result;	&Apache::lonxml::deregister('Apache::lonplot',
## Determine filename	('title','xlabel','ylabel','key','axis','label','curve'));
my $tmpdir = '/home/httpd/perl/tmp/';	my $result = '';
my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.	if ($target eq 'web') {
'_plot.data';	## Determine filename -- may need a better way later
my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});	my $tmpdir = '/home/httpd/perl/tmp/';
	my $filename = $tmpdir.$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
## Write the plot description to the file	'_plot.data';
my $fh=&Apache::File->new('/home/httpd/perl/tmp/'.$realname);	my $usersees=md5_base64($filename.'_'.$ENV{'REMOTE_ADDR'});
## Ack!
## return image tag for the plot	## Write the plot description to the file
$result = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';	my $fh=&Apache::File->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 = '<img src=\"/cgi-bin/plot.cgi?'.$usersees.'"';
	}
return $result;	return $result;
}	}

Line 148 sub end_plot {	Line 155 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,'key');	&get_attributes(\%key,\%key_defaults,$parstack,$safeeval,$tagstack);
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_key {	sub end_key {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}
##------------------------------------------------------------------- title	##------------------------------------------------------------------- title
Line 162 sub start_title {	Line 175 sub start_title {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);	$title = &Apache::lonxml::get_all_text("/title",$$parser[-1]);
my $result='';	my $result='';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_title {	sub end_title {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}
##------------------------------------------------------------------- xlabel	##------------------------------------------------------------------- xlabel
Line 175 sub start_xlabel {	Line 194 sub start_xlabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';	my $result='';
$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);	$xlabel = &Apache::lonxml::get_all_text("/xlabel",$$parser[-1]);
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_xlabel {	sub end_xlabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}
##------------------------------------------------------------------- ylabel	##------------------------------------------------------------------- ylabel
Line 188 sub start_ylabel {	Line 213 sub start_ylabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';	my $result='';
$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);	$ylabel = &Apache::lonxml::get_all_text("/ylabel",$$parser[-1]);
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_ylabel {	sub end_ylabel {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}
##------------------------------------------------------------------- label	##------------------------------------------------------------------- label
sub start_label {	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 = &newhashref();	my %label;
&get_attributes($label,\%label_defaults,$parstack,$safeeval,'label');	&get_attributes($label,\%label_defaults,$parstack,$safeeval,$tagstack);
$label->{'text'} = &Apache::lonxml::get_all_text("/label",$$parser[-1]);	$label->{'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;	return $result;
}	}

sub end_label {	sub end_label {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

Line 217 sub end_label {	Line 254 sub end_label {
sub start_curve {	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 = &newhashref();	my %curve;
&get_attributes($curve,\%curve_defaults,$parstack,$safeeval,'curve');	&get_attributes($curve,\%curve_defaults,$parstack,$safeeval,$tagstack);
push (@curves,$curve);	push (@curves,$curve);
	&Apache::lonxml::register('Apache::lonplot',('function','data'));
&Apache::lonxml::register('Apache::plot',('function','data'));
push (@Apache::lonxml::namespace,'curve');	push (@Apache::lonxml::namespace,'curve');
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_curve {	sub end_curve {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	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;	return $result;
}	}

Line 237 sub end_curve {	Line 280 sub end_curve {
sub start_function {	sub start_function {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';	my $result='';
	if (exists($curves[-1]->{'data'}) {
	&Apache::lonxml::warning('Use of <function> precludes use of <data>. The <data> will be omitted in favor of the <function> declaration.');
	delete($curves[-1]->{'data'});
	}
$curves[-1]->{'function'} =	$curves[-1]->{'function'} =
&Apache::lonxml::get_all_text("/function",$$parser[-1]);	&Apache::lonxml::get_all_text("/function",$$parser[-1]);
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_function {	sub end_function {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

Line 253 sub end_function {	Line 305 sub end_function {
sub start_data {	sub start_data {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result='';	my $result='';
push( @{$curves[-1]->{'data'}},	if (exists($curves[-1]->{'function'})) {
&Apache::lonxml::get_all_text("/data",$$parser[-1]));	&Apache::lonxml::warning('Use of <data> precludes use of <function>. The <function> will be omitted in favor of the <data> 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;	return $result;
}	}

sub end_data {	sub end_data {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

Line 268 sub end_data {	Line 336 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,'axis');	&get_attributes(\%axis,\%label_defaults,$parstack,$safeeval,$tagstack);
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

sub end_axis {	sub end_axis {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;	my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result = '';	my $result = '';
	if ($target eq 'web') {
	# This routine should never return anything.
	}
return $result;	return $result;
}	}

##------------------------------------------------------------------- misc	##------------------------------------------------------------------- misc
sub newhashref{
my %hash;
return \%hash;
}

sub get_attributes{	sub get_attributes{
%values = %{shift};	%values = %{shift};
%defaults = %{shift};	%defaults = %{shift};
Line 303 sub get_attributes{	Line 372 sub get_attributes{

1;	1;
__END__	__END__

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

Removed from v.1.2
changed lines
	Added in v.1.5