711 lines
16 KiB
Perl
711 lines
16 KiB
Perl
package WebGUI::Image::Graph;
|
|
|
|
use strict;
|
|
use WebGUI::Image;
|
|
use WebGUI::Image::Palette;
|
|
use WebGUI::Image::Font;
|
|
use List::Util;
|
|
|
|
our @ISA = qw(WebGUI::Image);
|
|
|
|
=head1 addDataset ( dataset )
|
|
|
|
Adds a dataset to the graph. Please not that not all graph types can handle
|
|
multiple datasets and will therefore ignore any dataset but the first.
|
|
|
|
=head2 dataset
|
|
|
|
An arrayref containg the values of the data. The dat must be numeric.
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------
|
|
sub addDataset {
|
|
my $self = shift;
|
|
my $dataset = shift;
|
|
|
|
push(@{$self->{_datasets}}, $dataset);
|
|
}
|
|
|
|
=head1 configurationForm
|
|
|
|
Returns a hashref containing the form where the properties of your graph type
|
|
can be set. Your pluging should extend this method by append the form to the
|
|
hashref returned by the super method and returning the reference.
|
|
|
|
The key for this entry must be unique, so use the namespace of your plugin
|
|
without the WebGUI::Image part; the :: converted to and underscore and
|
|
everything in lowercase.
|
|
|
|
Check some of the plugins that come with WebGUI for examples.
|
|
|
|
=cut
|
|
|
|
#-------------------------------------------------------------------
|
|
sub configurationForm {
|
|
my $self = shift;
|
|
|
|
my $i18n = WebGUI::International->new($self->session, 'Image_Graph');
|
|
|
|
my $f = WebGUI::HTMLForm->new($self->session);
|
|
$f->trClass('Graph');
|
|
$f->integer(
|
|
-name => 'graph_imageWidth',
|
|
-value => $self->getImageWidth,
|
|
-label => $i18n->get('image width'),
|
|
);
|
|
$f->integer(
|
|
-name => 'graph_imageHeight',
|
|
-value => $self->getImageHeight,
|
|
-label => $i18n->get('image height'),
|
|
);
|
|
$f->color(
|
|
-name => 'graph_backgroundColor',
|
|
-value => $self->getBackgroundColor,
|
|
-label => $i18n->get('background color'),
|
|
);
|
|
$f->selectBox(
|
|
-name => 'graph_paletteId',
|
|
-label => $i18n->get('palette'),
|
|
-value => [ $self->getPalette->getId ],
|
|
-options=> $self->getPalette->getPaletteList,
|
|
);
|
|
$f->float(
|
|
-name => 'graph_labelOffset',
|
|
-value => $self->getLabelOffset,
|
|
-label => $i18n->get('label offset'),
|
|
);
|
|
$f->selectBox(
|
|
-name => 'graph_labelFontId',
|
|
-value => [ $self->getLabelFont->getId ],
|
|
-label => $i18n->get('label font'),
|
|
-options=> WebGUI::Image::Font->getFontList($self->session),
|
|
);
|
|
$f->color(
|
|
-name => 'graph_labelColor',
|
|
-value => $self->getLabelColor,
|
|
-label => $i18n->get('label color'),
|
|
);
|
|
$f->integer(
|
|
-name => 'graph_labelFontSize',
|
|
-value => $self->getLabelFontSize,
|
|
-label => $i18n->get('label fontsize'),
|
|
);
|
|
|
|
return {'graph' => $f->printRowsOnly};
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 drawLabel ( label, [ properties ] )
|
|
|
|
Draws a label with your preferred properties. Defaults the font, font size and
|
|
color which you can override.
|
|
|
|
=head2 label
|
|
|
|
The text of the label you want to print.
|
|
|
|
=head2 properties
|
|
|
|
A hash containing imagemagick Annotate properties.
|
|
|
|
=cut
|
|
|
|
sub drawLabel {
|
|
my $self = shift;
|
|
my $label = shift;
|
|
my %properties = @_;
|
|
|
|
$self->text(
|
|
text => $label,
|
|
font => $self->getLabelFont->getFile,
|
|
fill => $self->getLabelColor,
|
|
style => 'Normal',
|
|
pointsize => $self->getLabelFontSize,
|
|
%properties,
|
|
);
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 formNamespace
|
|
|
|
Returns the namespace used in the configuration form. You must extend this
|
|
method by concatenating an underscore and the last part of your namespace to the
|
|
output of the SUPER method.
|
|
|
|
For examples please see the implementation in the plugins that come with WebGUI.
|
|
|
|
=cut
|
|
|
|
sub formNamespace {
|
|
return "Graph";
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getConfiguration
|
|
|
|
Returns the configuration hashref of the plugin. You must extend this method by
|
|
adding your configuration keys to the hashref returned by the SUPER method. To
|
|
avoid conflicts prepend your configuration keys with the namespace of your
|
|
plugin, encoded as follows: take the part of the namespace without
|
|
WebGUI::Image, convert it to lowercase and substitute the :: with a single
|
|
underscore.
|
|
|
|
Check out the plugins that are shipped with WebGUI for examples.
|
|
|
|
=cut
|
|
|
|
sub getConfiguration {
|
|
my $self = shift;
|
|
|
|
return {
|
|
graph_formNamespace => $self->formNamespace,
|
|
graph_paletteId => $self->getPalette->getId,
|
|
graph_labelOffset => $self->getLabelOffset,
|
|
graph_labelFontSize => $self->getLabelFontSize,
|
|
graph_labelFontId => $self->getLabelFont->getId,
|
|
graph_labelColor => $self->getLabelColor,
|
|
graph_imageWidth => $self->getImageWidth,
|
|
graph_imageHeight => $self->getImageHeight,
|
|
graph_backgroundColor => $self->getBackgroundColor,
|
|
};
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getGraphingTab ( session, [ config ] )
|
|
|
|
Returns the contents of the graphing tab you can add to your asset.
|
|
|
|
This is a class method, and therefore you must pass the WebGUI session object.
|
|
|
|
=head2 session
|
|
|
|
An instanciated WebGUI session object.
|
|
|
|
=head2 config
|
|
|
|
Optionally you can pass a configuration hash to populate the form
|
|
|
|
=cut
|
|
|
|
sub getGraphingTab {
|
|
my (%configForms, $output);
|
|
my $class = shift;
|
|
my $session = shift;
|
|
my $config = shift;
|
|
|
|
my (@graphingPlugins, %graphingPlugins, @failedGraphingPlugins);
|
|
|
|
my $i18n = WebGUI::International->new($session, 'Image_Graph');
|
|
|
|
my $f = WebGUI::HTMLForm->new($session);
|
|
|
|
foreach (@{$session->config->get("graphingPlugins")}) {
|
|
my $plugin = WebGUI::Image::Graph->load($session, $_);
|
|
if ($plugin) {
|
|
push(@graphingPlugins, $plugin);
|
|
$plugin->setConfiguration($config);
|
|
$graphingPlugins{$plugin->formNamespace} = $_;
|
|
} else {
|
|
push(@failedGraphingPlugins, $_);
|
|
}
|
|
}
|
|
|
|
my $ns = $config->{graph_formNamespace};
|
|
# payment plugin
|
|
if (%graphingPlugins) {
|
|
$session->style->setRawHeadTags(<<EOS
|
|
<script type="text/javascript">
|
|
function inNamespace (clas, namespace) {
|
|
var namespaceParts = namespace.split('_');
|
|
var s = '';
|
|
|
|
for (var i = 0; i < namespaceParts.length; i++) {
|
|
if (i > 0) {
|
|
s = s + '_';
|
|
}
|
|
s = s + namespaceParts[i];
|
|
|
|
if (s == clas) {
|
|
return true;
|
|
}
|
|
}
|
|
|
|
return false;
|
|
}
|
|
|
|
function getContainerTag (elem, tagname) {
|
|
var parent = elem.parentNode;
|
|
|
|
while (parent.tagName != tagname) {
|
|
parent = parent.parentNode;
|
|
}
|
|
|
|
return parent;
|
|
}
|
|
|
|
function switchGraphingFormElements (elem, namespace) {
|
|
var rowElements = getContainerTag(elem, 'TABLE').getElementsByTagName('TR');
|
|
|
|
for (var ix = 0; ix < rowElements.length; ix++) {
|
|
if (inNamespace(rowElements[ix].className, namespace)) {
|
|
rowElements[ix].style.display = '';
|
|
} else {
|
|
if (rowElements[ix].className.match(/^Graph_/)) {
|
|
rowElements[ix].style.display = 'none';
|
|
}
|
|
}
|
|
}
|
|
}
|
|
</script>
|
|
EOS
|
|
);
|
|
|
|
$f->selectBox(
|
|
-name => 'graphingPlugin',
|
|
-options => \%graphingPlugins,
|
|
-label => $i18n->get('graph type'),
|
|
#### hoverhelp
|
|
-hoverHelp => 'Graph type hover',
|
|
-id => 'graphTypeSelector',
|
|
-value => [ $config->{graph_formNamespace} ],
|
|
-extras => 'onchange="switchGraphingFormElements(this, this.value)"'
|
|
);
|
|
|
|
foreach my $currentPlugin (@graphingPlugins) {
|
|
%configForms = (%configForms, %{$currentPlugin->configurationForm});
|
|
}
|
|
} else {
|
|
$f->raw('<tr><td colspan="2" align="left">'.$i18n->get('no graphing plugins').'</td></tr>');
|
|
}
|
|
|
|
foreach (sort keys %configForms) {
|
|
$f->raw($configForms{$_});
|
|
}
|
|
|
|
$f->raw('<script type="text/javascript">'.
|
|
"switchGraphingFormElements(document.getElementById('graphTypeSelector'), '$ns');".
|
|
'</script>'
|
|
);
|
|
|
|
return $f->printRowsOnly;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getDataset ( [ index ] )
|
|
|
|
Returns the dataset indicated by index.
|
|
|
|
=head2 index
|
|
|
|
The index of the array containing the datasets. The first dataset is indicated
|
|
by index 0. If ommitted this method returns an arrayref of arrayrefs containing
|
|
all datasets.
|
|
|
|
=cut
|
|
|
|
sub getDataset {
|
|
my $self = shift;
|
|
my $index = shift;
|
|
|
|
return $self->{_datasets} unless (defined $index);
|
|
|
|
die "Illegal dataset" if ($index >= scalar(@{$self->{_datasets}}));
|
|
|
|
return $self->{_datasets}->[$index];
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabel ( [ index ] )
|
|
|
|
Returns the index'th label or an arrayref containing all labels.
|
|
|
|
=head2 index
|
|
|
|
The index of label to return. Numbering starts at 0. If omitted an arrayref
|
|
containing all labels is returned.
|
|
|
|
=cut
|
|
|
|
sub getLabel {
|
|
my $self = shift;
|
|
my $index = shift;
|
|
|
|
return $self->{_labels}->{data} || [] unless (defined $index);
|
|
return $self->{_labels}->{data}->[$index];
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabelColor
|
|
|
|
Returns the triplet of the label color. Defaults to '#333333'.
|
|
|
|
=cut
|
|
|
|
sub getLabelColor {
|
|
my $self = shift;
|
|
|
|
return $self->{_labels}->{labelColor} || '#333333';
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabelDimensions ( text, [ properties ] )
|
|
|
|
Returns a hashref containg the width and height in pixels of the passed text.
|
|
Width and height are referenced by the keys 'width' and 'height' respectively.
|
|
|
|
=head2 text
|
|
|
|
The text you want to know the dimensions of.
|
|
|
|
=head2 properties
|
|
|
|
Optionally you can pass a hashref containing imagemagick's Annotate properties.
|
|
|
|
=cut
|
|
|
|
sub getLabelDimensions {
|
|
my $self = shift;
|
|
my $text = shift;
|
|
my $properties = shift || {};
|
|
|
|
my ($x_ppem, $y_ppem, $ascender, $descender, $width, $height, $max_advance) = $self->image->QueryFontMetrics(
|
|
font => $self->getLabelFont->getFile,
|
|
# stroke => $self->getLabelColor,
|
|
fill => $self->getLabelColor,
|
|
style => 'Normal',
|
|
pointsize => $self->getLabelFontSize,
|
|
%$properties,
|
|
text => $text,
|
|
);
|
|
|
|
return {width => $width, height => $height};
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabelFont
|
|
|
|
Returns the WebGUI::Image::Font object this image is set to. Defaults to the
|
|
default font.
|
|
|
|
=cut
|
|
|
|
sub getLabelFont {
|
|
my $self = shift;
|
|
|
|
return $self->{_labels}->{labelFont} || WebGUI::Image::Font->new($self->session);
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabelFontSize
|
|
|
|
Returns the font size of the labels. Defaults to 20.
|
|
|
|
=cut
|
|
|
|
sub getLabelFontSize {
|
|
my $self = shift;
|
|
|
|
return $self->{_labels}->{labelFontSize} || 20;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getLabelOffset
|
|
|
|
Returns the label offset. This is the distance between the label and the axis.
|
|
Defaults to 10 pixels.
|
|
|
|
=cut
|
|
|
|
sub getLabelOffset {
|
|
my $self = shift;
|
|
|
|
return $self->{_labels}->{labelOffset} || 10;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 getMaxValueFromDataset
|
|
|
|
Returns the highest value of all added datasets.
|
|
|
|
=cut
|
|
|
|
sub getMaxValueFromDataset {
|
|
my $self = shift;
|
|
|
|
my ($sum, $maxSum);
|
|
|
|
if ($self->getDrawMode eq 'stacked') {
|
|
my $maxElements = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
|
my $numberOfDatasets = scalar @{$self->{_datasets}};
|
|
|
|
for my $currentElement (0 .. $maxElements-1) {
|
|
$sum = 0;
|
|
for my $currentDataset (0 .. $numberOfDatasets - 1) {
|
|
$sum += $self->{_datasets}->[$currentDataset]->[$currentElement];
|
|
}
|
|
$maxSum = $sum if ($sum > $maxSum);
|
|
}
|
|
} else {
|
|
$maxSum = List::Util::max(map {(@$_)} @{$self->{_datasets}});
|
|
}
|
|
|
|
return $maxSum;
|
|
|
|
return List::Util::max(@{$self->{_dataset}});
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 load ( session, namespace )
|
|
|
|
Instanciates an WebGUI::Graph object with the given namespace.
|
|
|
|
=head2 session
|
|
|
|
A WebGUI::Session object.
|
|
|
|
=head2 namespace
|
|
|
|
The full namespace of the plugin you want to load.
|
|
|
|
=cut
|
|
|
|
sub load {
|
|
my $self = shift;
|
|
my $session = shift;
|
|
my $namespace = shift;
|
|
|
|
my $cmd = "use $namespace";
|
|
eval($cmd);
|
|
|
|
$cmd = $namespace.'->new($session)';
|
|
my $plugin = eval($cmd);
|
|
return $plugin;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 loadByConfiguration ( session, configuration )
|
|
|
|
Loads a plugin defined by a configuration hash.
|
|
|
|
=head2 session
|
|
|
|
A WebGUI::Session object.
|
|
|
|
=head2 configuration
|
|
|
|
A configuration hashref.
|
|
|
|
=cut
|
|
|
|
sub loadByConfiguration {
|
|
my $self = shift;
|
|
my $session = shift;
|
|
my $config = shift;
|
|
|
|
my $namespace = "WebGUI::Image::".$config->{graph_formNamespace};
|
|
$namespace =~ s/_/::/g;
|
|
|
|
$session->errorHandler->fatal("wrong namespace: [$namespace]") unless ($config->{graph_formNamespace} =~ /^[\w\d_]+$/);
|
|
|
|
my $plugin = $self->load($session, $namespace);
|
|
$plugin->setConfiguration($config);
|
|
|
|
return $plugin;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 processConfigurationForm ( session )
|
|
|
|
Processes the configuration form that is submitted and returns the correct
|
|
instanciated graphing plugin.
|
|
|
|
=head2 session
|
|
|
|
The WebGUI session object.
|
|
|
|
=cut
|
|
|
|
sub processConfigurationForm {
|
|
my $self = shift;
|
|
my $session = shift;
|
|
|
|
my $namespace = "WebGUI::Image::".$session->form->process('graphingPlugin');
|
|
$namespace =~ s/_/::/g;
|
|
|
|
my $graph = $self->load($session, $namespace);
|
|
|
|
$graph->setConfiguration($session->form->paramsHashRef);
|
|
|
|
return $graph;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setConfiguration ( config )
|
|
|
|
Configures the pluging according to the configuration hashref that is passed.
|
|
You must extend this method by calling the SUPER method with the configuration
|
|
hashref and processing your part of the configuration options.
|
|
|
|
=head2 config
|
|
|
|
The configuration hashref.
|
|
|
|
=cut
|
|
|
|
sub setConfiguration {
|
|
my $self = shift;
|
|
my $config = shift;
|
|
|
|
$self->setPalette(WebGUI::Image::Palette->new($self->session, $config->{graph_paletteId}));
|
|
$self->setLabelOffset($config->{graph_labelOffset});
|
|
$self->setLabelFontSize($config->{graph_labelFontSize});
|
|
$self->setLabelFont(WebGUI::Image::Font->new($self->session, $config->{graph_labelFontId}));
|
|
$self->setLabelColor($config->{graph_labelColor});
|
|
$self->setImageWidth($config->{graph_imageWidth});
|
|
$self->setImageHeight($config->{graph_imageHeight});
|
|
$self->setBackgroundColor($config->{graph_backgroundColor});
|
|
|
|
};
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setLabelColor ( color )
|
|
|
|
Sets the color triplet of the labels.
|
|
|
|
=head2 color
|
|
|
|
The triplet defining the color. The triplet should be in the form of '#ffffff'.
|
|
|
|
=cut
|
|
|
|
sub setLabelColor {
|
|
my $self = shift;
|
|
my $color = shift;
|
|
|
|
$self->{_labels}->{labelColor} = $color;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setLabelFont ( font )
|
|
|
|
Set the label font.
|
|
|
|
=head2 font
|
|
|
|
A WebGUI::Image::Font object.
|
|
|
|
=cut
|
|
|
|
sub setLabelFont {
|
|
my $self = shift;
|
|
my $font = shift;
|
|
|
|
$self->{_labels}->{labelFont} = $font;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setLabelFontSize ( size )
|
|
|
|
Sets the font size of the labels.
|
|
|
|
=head2 size
|
|
|
|
The desired font size.
|
|
|
|
=cut
|
|
|
|
sub setLabelFontSize {
|
|
my $self = shift;
|
|
my $size = shift;
|
|
|
|
$self->{_labels}->{labelFontSize} = $size;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setLabelOffset ( offset )
|
|
|
|
Sets the label offset. This is the distance in pixels between the labels and the
|
|
axis.
|
|
|
|
=head2 offset
|
|
|
|
The label offset.
|
|
|
|
=cut
|
|
|
|
sub setLabelOffset {
|
|
my $self = shift;
|
|
my $offset = shift;
|
|
|
|
$self->{_labels}->{labelOffset} = $offset;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 setLabels ( labels )
|
|
|
|
Sets the labels for the datasets.
|
|
|
|
=head2 labels
|
|
|
|
An arrayref containig the labels.
|
|
|
|
=cut
|
|
|
|
sub setLabels {
|
|
my $self = shift;
|
|
my $labels = shift || [];
|
|
|
|
$self->{_labels}->{data} = $labels;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
=head1 wrapLabelToWidth ( text, maxWidth, [ properties ] )
|
|
|
|
Wraps a text string onto multiple lines having a width of maxWidth.
|
|
|
|
=head2 text
|
|
|
|
The text you want to wrap.
|
|
|
|
=head2 maxWidth
|
|
|
|
The width the string should have after wrapping/
|
|
|
|
=head2 properties
|
|
|
|
An optional hashref containing imagemagick's Annotate properties.
|
|
|
|
=cut
|
|
|
|
sub wrapLabelToWidth {
|
|
my (@words, $part, @lines);
|
|
my $self = shift;
|
|
my $text = shift;
|
|
my $maxWidth = shift;
|
|
my $properties = shift;
|
|
|
|
@words = split(/ +/, $text);
|
|
|
|
foreach (@words) {
|
|
if ($self->getLabelDimensions("$part $_", $properties)->{width} > $maxWidth) {
|
|
if ($part) {
|
|
$part =~ s/ $//;
|
|
push(@lines, $part);
|
|
$part = "$_ ";
|
|
} else {
|
|
push(@lines, $_);
|
|
$part = '';
|
|
}
|
|
} else {
|
|
$part .= "$_ ";
|
|
}
|
|
}
|
|
$part =~ s/ $//;
|
|
push(@lines, $part) if ($part);
|
|
|
|
return join("\n", @lines);
|
|
}
|
|
|
|
1;
|
|
|