Apache-Wyrd

 view release on metacpan or  search on metacpan

Wyrd/Chart.pm  view on Meta::CPAN


Marker types (1: filled square, 2: open square, 3: horizontal cross, 4:
diagonal cross, 5: filled diamond, 6: open diamond, 7: filled circle, 8:
open circle, 9: horizontal line, 10: vertical line) and size (in pixels)

=item 3d pie_height start_angle suppress_angle

Pie chart attributes.  suppress_angle is a limit below which no line is
drawn

=item legend_font title_font x_label_font y_label_font x_axis_font
y_axis_font

Fonts.  Either a file (if your system supports TTF) or one of the builtin
fonts: gdTinyFont gdSmallFont gdMediumBoldFont gdLargeFont gdGiantFont

=back

=back

=head2 PERL METHODS

I<(format: (returns) name (arguments after self))>

=cut

Wyrd/Chart.pm  view on Meta::CPAN

	my ($self, $file) = @_;
	if (-f $file) {
		$self->_error("$file is not writable.  Updates will fail.") unless (-w _);
	} else {
		my $dir = $file;
		$dir =~ s/[^\/]+$//;
		$self->_raise_exception("$dir is not writable") unless (-w $dir);
	}
}

sub _ok_font {
	my ($self, $font) = @_;
	if ($font =~ /\//) {
		#font is a file
		unless ($self->{'_ttf_support'}) {
			$self->_error("Font requested: $font, but no TTF support");
			return;
		}
		#warn $font;
		my $root = $self->dbl->req->document_root;
		return "$root$font" if (-f "$root$font" and -r _);
		$self->_error("Font requested: $font, but the file doesn't exist or can't be read");
		return;
	}
	return $font if (grep {$font eq $_} @{$self->{'_valid_attributes'}->{'builtin_fonts'}});
	return;
}

sub _image_template {
	my ($self) = @_;
	my $template = attopts_template(@{$self->{'_valid_attributes'}->{'img'}});
	return '<img src="$:src"' . $template . '>';
}

