Apache-Wyrd
view release on metacpan or search on metacpan
Wyrd/Chart.pm view on Meta::CPAN
use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized);
package Apache::Wyrd::Chart;
our $VERSION = '0.98';
use base qw(Apache::Wyrd::Interfaces::Setter Apache::Wyrd);
use GD::Graph;
use GD::Graph::colour qw(:colours :convert :lists);
use Apache::Wyrd::Services::SAK qw(:tag :file token_parse token_hash);
use Digest::SHA qw(sha1_hex);
use Data::Dumper;
=pod
=head1 NAME
Apache::Wyrd::Chart - Embed Dynamically-redrawn charts in HTML
=head1 SYNOPSIS
<BASENAME::Chart img="chart.png" type="bars" height="200" width="300">
<BASENAME::Query>
select month, price
from monthly_prices
order by month
</BASENAME::Query>
</BASENAME::Chart>
=head1 DESCRIPTION
Chart-graphic Wyrd wrapping the C<GD::Graph> Module. Creates a graphic file
(PNG) and a meta-data file based on data handed it to by an
C<Apache::Wyrd::Query> Wyrd.
=head2 HTML ATTRIBUTES
The Chart Wyrd accepts nearly all the attributes of the GD::Graph module and the
E<lt>imgE<gt> tag, producing an E<lt>imgE<gt> tag which points to the
graphic file produced by GD::Graph, having most attributes (such as onClick,
border, but not src) given to the Chart Wyrd.
=over
=item Wyrd attributes:
=over
=item data_col
Which column of the query to plot. Default: 2.
=item labels
A comma or whitespace-separated list of label names. If not enough labels
are given, the remainder will be labeled "unknown"
=item label_col
Which column of the query to use for labels. Default: 1.
=item other_limit
Items with values under this number will be lumped together under the item
name "Other".
=item label_filters, value_filters
A whitespace or comma delineated list of builtin filters to apply to the
labels or values respectively. Current filters:
=over
=item zero
Replace undefined values with 0.
=item dollar_sign
Put a dollar sign to the left
=item percent_sign
Put a percent sign to the right
=item commify
Put numbers into (north american style) comma splits, i.e. 3,000,000 for 3E6
=back
=item Flags
=over
=item nochache
Always generate the graphic, instead of checking to see if it has changed
=item percent
Convert values to percentages of total
=item rotate
Pivot the table returned by the query to make X Y and vice-versa
=item value_labels
Add the value to the label, as in "Foobars (2), Widgets (23)"
=back
=back
=over
=item IMG-style attributes:
=over
=item height, width, vspace, border, hspace
In pixels, as per IMG tag
=item src
Required - Where (document-root-relative) the graphic is to appear.
Currently must end with .png.
=back
=item GD::Graph-style attributes
See GD::Graph documentation for more details. Files are always
document-root-relative. Colors may be in GD::Graph name format or in in
HTML "#XXXXXX" format. Edge-positions are in the GD::Graph standard of UL
for Upper-Left, LL for Lower-Left, etc. 1 is the usual value for "yes" in
boolean attributes. Lists are in a whitespace-separated or comma-separated
list of items (using Apache::Wyrd::Services::SAK::token_parse). Angles are
in degrees.
=over
=item type
What type of graph, per the GD::Graph subclasses. Valid types are: lines,
hbars, bars, points, linespoints, area, or pie
=item b_margin t_margin l_margin r_margin
edge-to-graphic margins
=item transparent interlaced
PNG options
=item bgclr fgclr boxclr textclr labelclr axislabelclr legendclr valuesclr
accentclr shadowclr
Colors for the respective chart elements
=item dclrs borderclrs
Data element and border colors, in list format.
=item show_values values_vertical values_space values_format
Whether (1=yes) to show values, whether vertically, what space (pixels)
around them and what (sprintf-style) format to display them in.
=item logo logo_position logo_resize
logo file, corner for logo, and resize factor
=item legend_placement legend_spacing legend_marker_width
legend_marker_height lg_cols
Legend attributes (axestype graphs only)
=item 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_all_ticks x_label_position
y_label_position x_labels_vertical long_ticks tick_length x_ticks
y_tick_number axis_space text_space
Axis attributes (for applicable chart types)
Wyrd/Chart.pm view on Meta::CPAN
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);
$graph->set(%settings);
return $graph;
}
sub _plot {
my ($self) = @_;
my $graph = $self->_get_graph;
$self->_process_chart($graph);
my $gd = $graph->plot($self->{'_graph_data'});
$self->_error($graph->error) if ($graph->error);
$self->_alter_graphic($gd);
$self->_error($graph->error) if ($graph->error);
#256 Color limit due to bugs in GD library
eval {$gd->trueColor(0)};
my $file = $self->{'_graphic_file'};
my $format = $self->{'_file_format'};
local $| = 1;
open OUT, "> $file" || $self->_raise_exception("Could not write file $file: $!");
binmode(OUT);
eval {
if ($format eq 'gif') {
print OUT $gd->gif();
} else {
print OUT $gd->png();
}
$self->_error($graph->error) if ($graph->error);
};
close OUT;
select OUT;
if ($@) {
$self->_error($@);
}
}
sub _add_chart_attributes {
my ($self, $arrayref) = @_;
my %uniq = ();
#combine existing attributes, new attributes, and uniquify them before assigning them to
#the _chart_attributes attribute
$self->{'_chart_attributes'} = [grep {$uniq{$_}++ == 0} (@{$self->{'_chart_attributes'}}, @$arrayref)];
}
=pod
=item (void) C<_alter_graphic> (GD Object)
"Hook" method for putting final changes on the plotted GD graphic. Accepts
the graphic as a GD object. Does nothing by default.
=cut
sub _alter_graphic {
my ($self, $dg) = @_;
return;
}
=pod
=item (undef) C<_process_chart> (GD::Graph Object)
"Hook" method for putting final changes on the GD::Graph object. Accepts
the chart as a GD::Graph object. Does nothing by default.
=cut
sub _process_chart {
my ($self, $graph) = @_;
return;
}
=pod
=item (void) C<_set_default_attribs> (void)
"Hook" method for setting default attributes. Does nothing by default.
=cut
sub _set_default_attributes {
return;
}
sub _get_data {
my ($self) = @_;
Wyrd/Chart.pm view on Meta::CPAN
"Hook" for filtering data/labels. Should accept a value for the filter and
the data to perform filters upon.
=cut
sub _special_filter {
my ($self, $filter, $value) = @_;
return $value;
}
=pod
=back
=head1 BUGS/CAVEATS/RESERVED METHODS
Reserves the register_filter, _setup and _format_output methods. Also
reserves the methods _set_default_attributes, _get_data, _process_data,
_filter_labels, _filter_values, _filter. Also reserves the standard
register_query method.
Produces, by default, a second file (E<lt>graphic_nameE<gt>.tdf) in the same
directory as the graphic which has the HTML fingerprint and the data stored
in tab-delineated-text format.
=cut
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) = @_;
$self->_raise_exception('Chart Wyrds require Query Wyrds')
unless ($self->{'sh'});
my $file = $self->{'src'};
my $root = $self->dbl->req->document_root;
if ($file) {
$file = "$root$file";
} else {
$self->_raise_exception("Chart Wyrds require a src attribute");
}
$self->_file_problems($file);
my ($format) = $file =~ /\.(png|gif)$/i;
unless ($format) {
$self->_raise_exception('Only PNG or GIF file format is supported');
}
$self->{'_graphic_file'} = $file;
$self->{'_file_format'} = lc($format);
my $datafile = $file;
$datafile =~ s/\.$format/\.tdf/;
$self->_file_problems($datafile);
$self->{'_data_file'} = $datafile;
my $data = $self->_get_data;
my $cache = '';
$cache = $self->slurp_file($datafile) if (-f $datafile);
if (($data ne $cache)) {
$self->_info("(Re)building chart...");
$self->_process_data;
$self->_plot;
#warn $datafile;
spit_file($datafile, $data);
}
my %image_attributes = map {$_, $self->{$_}} @{$self->{'_valid_attributes'}->{'img'}};
#warn $self->_image_template;
$self->_data($self->_set(\%image_attributes, $self->_image_template));
return;
}
sub register_query {
my ($self, $query) = @_;
$self->{'sh'} = $query->sh;
}
=pod
=head1 AUTHOR
Barry King E<lt>wyrd@nospam.wyrdwright.comE<gt>
=head1 SEE ALSO
=over
=item Apache::Wyrd
General-purpose HTML-embeddable perl object
=back
=head1 LICENSE
Copyright 2002-2007 Wyrdwright, Inc. and licensed under the GNU GPL.
See LICENSE under the documentation for C<Apache::Wyrd>.
=cut
1;
( run in 2.292 seconds using v1.01-cache-2.11-cpan-df04353d9ac )