[Bps-public-commit] r11238 - WebChart/lib/WebChart/Renderer/GD

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Thu Mar 27 11:57:58 2008
New Revision: 11238

Added:
   WebChart/lib/WebChart/Renderer/GD/
   WebChart/lib/WebChart/Renderer/GD/Graph.pm

Log:
added GD::Graph Renderer

Added: WebChart/lib/WebChart/Renderer/GD/Graph.pm
==============================================================================
--- (empty file)
+++ WebChart/lib/WebChart/Renderer/GD/Graph.pm	Thu Mar 27 11:57:58 2008
@@ -0,0 +1,83 @@
+package WebChart::Renderer::GD::Graph;
+use strict;
+use warnings;
+use Carp;
+
+use base qw/ WebChart::Renderer /;
+use UNIVERSAL::require;
+use File::Spec;
+use File::Temp;
+
+=head2 render
+
+accept the same args as WebChart::render
+in scalar context, returns html segment like <img src="..." />
+in list context, return html segment and the actual file path of the chart.
+
+=cut
+
+sub render {
+
+    my $self = shift;
+    my %args = @_;
+
+    $self->SUPER::render( \%args );
+
+    # GD::Graph types from generic types
+    my %types = (
+        lines          => 'lines',
+        bars           => 'bars',
+        horizontalbars => 'hbars',
+        points         => 'points',
+        linespoints    => 'linespoints',    # non-standart
+        area           => 'area',
+        pie            => 'pie',
+        mixed          => 'mixed',          # non-standard
+    );
+
+    # Convert the generic type to a GD::Graph type
+    $args{type} = $types{ $args{type} } if $types{ $args{type} };
+
+    my $class = "GD::Graph::$args{type}";
+    $class->require or die "can't require $class: $!";
+
+    my $graph = $class->new( $args{width}, $args{height} );
+    $graph->set( %{ $args{options} } ) if $args{options};
+    my $gd = $graph->plot( $args{data} ) or die $graph->error;
+
+    my ( $fd, $filename ) = File::Temp::tempfile(
+        'wc_XXXXXX',
+        SUFFIX  => '.png',
+        DIR     => $args{img_dir},
+        CLEANUP => 0,
+    );
+
+    binmode $fd;
+    print $fd $gd->png;
+
+    my $seg = qq[<img src="$args{web_img_dir}/]
+      . ( File::Spec->splitpath($filename) )[2] . q{"};
+
+    if ( $args{css_class} ) {
+        $seg .= qq{ class="$args{css_class}"};
+    }
+
+    $seg .= q[ />];
+
+    return wantarray ? ( $seg, $filename ) : $seg;
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+sunnavy  C<< <sunnavy at bestpractical.com> >>
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2008 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.