[Bps-public-commit] r11297 - WebChart/lib/WebChart/Renderer

sunnavy at bestpractical.com sunnavy at bestpractical.com
Mon Mar 31 09:15:53 EDT 2008


Author: sunnavy
Date: Mon Mar 31 09:15:47 2008
New Revision: 11297

Added:
   WebChart/lib/WebChart/Renderer/PlotKit.pm

Log:
added plotkit renderer

Added: WebChart/lib/WebChart/Renderer/PlotKit.pm
==============================================================================
--- (empty file)
+++ WebChart/lib/WebChart/Renderer/PlotKit.pm	Mon Mar 31 09:15:47 2008
@@ -0,0 +1,125 @@
+package WebChart::Renderer::PlotKit;
+use strict;
+use warnings;
+use Carp;
+
+use base qw/ WebChart::Renderer /;
+use String::Random;
+use JSON 'to_json';
+
+=head2 render
+
+accept the same args as WebChart::render
+in scalar context, returns html segment that renders chart,
+in list context, return html segment and the actual file path of the chart.
+
+=cut
+
+sub render {
+    my $self = shift;
+    my %args = ( options => {}, @_ );
+    $args{data} =
+      [ @{ $args{data} } ];    # dump one, don't change the original value
+
+    $self->SUPER::render( \%args );
+
+    # translations from generic type to PlotKit types
+    my %types = (
+        lines          => { type => 'line' },
+        bars           => { type => 'bar', barOrientation => 'vertical' },
+        pie            => { type => 'pie' },
+        horizontalbars => { type => 'bar', barOrientation => 'horizontal' },
+    );
+
+    # Make sure the type is ready to be used
+    my $options = $types{ $args{type} } || {};
+    $args{type} = delete $options->{type};
+    $args{options}{$_} = $options->{$_} foreach keys %$options;
+
+    $self->_transform_data( \%args );
+
+    my $r  = String::Random->new;
+    my $id = $r->randregex('\d{6}');
+    my $div;
+    $div = qq[<div><canvas id="$id"];
+    $div .= qq[ class="$args{web_css_class}"] if $args{web_css_class};
+    $div .= qq[ height="$args{height}"]       if $args{height};
+    $div .= qq[ width="$args{width}"]         if $args{width};
+    $div .= qq[ /></div>];
+
+    my $seg = <<"EOF"
+<script type="text/javascript" src="$args{web_js_dir}/mochikit/MochiKit.js"></script>
+<script type="text/javascript" src="$args{web_js_dir}/plotkit/Base.js"></script>
+<script type="text/javascript" src="$args{web_js_dir}/plotkit/Layout.js"></script>
+<script type="text/javascript" src="$args{web_js_dir}/plotkit/Canvas.js"></script>
+<script type="text/javascript" src="$args{web_js_dir}/plotkit/SweetCanvas.js"></script>
+<script type="text/javascript">
+function PlotKitDraw( id, dataset, options ) {
+    return function (){
+        var layout = new PlotKit.Layout("$args{type}", options );
+        for ( var i in dataset ) {
+            layout.addDataset(i, dataset[i] );
+        }
+        layout.evaluate();
+        var canvas = MochiKit.DOM.getElement(id);
+        var plotter = new PlotKit.SweetCanvasRenderer(canvas, layout, options );
+        plotter.render();
+    };
+};
+var options = @{[to_json($args{options})]};
+var dataset = @{[to_json($args{data})]};
+MochiKit.DOM.addLoadEvent(PlotKitDraw('$id', dataset, options ));
+</script>
+
+$div
+
+EOF
+      ;
+
+    return wantarray ? ( $seg, $id ) : $seg;
+}
+
+sub _transform_data {
+    my $self = shift;
+    my $args = shift;
+
+    my @data;
+    my $labels = shift @{ $args->{data} };
+
+    for ( my $i = 0 ; $i < @$labels ; $i++ ) {
+        push @{ $args->{options}{xTicks} }, { v => $i, label => $labels->[$i] }
+          if defined $labels->[$i];
+    }
+
+    for my $dataset ( @{ $args->{data} } ) {
+        my @ds;
+        for ( my $i = 0 ; $i < @$dataset ; $i++ ) {
+
+            # PlotKit can't deal with undefined values
+            if ( not ref $dataset->[$i] ) {
+                push @ds, [ $i, defined $dataset->[$i] ? $dataset->[$i] : '0' ];
+            }
+            else {
+                push @ds, $dataset->[$i];
+            }
+        }
+        push @data, \@ds;
+    }
+
+    $args->{data} = \@data;
+}
+
+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.



More information about the Bps-public-commit mailing list