cvsuser 05/11/07 21:12:34
Added: App-Widget/lib/App/Widget Graph.pm
Log:
new
Revision Changes Path
1.1 p5ee/App-Widget/lib/App/Widget/Graph.pm
Index: Graph.pm
===================================================================
######################################################################
## $Id: Graph.pm,v 1.1 2005/11/08 05:12:34 spadkins Exp $
######################################################################
package App::Widget::Graph;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf
"%d."."%02d"x$#r,@r};
use App;
use App::Widget;
@ISA = ( "App::Widget" );
use strict;
=head1 NAME
App::Widget::Graph - A graph for displaying data using HTML tables for bar
graphs
=head1 SYNOPSIS
$name = "first_name";
# official way
use App;
$context = App->context();
$w = $context->widget($name);
# OR ...
$w = $context->widget($name,
class => "App::Widget::Graph",
);
# internal way
use App::Widget::Graph;
$w = App::Widget::Graph->new($name);
=cut
=head1 DESCRIPTION
A graph for displaying data using HTML tables for bar graphs.
=cut
sub html {
&App::sub_entry if ($App::trace);
my $self = shift;
my ($name, $value, $html_value, $html);
$name = $self->{name};
my $x_values = $self->{x};
my $y_values = $self->{y};
my $y_max = $self->{y_max};
my $y_width = $self->{width} || 300;
$html = "<table cellpadding=0 border=0 cellspacing=5>\n";
my ($x_value, $y_value, $width, $x_cell);
$y_max = 0;
for (my $i = 0; $i <= $#$y_values; $i++) {
$y_value = $y_values->[$i];
if ($y_max < $y_value) {
$y_max = $y_value;
}
}
$y_max = 1 if ($y_max == 0);
$x_cell = "";
for (my $i = 0; $i <= $#$y_values; $i++) {
if ($x_values) {
$x_value = $x_values->[$i];
$x_cell = "<td align=\"right\">$x_value</td>";
}
$y_value = $y_values->[$i];
$y_value = $y_max if ($y_max && $y_value > $y_max);
$width = ($y_value/$y_max) * $y_width;
$html .= " <tr>$x_cell<td>\n";
$html .= " <table border=0 cellpadding=0 cellspacing=0><tr><td
width=\"$width\" bgcolor=\"red\"></td>";
$html .= "<td> $y_value</td></tr></table>\n";
$html .= " </td></tr>\n";
}
$html .= "</table>\n";
&App::sub_exit() if ($App::trace);
$html;
}
sub get_x {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
$self->load_data($spec) if (!$spec->{y});
my $x = $spec->{x};
&App::sub_exit($x) if ($App::trace);
return($x);
}
sub get_y {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
$self->load_data($spec) if (!$spec->{y});
my $yn = [];
my ($y);
if ($spec->{y}) {
$y = $spec->{y};
if (ref($y->[0]) eq "ARRAY") {
$yn = $y;
}
else {
push(@$yn, $y);
my $series = 2;
$y = $spec->{"y$series"};
while ($y) {
push(@$yn, $y);
$series++;
$y = $spec->{"y$series"};
}
}
}
&App::sub_exit($yn) if ($App::trace);
return($yn);
}
sub get_object_set {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
$spec = $self if (!$spec);
my $name = $self->{name};
my $context = $self->{context};
my $object_set_name = $spec->{object_set} || "$name-object_set";
my ($object_set);
if ($object_set_name) {
$object_set = $context->session_object($object_set_name, class =>
"App::SessionObject::RepositoryObjectSet");
}
elsif ($spec->{domain}) {
my $domain_name = $spec->{domain};
my $table = $spec->{table};
my $domain = $context->session_object($domain_name);
$object_set = $domain->get_object_set($table);
}
&App::sub_exit($object_set) if ($App::trace);
return($object_set);
}
sub load_data {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
# the following four fields need to be set to bind
my $columns = $spec->{columns};
$columns = [ split(/,/, $columns) ] if (!ref($columns));
die "no columns in graph" if ($#$columns == -1);
my $context = $self->{context};
my $object_set = $self->get_object_set($spec);
if (!$object_set) {
die "No known way to get data";
}
# make sure that the columns we need for the graph are in the
# list of columns in the dataset
$object_set->include_columns($columns);
my $keys = $object_set->get_key_columns(); # get the columns that are
keys
my $column_dims = (($#$columns > 0) ? 1 : 0);
my $data_dims = ($#$keys + 1) + $column_dims;
my $graph_dims = $self->get_num_dims($spec->{graphtype});
if ($graph_dims > $data_dims) {
$graph_dims = $data_dims;
}
my ($objects);
if ($graph_dims < $data_dims) {
$graph_dims = $data_dims;
my $max_key_idx = $data_dims - $graph_dims;
my (@index_keys);
my $index = $object_set->get_index([EMAIL PROTECTED]);
my $key = $spec->{key};
if (!$key) {
my @keys = (sort keys %$index);
$key = $keys[0];
}
$objects = $index->{$key};
}
else {
$graph_dims = $data_dims;
$objects = $object_set->get_objects();
}
my (@x, @yn, $object, $column);
for (my $i = 0; $i <= $#$objects; $i++) {
$object = $objects->[$i];
for (my $j = 0; $j <= $#$columns; $j++) {
$column = $columns->[$j];
$yn[$j][$i] = $object->{$column};
}
}
$spec->{y} = [EMAIL PROTECTED];
my ($label);
my $column_defs = $object_set->get_column_defs();
if ($column_dims) {
my (@y_labels);
foreach my $column (@$columns) {
$label = $column_defs->{$column}{label} || $column;
$label =~ s/<br>//g;
push(@y_labels, $label);
}
$spec->{y_labels} = [EMAIL PROTECTED];
}
{
my $x_dim = $#$keys;
my $x_column = $keys->[$x_dim];
$label = $column_defs->{$x_column}{label};
$label =~ s/<br>//g;
$spec->{x_title} = $label if (!$spec->{x_title});
my (@x);
foreach my $object (@$objects) {
push(@x, $object->{$x_column});
}
$spec->{x} = [EMAIL PROTECTED];
}
&App::sub_exit() if ($App::trace);
}
sub get_y_limits {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
my $y_min = 0;
my $y_max = 0;
my $yn = $self->get_y($spec);
my $graphtype = $spec->{graphtype} || "bar";
# stacked types
if ($graphtype eq "stacked_bar" || $graphtype eq "area") {
my (@y_values);
foreach my $y (@$yn) {
foreach (my $i = 0; $i <= $#$y; $i++) {
$y_values[$i] += $y->[$i];
$y_min = $y_values[$i] if ($y_min > $y_values[$i]);
$y_max = $y_values[$i] if ($y_max < $y_values[$i]);
}
}
}
else {
foreach my $y (@$yn) {
foreach (my $i = 0; $i <= $#$y; $i++) {
$y_min = $y->[$i] if ($y_min > $y->[$i]);
$y_max = $y->[$i] if ($y_max < $y->[$i]);
}
}
}
&App::sub_exit($y_min, $y_max) if ($App::trace);
return($y_min, $y_max);
}
1;
