view release on metacpan or  search on metacpan

Chart.pm  view on Meta::CPAN

'X_ORIENT', 1,
'FORMAT', 1,
'LOGO', 1,
'X-LOG', 1,
'Y-LOG', 1,
'3-D', 1,
'Y-MAX', 1,
'Y-MIN', 1,
'X_LOG', 1,
'Y_LOG', 1,
'THREE_D', 1,
'Y_MAX', 1,
'Y_MIN', 1,
'ICON', 1,
'ICONS', 1,
'FONT', 1,
'TEMPLATE', 1,
'GRIDCOLOR', 1,
'TEXTCOLOR', 1,
'MAPURL', 1,
'MAPSCRIPT', 1,
'MAPNAME', 1,
'MAPTYPE', 1,
'CUMULATIVE', 1,
'STACK', 1,
'LINEWIDTH', 1,
'ANCHORED', 1,
'BORDER', 1
);

our %valid_colors = (
	white	=> [255,255,255],
	lgray	=> [191,191,191],
	gray	=> [127,127,127],
	dgray	=> [63,63,63],
	black	=> [0,0,0],
	lblue	=> [0,0,255],
	blue	=> [0,0,191],
	dblue	=> [0,0,127],
	gold	=> [255,215,0],
	lyellow	=> [255,255,0],
	yellow	=> [191,191,0],
	dyellow	=> [127,127,0],
	lgreen	=> [0,255,0],
	green	=> [0,191,0],
	dgreen	=> [0,127,0],
	lred	=> [255,0,0],
	red		=> [191,0,0],
	dred	=> [127,0,0],
	lpurple	=> [255,0,255],
	purple	=> [191,0,191],
	dpurple	=> [127,0,127],
	lorange	=> [255,183,0],
	orange	=> [255,127,0],
	pink	=> [255,183,193],
	dpink	=> [255,105,180],
	marine	=> [127,127,255],
	cyan	=> [0,255,255],
	lbrown	=> [210,180,140],
	dbrown	=> [165,42,42],
	transparent => [1,1,1]
);

our @dfltcolors = qw( red green blue yellow purple orange
dblue cyan dgreen lbrown );

our %valid_shapes = (
'fillsquare', 1,
'opensquare', 2,
'horizcross', 3,
'diagcross', 4,
'filldiamond', 5,
'opendiamond', 6,
'fillcircle', 7,
'opencircle', 8,
'icon', 9,
'dot', 10);

