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.02'; 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) $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__ =head1 NAME GD::Graph::Thermometer - Generate progress graph on the fly =head1 VERSION This document describes GD::Graph::Thermometer version 0.0.1 =head1 SYNOPSIS use GD::Graph::Thermometer; my $result = GD::Graph::Thermometer->new({ image_path => '/path/to/image.png', type => 'png', goal => '80000', current => '20000', title => 'Funding the League for the Year ($)', width => '100', height => '200', background_color => [ r, g, b ], text_color => [ r, g, b ], outline_color => [ r, g, b ], mercury_color => [ r, g, b ] }); =head1 DESCRIPTION When deployed in production, the current value ought to be dynamically calculated based on a query of the database tracking contributions or volunteers or whatever the goal represented by the graph represents. =head2 my $result = GD::Graph::Thermometer->new({}); This module exports only one method, its constructor, ->new(), which creates a .png (by default) image file of the thermometer graph with the path and name defined in its constructor. If no image_path is defined in the constructor, then the module will print the image directly to STDOUT. The anonymous hash fed to the constructor must define values for the keys: goal and current. Otherwise a fatal error will be thrown. Current should represent the progress made toward the goal being graphed since the beginning of the campaign. The output format defaults to png if the key 'type' is undefined, otherwise a user may specify png, gif or jpeg as the output format. These correspond to the GD::Image-> methods by the same name, which are used to implement the ->_render_image() internal method. The size parameters will default to 100 pixels wide by 200 pixels tall, if those arguments are missing from the anonymous hash given to the constructor. If title is not defined a warning will be thrown, but the graph will still be generated. The colors for the background, text, outline and mercury will default to white, black, black and red respectively, if not otherwise defined in the constructor. If defined in the constructor, they should be defined as an anonymous array of three values ( => [ r, g, b ],), range 0 - 255, suitable for feeding to the GD::Image->colorAllocate() method. =head1 DIAGNOSTICS =for author to fill in: List every single error and warning message that the module can generate (even the ones that will "never happen"), with a full explanation of each problem, one or more likely causes, and any suggested remedies. =over =item C<< Couldn't open file . . . >> The system user under which this module was invoked does not have sufficient permission to write to the result image file. Make sure that the user has write permission on the target directory, or alternately, touch the file into existance and use chown and chmod to give write permissions on the result file itself to the user which will invoke the module. If this is run by your web server, that user is likely nobody, apache, www-data or something similiar. =item C<< The call to GD::Graph::Thermometer failed to define a title for the resulting graph. >> Add "title => 'This is the title of my graph'," to your constructor, otherwise the module will throw this error and produce a graph without an explanatory title. [=item C<< Error message here, perhaps with %s placeholders >>] [Description of error here] =back =head1 CONFIGURATION AND ENVIRONMENT GD::Graph::Thermometer requires no configuration files or environment variables. =head1 DEPENDENCIES This module depends on GD and GD::Text::Align. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND LIMITATIONS At present this module will produce a reasonable looking graphic when the image uses its default size (100 x 200 pixels). For reasons I don't yet quite understand, changing these arguments creates distorted images. Perhaps future development might address this issue. Please report any bugs or feature requests to C, or through the web interface at L. =head1 AUTHOR Hugh Esco C<< >> =head1 ACKNOWLEDGEMENTS This module would not have been possible without the work of Lincoln Stein, who's GD:: heirarchy of modules makes this possible. And while I'm at it, let me also thank him for CGI.pm, which has made all of our lives much easier. =head1 LICENCE AND COPYRIGHT Copyright (c) 2007, Hugh Esco C<< >>. All rights reserved. This module was created to serve an immediate need. However it is not central to the current focus of my development work. While I am not abandoning this code as unmaintained, I do invite others, particularly those with more experience developing modules in the GD:: heirarchy to consider adopting and maintaining this module. Please contact me by email if you are interested. This module is free software; you can redistribute it and/or modify it under the terms of the Gnu Public License. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.