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

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Mon Mar 31 04:12:39 2008
New Revision: 11290

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

Log:
added XMLSWF renderer

Added: WebChart/lib/WebChart/Renderer/XMLSWF.pm
==============================================================================
--- (empty file)
+++ WebChart/lib/WebChart/Renderer/XMLSWF.pm	Mon Mar 31 04:12:39 2008
@@ -0,0 +1,143 @@
+package WebChart::Renderer::XMLSWF;
+use strict;
+use warnings;
+use Carp;
+
+use base qw/ WebChart::Renderer /;
+use UNIVERSAL::require;
+use File::Spec;
+use File::Temp;
+use XML::Simple;
+
+=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 = (
+        bgcolor => '#ffffff',
+        wmode   => 'transparent',
+        @_
+    );
+
+    $self->SUPER::render( \%args );
+
+    # Conversion from generic types to XML SWF types -- incomplete
+    my %types = (
+        'bars'           => 'column',
+        'stackedbars'    => 'stacked column',
+        'horizontalbars' => 'bar',
+        'lines'          => 'line',
+        'pie'            => '3d pie',
+        'points'         => 'scatter',
+    );
+
+    # Make sure the type is ready to be used
+    $args{type} = $types{ $args{type} } if $types{ $args{type} };
+
+    # The KeyAttr thing is a bloody hack to get ordering right
+    my $xml = XML::Simple->new(
+        RootName => 'chart',
+        KeyAttr  => { row => '+string' },
+    );
+
+    my $labels = shift @{ $args{data} };
+
+    # Base chart options
+    my %chart = (
+        chart_type    => { content     => $args{type} },
+        axis_category => { size        => '11', color => '808080' },
+        axis_value    => { size        => '11', color => '808080' },
+        axis_ticks    => { major_color => '808080' },
+        legend_label  => { size        => '11' },
+        chart_value =>
+          { position => 'cursor', size => '11', color => '666666' },
+        %{ $args{options} || {} },
+        chart_data => { row => [ { string => [ {}, @$labels ], }, ], },
+    );
+
+    for my $i ( 0 .. $#{ $args{data} } ) {
+        push @{ $chart{'chart_data'}{'row'} },
+          {
+            string => [ $args{legend}[$i] || {} ],
+            number => $args{data}[$i],
+          };
+    }
+
+    my ( $fd, $filename ) = File::Temp::tempfile(
+        'wc_XXXXXX',
+        SUFFIX  => '.xml',
+        DIR     => $args{xml_dir},
+        CLEANUP => 0,
+    );
+
+    print $fd $xml->XMLout( \%chart );
+
+    # Build up the chart tag
+    my $src =
+"$args{web_flash_dir}/xmlswf/charts.swf?library_path=$args{web_flash_dir}/xmlswf/charts_library&xml_source=$filename";
+
+    my $tags = {
+        embed => {
+            src           => $src,
+            quality       => 'high',
+            bgcolor       => $args{bgcolor},
+            width         => $args{width},
+            height        => $args{height},
+            wmode         => $args{wmode},
+            type          => 'application/x-shockwave-flash',
+            swLiveConnect => 'true',
+            pluginspage   => 'http://www.macromedia.com/go/getflashplayer',
+        },
+        object => {
+            classid => 'clsid:D27CDB6E-AE6D-11cf-96B8-444553540000',
+            codebase =>
+'http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0',
+            width  => $args{width},
+            height => $args{height},
+            $args{web_css_class} ? ( class => $args{web_css_class} ) : (),
+        },
+        params => {
+            movie   => $src,
+            quality => 'high',
+            bgcolor => $args{bgcolor},
+            wmode   => $args{wmode},
+        },
+    };
+
+    my $seg = "<div>\n<object";
+    $seg .= qq[ $_="@{[$tags->{object}{$_}]}"] for keys %{ $tags->{object} };
+    $seg .= ">\n";
+
+    $seg .=
+      qq[<param name="$_" value="@{[$tags->{params}{$_}]}" />\n]    # /damn vim
+      for keys %{ $tags->{params} };
+
+    $seg .= "<embed";
+    $seg .= qq[ $_="@{[$tags->{embed}{$_}]}"] for keys %{ $tags->{embed} };
+    $seg .= " />\n";
+    $seg .= "</object>\n";
+    $seg .= "</div>\n";
+
+    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.