{
package DBD::Chart;

use DBI;
use DBI qw(:sql_types);

# Do NOT @EXPORT anything.
$DBD::Chart::VERSION = '0.82';

$DBD::Chart::drh = undef;
$DBD::Chart::err = 0;
$DBD::Chart::errstr = '';
$DBD::Chart::state = '00000';
%DBD::Chart::charts = ();	# defined chart list;
							# hash of (name, property hash)
$DBD::Chart::seqno = 1;	# id for each CREATEd chart so we don't access
						# stale names

sub driver {
#
#	if we've already been init'd, don't do it again
#
	return $DBD::Chart::drh if $DBD::Chart::drh;
	my($class, $attr) = @_;
	$class .= '::dr';

	$DBD::Chart::drh = DBI::_new_drh($class,
		{
			'Name' => 'Chart',
			'Version' => $DBD::Chart::VERSION,
			'Err' => \$DBD::Chart::err,
			'Errstr' => \$DBD::Chart::errstr,
			'State' => \$DBD::Chart::state,
			'Attribution' => 'DBD::Chart by Dean Arnold'
		});
	DBI->trace_msg("DBD::Chart v.$DBD::Chart::VERSION loaded on $^O\n", 1);
#
#	generate the base colormap
#
	my %table = ();
	$table{columns} = {
		'NAME' => 0,
		'REDVALUE' => 1,

Chart.pm  view on Meta::CPAN

		$$numphs++,
		next
			if ($t eq '?');

		if ($binary_props{$prop}) {
#
#	make sure its zero or 1
#
			$props{ $prop } = $t,
			next
				if (($t == 1) || ($t == 0));

			return ($dbh->DBI::set_err(-1, "Invalid value for $prop property.",'S1000'), $t);
		}
		if ($prop eq 'SHOWVALUES') {
			$props{ $prop } = $t,
			next
				if (($t=~/^\d+$/) && ($t >= 0) && ($t <= 100));

			return ($dbh->DBI::set_err(-1, "Invalid value for $prop property.",'S1000'), $t);
		}
		if ($string_props{$prop}) {

			$props{$prop} = restore_strings($dbh, $prop, $t, $strlits);
			return (undef, $t)
				unless defined($props{$prop});
			next;
		}
		if (($prop eq 'WIDTH') || ($prop eq 'HEIGHT')) {

			$props{ $prop } = $t,
			next
				if (($t=~/^\d+$/) && ($t >= 10) && ($t <= 100000));

			return ($dbh->DBI::set_err(-1, "Invalid value for $prop property.",'S1000'), $t);
		}

		if ($prop eq 'LINEWIDTH') {

			$props{ $prop } = $t,
			next
				if (($t=~/^\d+$/) && ($t > 0) && ($t <= 100));

			return ($dbh->DBI::set_err(-1, 'Invalid value for LINEWIDTH property.','S1000'), $t);
		}

#		$DBD::Chart::errstr =
#			'Y_MAX and Y_MIN deprecated as of release 0.50.',
		next
			if (($prop eq 'Y_MAX') || ($prop eq 'Y_MIN'));

		if (($prop eq 'BACKGROUND') || ($prop eq 'GRIDCOLOR') ||
			($prop eq 'TEXTCOLOR')) {

			$t = restore_strings($dbh, $prop, $t, $strlits)
				if ($t=~/<\d+>/);
			$t = lc $t;
			$props{$prop} = $t,
			next
				if (check_color($t) ||
					(($prop eq 'BACKGROUND') && ($t eq 'transparent')));

			return ($dbh->DBI::set_err(-1, "Invalid value for $prop property.",'S1000'), $t);
		}

 		if (($prop eq 'COLOR') || ($prop eq 'SHAPE') || ($prop eq 'FONT')) {
 			my @colors = ();
			$props{ $prop } = \@colors;

			$t = restore_strings($dbh, $prop, $t, $strlits)
				if ($t=~/^<\d+>$/);
			push(@colors, $t),
			next
	 			unless ($t=~/^\(([^\)]+)\)$/);

			$t = lc $1;
			$t=~s/\s+//g;
			@colors = split(',', $t);
			for (my $i = 0; $i <= $#colors; $i++) {
				next if (uc $colors[$i] eq 'NULL');
				$colors[$i] = "?$$numphs",
				$$numphs++,
				next
					if ($colors[$i] eq '?');

				next unless ($colors[$i]=~/^<\d+>$/);
				$colors[$i] = restore_strings($dbh, $prop, $colors[$i], $strlits);
			}
			next;
 		}
 		if ($prop eq 'ICON') {
 			my @icons = ();
			$props{ $prop } = \@icons;

			$t = restore_strings($dbh, $prop, $t, $strlits)
 				if ($t=~/^<\d+>$/);

			$icons[0] = $t,
			next
 				unless ($t=~/^\(([^\)]+)\)$/);

			$t = $1;
			$t=~s/\s+//g;
			@icons = split(',', $t);
			for (my $i = 0; $i <= $#icons; $i++) {
				next if (uc $icons[$i] eq 'NULL');
				$icons[$i] = "?$$numphs",
				$$numphs++,
				next
					if ($icons[$i] eq '?');
				next unless ($icons[$i]=~/^<\d+>$/);
				$icons[$i] = restore_strings($dbh, $prop, $icons[$i], $strlits);
 			}
 		}
	} # end while

	if (defined($props{COLOR})) {
		my $colors = $props{COLOR};
		foreach $prop (@$colors) {
			next unless defined($prop);
			next if check_color($prop);