cvs commit: p5ee/App-Widget/lib/App/Widget Graph.pm

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>&nbsp;$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(\@index_keys);
          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} = \@yn;
  
      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} = \@y_labels;
      }
  
      {
          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} = \@x;
      }
      &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;