File Coverage

lib/GD/Graph/Thermometer.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package GD::Graph::Thermometer;

use warnings;
use strict;
use Carp;
use CGI;
use GD;
use GD::Text::Align;
use Data::Dumper;
use constant PI => 3.14;

use vars qw($VERSION);
$VERSION = '0.05';

my $cgi = CGI->new();

sub new {
  my $self = shift;
  my $args = shift;

  my $missing_arguments = 0;
  foreach my $key qw( goal current ){
    if(!defined($args->{$key})) { $missing_arguments++ };
  }
  if($missing_arguments){
    croak "GD::Graph::Thermometer requires that the 'goal' and 'current' keys be defined in its constructor.  All other arguments are optional and default values will be substituted for any missing values";
  }

  if(!defined($args->{'title'})){
    $args->{'title'} = "";
    carp "The call to GD::Graph::Thermometer failed to define a title for the resulting graph.";
  }

  if(!defined($args->{'width'})){
    $args->{'width'} = '100';
  }

  if(!defined($args->{'height'})){
    $args->{'height'} = '200';
  }

  my $image = new GD::Image($args->{width},$args->{height});
  my $colors = $self->_define_colors($image, {
       background_color => $args->{'background_color'},
          outline_color => $args->{'outline_color'},
             text_color => $args->{'text_color'},
          mercury_color => $args->{'mercury_color'}
       });

  my $top = ($args->{'height'} * .04);
  my $bottom = ($args->{'height'} * .80);
  my $diff = $bottom - $top;
  my $left_text_margin = ($args->{'width'} * .38);
  my $diameter = ($args->{'width'} * .36);

  # background, set tranparent if you want
  $image->filledRectangle( 0, 0, $args->{'width'}, $args->{'height'}, $colors->{'background_color'} );

  # $image->rectangle($x1,$y1,$x2,$y2,$color)
  if($args->{'transparent'} == '1'){
    $image->transparent($colors->{'background_color'});
  }
  $image->rectangle(($args->{'width'} * .16),($args->{'height'} * .04),($args->{'width'} * .32),($args->{'height'} * .85),$colors->{'outline_color'});

  # $image->filledEllipse($cx,$cy,$width,$height,$color)
  $image->filledEllipse(($args->{'width'} * .24),($args->{'height'} * .90),($args->{'width'} * .36),($args->{'width'} * .36),$colors->{'mercury_color'});

  # mercury rising . . .
  $image->filledRectangle(($args->{'width'} * .16),($args->{'height'} * .80),($args->{'width'} * .32),($args->{'height'} * .85),$colors->{'mercury_color'});

  # add labels to graph
  $image = $self->_add_labels($image,$args->{'goal'},$args->{'current'},$colors->{'text_color'},$colors->{'mercury_color'},$left_text_margin,$top,$bottom,$diff,$args->{'width'},$args->{'height'});

  # display title
  $self->_display_title($image,$colors->{'text_color'},$args->{'title'},$args->{'width'},$bottom);

  # render image as a .png file
  $self->_render_image($image, $args->{'image_path'}, $args->{'type'});

  return;
}

sub _render_image {
  my $self = shift;
  my $image = shift;
  my $image_path = shift;
  my $type = shift;

  if(!defined($type)){
    $type = 'png';
  }

  if(defined($image_path)){
    open( "IMAGE", ">", "$image_path") || die "Couldn't open file: $image_path.  $!\n";
    binmode( IMAGE );
    print IMAGE $image->$type();
    close IMAGE;
  } else {
    print $cgi->header("image/$type");
    binmode STDOUT;
    print $image->$type;
  }

  return;
}

sub _add_labels {
  my($self,$image,$goal,$current,$text_color,$red,$left_text_margin,$top,$bottom,$diff,$w,$h) = @_;
  my $text = new GD::Text::Align(
         $image,
         font => gdTinyFont,
         text => $goal.' Goal',
        color =>  $text_color,
       valign => "center",
       halign => "left",
       );

  #draw goal at top
  $text->draw($left_text_margin,$top);

  #draw start at bottom
  if (($current / $goal) > .10){
    $text->set_text('0 Start');
    $text->draw($left_text_margin,$bottom);
  }
  my $curpix = ($h * .80) - ($diff/$goal) * $current;

  # draw
  $text->set_text("$current Current");
  $text->draw($left_text_margin,$curpix);
  $image->filledRectangle(($w * .16),$curpix,($w * .32),($h * .85),$red);
  return $image;
}

sub _display_title {
  my ($self,$image,$color,$title,$w,$bottom) = @_;
  my $set_title = GD::Text::Align->new($image,
      vtitle => 'top',
      htitle => 'right',
      color => $color,
    );
  $set_title->set_font('arial', 12);
  $set_title->set_text($title);
  my @bb = $set_title->bounding_box(($w * .10), $bottom, (PI/2));
  $set_title->draw(($w * .10),$bottom,(PI/2));
  return $image;
}

sub _define_colors {
  my $self = shift;
  my $image = shift;
  my $custom_colors = shift;

  my $background_color;
  if (defined($custom_colors->{'background_color'})) {
    $background_color = $image->colorAllocate(
        $custom_colors->{'background_color'}[0],
        $custom_colors->{'background_color'}[1],
        $custom_colors->{'background_color'}[2]
      );
  } else {
    $background_color = $self->_white($image);
  }

  my $outline_color;
  if (defined($custom_colors->{'outline_color'})) {
    $outline_color = $image->colorAllocate(
        $custom_colors->{'outline_color'}[0],
        $custom_colors->{'outline_color'}[1],
        $custom_colors->{'outline_color'}[2]
      );
  } else {
    $outline_color = $self->_black($image);
  }

  my $text_color;
  if (defined($custom_colors->{'text_color'})) {
    $text_color = $image->colorAllocate(
        $custom_colors->{'text_color'}[0],
        $custom_colors->{'text_color'}[1],
        $custom_colors->{'text_color'}[2]
      );
  } else {
    $text_color = $self->_black($image);
  }

  my $mercury_color;
  if (defined($custom_colors->{'mercury_color'})) {
    $mercury_color = $image->colorAllocate(
        $custom_colors->{'mercury_color'}[0],
        $custom_colors->{'mercury_color'}[1],
        $custom_colors->{'mercury_color'}[2]
      );
  } else {
    $mercury_color = $self->_red($image);
  }

  my $colors = {
    background_color => $background_color,
       outline_color => $outline_color,
          text_color => $text_color,
       mercury_color => $mercury_color
       };

  return $colors;
}

sub _black {
  my $self = shift;
  my $image = shift;
  my $color = $image->colorAllocate(0,0,0);
  return $color;
}

sub _white {
  my $self = shift;
  my $image = shift;
  my $color = $image->colorAllocate(255,255,255);
  return $color;
}

sub _red {
  my $self = shift;
  my $image = shift;
  my $color = $image->colorAllocate(255,0,0);
  return $color;
}

1; # Magic true value required at end of module
__END__