sub _get_graph {

Wyrd/Chart.pm  view on Meta::CPAN

		eval("\$graph = GD::Graph::$type->new(\$width, \$height)");
		$self->_raise_exception($@) if ($@);
	} else {
		$self->_raise_exception("Chart type \"$type\" not supported.");
	}
	$self->{'_ttf_support'} = $graph->can_do_ttf;

	my @builtin_colors = GD::Graph::colour::colour_list;
	my @color_attribs = @{$self->{'_valid_attributes'}->{'color_attr'}};
	my @array_attribs = @{$self->{'_valid_attributes'}->{'array_attr'}};
	my @font_attribs = @{$self->{'_valid_attributes'}->{'font_attr'}};
	@font_attribs = @{$self->{'_valid_attributes'}->{'font_attr_pie'}} if ($self->{'type'} eq 'pie');

	#Parse colors, allowing only valid hex or builtin colors
	my %bad_colors = ();
	foreach my $attrib (@color_attribs) {
		my @colors = token_parse($self->{$attrib});
		my @dclrs = ();
		foreach my $color (@colors) {
			next if (grep {$_ eq $color} @builtin_colors);
			if ($color !~ /^#[0-9abcdefABCDEF]{6}$/) {
				$self->_error("color $color in attribute $attrib is invalid.  This color will be ignored.");

Wyrd/Chart.pm  view on Meta::CPAN

		my @values = token_parse($self->{$attrib});
		delete ($self->{$attrib});
		if (grep {$_ eq $attrib} @color_attribs) {
			@values = (grep {$bad_colors{$_} != 1} @values);
		}
		$self->{$attrib} = \@values if (@values);
	}

	#call those methods that are available to all types
	$self->{'text_clr'} && $graph->set_text_clr($self->{'text_clr'});
	$self->{'title_font'} && $self->_ok_font($self->{'title_font'}) && $graph->set_title_font(token_parse($self->{'title_font'}));

	$self->_add_chart_attributes($self->{'_valid_attributes'}->{'all'});
	#then those for axis types
	if ($type =~ /^(lines|hbars|bars|points|linespoints|area)$/) {
		$self->_add_chart_attributes($self->{'_valid_attributes'}->{'axes'});
		if ($type =~ /bars/) {
			$self->_add_chart_attributes($self->{'_valid_attributes'}->{'bars'});
		}
		if ($type =~ /points/) {
			$self->_add_chart_attributes($self->{'_valid_attributes'}->{'points'});
		}
		if ($type =~ /lines/) {
			$self->_add_chart_attributes($self->{'_valid_attributes'}->{'lines'});
		}
	#or those for pie types
	} elsif ($type eq 'pie') {
		$self->_add_chart_attributes($self->{'_valid_attributes'}->{'pie'});
	}

	#then parse function-based settings, such as fonts
	foreach my $attrib (@font_attribs) {
		next unless defined ($self->{$attrib});
		my ($font, $size) = token_parse($self->{$attrib});
		my $approved_font = $self->_ok_font($font);
		if ($approved_font) {
			eval "\$graph->set_$attrib('$approved_font', $size)";
			$self->_error("Could not use font $font in attribute $attrib: $@") if ($@);
		} else {
			$self->_error("Could not use font $font in attribute $attrib");
		}
	}
	$graph->set_legend(token_parse($self->{'legend'})) if $self->{'legend'};

	my %settings = ();
	foreach my $attribute (@{$self->{'_chart_attributes'}}) {
		$settings{$attribute} = $self->{$attribute} if defined($self->{$attribute});
	}

	#warn Dumper(\%settings);

Wyrd/Chart.pm  view on Meta::CPAN

sub _setup {
	my ($self) = @_;
	$self->{'_valid_attributes'} = {
		'img'			=>	[qw(align alt border height hspace ismap longdesc usemap vspace width src)],
		'all'			=>	[qw(b_margin t_margin l_margin r_margin transparent interlaced bgclr fgclr boxclr textclr labelclr axislabelclr legendclr valuesclr accentclr shadowclr dclrs show_values values_vertical values_space values_format logo logo_position logo_...
		'axes'			=>	[qw(x_label y_label box_axis two_axes zero_axis zero_axis_only x_plot_values y_plot_values y_max_value y_min_value x_tick_number x_min_value x_tick_number x_min_value x_max_value y_number_format x_label_skip y_label_skip x_tick_offset x...
		'bars'			=>	[qw(overwrite bar_width bar_spacing shadow_depth borderclrs cycle_clrs cumulate)],
		'lines'			=>	[qw(line_types line_type_scale line_width skip_undef)],
		'points'		=>	[qw(markers marker_size)],
		'pie'			=>	[qw(3d pie_height start_angle suppress_angle)],
		'builtin_fonts'	=>	[qw(gdTinyFont gdSmallFont gdMediumBoldFont gdLargeFont gdGiantFont)],
		'font_attr'		=>	[qw(legend_font title_font x_label_font y_label_font x_axis_font y_axis_font)],
		'font_attr_pie'	=>	[qw(legend_font title_font label_font value_font)],
		'color_attr'	=>	[qw(bgclr fgclr boxclr textclr labelclr axislabelclr legendclr valuesclr accentclr shadowclr dclrs)],
		'array_attr'	=>	[qw(dclrs markers)],
		'boolean_attr'	=>	[qw(transparent interlaced show_values values_vertical box_axis two_axes zero_axis zero_axis_only x_plot_values y_plot_values x_all_ticks x_labels_vertical long_ticks x_ticks correct_width cycle_clrs cumulate skip_undef 3d)]
	};
	$self->{'_chart_attributes'} = [];
	$self->_set_default_attributes;
}

sub _format_output {
	my ($self) = @_;

Wyrd/Site/GDButton.pm  view on Meta::CPAN


=item bgcolor, color

(required w/o template) background and foreground color, in six-digit hex form
(#RRGGBB).

=item size

Font size, in pixels.

=item font

Path to the font file.  Either absolute, relative, or root-dir-relative.  It
must be a TrueType font file, and your version of GD must support TrueType
fonts.

=item margin, tmargin, rmargin, bmargin, lmargin

Margin between text and edge of button, in pixels.  Margin represents an
overall number, and is the default for the others.  Specific top, right,
bottom, and left margins can be defined separately, falling back to the
margin value.

=item name id action method alt align onmouseover onmouseout onclick border ismap longdesc usemap

Wyrd/Site/GDButton.pm  view on Meta::CPAN

=back

=head1 BUGS/CAVEATS

Reserves the _format_output and _generate_output methods.

=cut

sub _format_output {
	my ($self) = @_;
	my @required_attributes = qw(src name outfile bgcolor color size font);
	unless ($self->{'template'}) {
		push @required_attributes, qw(width height);
	}
	my @optional_attributes = qw(margin lmargin rmargin bmargin tmargin halign valign);
	my $defaults = $self->_defaults;
	$defaults = {} unless (ref($defaults) eq 'HASH');
	map {$self->{$_} ||= ($defaults->{$_})} @required_attributes, @optional_attributes;
	$self->{'outfile'} = $self->file_attribute('src', 'rw') if ($self->{'src'});
	$self->{'template'} = $self->file_attribute('template', 'rf') if ($self->{'template'});
	$self->{'font'} = $self->file_attribute('font', 'rf') if ($self->{'font'});
	#When these are inputs, the name is more important than the text.
	$self->{'text'} ||= ($self->_data || ucfirst($self->{'name'}) || 'Click Me');
	#When these are images, the name is less important than the SRC attribute
	$self->{'name'} ||= ($self->{'src'});
	$self->{'halign'} ||= ('center');
	$self->{'valign'} ||= ('middle');
	$self->{'type'} ||= ('input');
	my @missing = grep {not($self->{$_})} @required_attributes;
	@missing = grep {$_ ne 'name'} @missing if ($self->{'type'} ne 'input');#inputs must have names, but others don't have to.
	$self->_raise_exception("Missing attributes: " . join ", ", @missing) if (@missing);

Wyrd/Site/GDButton.pm  view on Meta::CPAN

			if (lc($type) eq 'gif') {
				$base_image = GD::Image->newFromGif($template);
			} else {
				$base_image = GD::Image->newFromPng($template);
			}
			my $width = $self->{'width'} = $base_image->width;
			my $width = $self->{'height'} = $base_image->height;
			$image = GD::Image->new($self->{'width'} * 5, $self->{'height'} * 5);
			$image->copyResampled($base_image, 0, 0, 0, 0, $self->{'width'} * 5, $self->{'height'} * 5, $self->{'width'}, $self->{'height'});
		} else {
			#Draw everything at 5 times the given size, since font shape and spacing issues are less prominent
			$image= GD::Image->new($self->{'width'} * 5, $self->{'height'} * 5);
			my $bg = $image->colorAllocate($self->_get_color($self->{'bgcolor'}));
			$image->filledRectangle(0, 0, $self->{'width'} * 5, $self->{'height'} * 5, $bg);
		}
		my $fg = $image->colorAllocate($self->_get_color($self->{'color'}));

		#First get the size of the text image.  Since font shapes falling below
		#the drawing line will throw off the placment, this value will be taken
		#into account by _get_startpoint, which attempts to place the text at a
		#more "natural" location. This setting is overridden with the "absolute"
		#flag.
		my @abstract = GD::Image->stringFT($antialias * $fg, $self->{'font'}, $self->{'size'} * 5, 0, 0, 0, $self->{'text'});
		my ($x, $y) = $self->_get_startpoint(@abstract);

		#Then render the actual text using the calculated start point.
		my @bounds = $image->stringFT($antialias * $fg, $self->{'font'}, $self->{'size'} * 5, 0, $x, $y, $self->{'text'}, {resolution => "72,72", kerning => 1});

		#Shrink it down to 1/5 the rendered size.
		my $final = GD::Image->new($self->{'width'}, $self->{'height'});
		$final->copyResampled($image, 0, 0, 0, 0, $self->{'width'}, $self->{'height'}, $self->{'width'} * 5, $self->{'height'} * 5);
		
		open FILE, "> " . $self->{'outfile'};
		binmode FILE;
		print FILE ($self->{'outfile'}=~/gif$/) ? $final->gif : $final->png;
		close FILE;
	}



( run in 0.849 second using v1.01-cache-2.11-cpan-5735350b133 )