package SWF::Chart;

=pod

=head1 NAME

SWF::Chart - Perl interface to the SWF Chart generation tool

=head1 SYNOPSIS

  use SWF::Chart;

  $g->set_titles(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));

  $g->add_dataset([qw(1 3 5 7 11 13 17 23 29 31 37 41)],
                  [qw(1 1 2 3 5 8 13 21 34 55 89 144)]);

  $g->text_properties(bold  => 0,
                      size  => 10,
                      color => '333333');

  $g->chart_bg(positive_color => '555555',
               positive_alpha => 100);

  $g->series_color('DEADBE');

  print $g->xml;

=head1 DESCRIPTION

This module is the Perl interface to the SWF Charts flash graphing tool.  It constructs the XML file this flash movie requires via an OO interface.  Each configurable option that is listed on the SWF Charts reference page has a companion method in this module.  See:

  http://www.maani.us/charts/index.php?menu=Reference

Note that there are a few extra helper functions that this module provides.

=over 4

=item chart_data (set_titles/add_dataset)

The 'chart_data' option has been split into two different methods, 'set_titles' and 'add_dataset'.  The original 'chart_data' option held all of this information, but from an interface standpoint, it makes more sense to separate these.

=item text_properties

This method sets the 'font', 'bold', 'size' and 'color' properties of all options that effect text ('axis_category', 'axis_value', 'chart_value', 'legend_label' and 'draw_text').  See "L<text_properties|/"MODULE SPECIFIC METHODS">" for more information.

=item hide_legend

This method employes a hack to hide the legend of a graph since this option does not currently exist in SWF Chart.

=back

=head1 MODULE SPECIFIC METHODS

The following methods do not have a direct analog to any SWF Chart option.

=over 4

=cut

#--------------------------------------#
# Dependencies

use strict;

#--------------------------------------#
# Global Variables

our $VERSION = '1.0';

#--------------------------------------#
# Constants

# The OPTIONS hash keeps track of how all the options are represented in XML.
# If the first value is 'elem' it means that the option is a single element.
# For 'elem', if there is no second value, then that option is an empty content
# element that uses parameters, ie:
#
#   foobar => ['elem']
#
# and if the set call for this option looks like:
#
#   $g->foobar(param1 => 'value1', param2 => 'value2')
#
# then this XML will be produced:
#
#   <foobar param1="value1" param2="value2" />
#
# For 'elem', if the second value is 1, then the element has content, ie:
#
#   fizpow => ['elem', 1]
#
# and if the set call for this option looks like:
#
#   $g->fizpow('value')
#
# then this XML will be produced:
#
#   <fizpow>value</fizpow>
#
# If the first value if 'container' then the second value will be another option
# in OPTIONS that gives the format for the elements contained by this container.
# For example, if the option definition is:
#
#   mumblyjoe => ['container', 'fizpow']
#
# and if the set call for this option looks like:
#
#   $g->mumblyjoe('foo');
#   $g->mumblyjoe('bar');
#
# then this XML will be produced:
#
#   <mumblyjoe><fizpow>foo</fizpow><fizpow>bar</fizpow></mumblyjoe>
#
# To get different behavior, override the default AUTOLOAD method.

use constant OPTIONS => {
                         axis_category    => ['elem'],
                         axis_ticks       => ['elem'],
                         axis_value       => ['elem'],
                         axis_value_text  => ['container', 'string'],

                         chart_border     => ['elem'],
                         chart_data       => ['elem'],
                         chart_grid_h     => ['elem'],
                         chart_grid_v     => ['elem'],
                         chart_pref       => ['elem'],
                         chart_rect       => ['elem'],

                         chart_type       => ['elem', 1],
                         chart_value      => ['elem'],
                         chart_value_text => ['elem'],

                         draw_circle      => ['container', 'circle'],
                         draw_image       => ['container', 'image'],
                         draw_line        => ['container', 'line'],
                         draw_rect        => ['container', 'rect'],
                         draw_text        => ['container', 'text'],

                         legend_label      => ['elem'],
                         legend_rect       => ['elem'],
                         legend_transition => ['elem'],

                         link             => ['elem'],
                         link_data        => ['elem'],

                         live_update      => ['elem'],

                         series_color     => ['container', 'color'],
                         series_explode   => ['container', 'number'],
                         series_gap       => ['elem'],
                         series_switch    => ['elem'],

                         circle           => ['elem'],
                         line             => ['elem'],
                         rect             => ['elem'],
                         text             => ['elem'],
                         string           => ['elem', 1],
                         color            => ['elem', 1],
                         number           => ['elem', 1],
                        };

# A list of properties that if passed to any of the above options should be
# considered text properties.
use constant TEXT_PROPS => {font  => 1,
                            bold  => 1,
                            size  => 1,
                            color => 1,
                           };

#--------------------------------------#
# Public Class Methods

=pod

=item $g = SWF::Chart->new

Creates a new SWF Chart object.  Does not take any parameters.

=cut

sub new {
    my $class = shift;
    my $self = bless {}, ref $class || $class;

    return $self;
}

sub DESTROY { }

#--------------------------------------#
# Public Instance Methods

=pod

=item $g->set_titles

Sets the titles for each column of data.  There should be as many titles as data points you pass to 'add_dataset'. If this method is called multiple times, only the last set of titles given will be used.

=cut

sub set_titles {
    my $self = shift;
    my (@titles) = @_;

    # Allow either an array ref or an actual array to be passed in
    $self->{rows}->[0] = ref $titles[0] ? $titles[0] : \@titles;

    # Make sure to include the required empty cell for the title row
    unshift @{$self->{rows}->[0]},  undef;
}

=pod

=item $g->add_dataset(\@row1, \@row2, \@rows)

Adds rows of data to be charted.  Accepts a list of array references.  If this method is called more than once, each row is added after the existing rows rather than replacing them.

=cut

sub add_dataset {
    my $self = shift;
    my (@set) = @_;

    # Initialize rows with a blank first row saved for the titles
    $self->{rows} ||= [undef];

    push @{$self->{rows}}, ref $set[0] ? $set[0] : \@set;
}

=pod

=item $g->hide_legend

This method is a hack to allow easy hiding of the legend.  It achives this by setting the legend y-coordinate to -9999, placing it (hopefully) far off canvas.  If at some point a native 'hide_legend' is implimented, that will be used instead.

=cut

sub hide_legend {
    my $self = shift;

    # This is the ordained way to remove the legend...yuk
    $self->legend_rect(y => -9999);
}

=pod

=item $g->text_properties(%param)

This method sets text properties for all options that affect text.  This makes it easy to sets the font for all text in a graph to be 'Arial', or all to a particular point size.  The keys to %param are the properties that can be changed:

=over 4

=item font

The font face to use for all text.  Arial is the default font and is the only one embedded in the flash movie.  If any other font is set here it must be installed on the clients machine or SWF Chart will default to the closest font.

=item bold

A boolean that determines whether the font is bold or not

=item size

The font size in points

=item color

The hex color for text

=back

This method acts as a convience method to set all text properties at once.  This means that if you call this after setting font properties for a specific option, those values will be overwritten. If you would prefer this to operate as a way to set defaults, then call this method first and then set the additional font prorperites.

=cut

sub text_properties {
    my $self = shift;
    my (%param) = @_;

    # Clean the values on the way in so we don't inadvertantly overwrite stuff
    foreach my $k (keys %param) {
        delete $param{$k} unless exists TEXT_PROPS->{$k};
    }
    $self->{defaults}->{text_props} = \%param;

    # Set the defaults for attribute only tags
    $self->axis_category(%param);
    $self->axis_value(%param);
    $self->chart_value(%param);
    $self->legend_label(%param);

    # Set the defaults for the draw_text tags
    if (exists $self->{opts}->{draw_text}) {

        # Get the array of <text> elements and loop through them
        my $text = $self->{opts}->{draw_text}->[2];
        foreach my $t (@$text) {

            # Iterate over each attribute currently set on this <text> element
            foreach my $k (keys %param) {

                # Update it unless its already set
                next if exists $t->[1]->{$k};
                $t->[1]->{$k} = $param{$k};
            }
        }
    }
}

=pod

=back

=head1 SWF CHART METHODS

The following methods have a direct relationship to the options SWF Charts accepts.  Please refer to the SWF Chart reference page for details on these options.  These methods are split into three categories:

=head2 Parameter Methods

These methods take a hash of parameters that map to the parameters given on the SWF Chart reference page.  If called more than once, each call overwrites the previous parameter values.  If a particular parameter is not given, then the previous value for that parameter is retained.  Example:

  $g->chart_border(color            => '00FF00',
                   top_thickness    => 0,
                   bottom_thickness => 0);

The 'chart_border' option now has a border color of '00FF00' and zero top and bottom thickness.  After this call:

  $g->chart_border(top_thickness    => 5,
                   bottom_thickness => 5);

The top and bottom thickness will become 5, but the color will remain '00FF00'.

=over 4

=item *

$g->axis_category(%param)

=item *

$g->axis_ticks(%param)

=item *

$g->axis_value(%param)

=item *

$g->chart_border(%param)

=item *

$g->chart_data(%param)

=item *

$g->chart_grid_h(%param)

=item *

$g->chart_grid_v(%param)

=item *

$g->chart_pref(%param)

=item *

$g->chart_rect(%param)

=item *

$g->chart_value(%param)

=item *

$g->chart_value_text(%param)

=item *

$g->legend_bg(%param)

=item *

$g->legend_label(%param)

=item *

$g->legend_rect(%param)

=item *

$g->link(%param)

=item *

$g->link_data(%param)

=item *

$g->live_update(%param)

=item *

$g->series_gap(%param)

=item *

$g->series_switch(%param)

=back

=head2 Value Methods

These methods take a scalar value.  If called more than once, each call overwrites the previous value.

=over 4

=item *

$g->chart_type($value)

=back

=head2 Repeatable Methods

These methods can be called more than once.  Each time they are called they add additional data rather than replace existing data.  Currently there is no way to change the parameters given on previous calls.

=over 4

=item *

$g->draw_circle(%param)

=item *

$g->draw_image(%param)

=item *

$g->draw_line(%param)

=item *

$g->draw_rect(%param)

=item *

$g->draw_text($text, %param)

=item *

$g->series_color($value)

=item *

$g->series_explode($value)

=back

=cut

sub draw_text {
    my $self = shift;
    my ($text, %param) = @_;
    my $data = $self->{opts}->{draw_text} ||= ['draw_text', undef, []];
    my $text_defaults = $self->{defaults}->{text_props};

    # If there are defaults copy them to the unset values
    if ($text_defaults) {
        foreach my $k (keys %$text_defaults) {
            next if exists $param{$k};
            $param{$k} = $text_defaults->{$k};
        }
    }

    push @{$data->[2]}, ['text', \%param, $text];
}

use vars qw( $AUTOLOAD );
sub AUTOLOAD {
    my $obj = $_[0];
    (my $option = $AUTOLOAD) =~ s!.+::!!;
    no strict 'refs';

    my $type = OPTIONS->{$option};

    die "No such graph option '$option'" unless $type;

    if ($type->[0] eq 'elem') {
        # This type just sets a single value with no attributes
        if ($type->[1]) {
            *$AUTOLOAD = sub {
                my $self = shift;
                my ($value) = @_;
                $self->{opts}->{$option} = [$option, undef, $value];
            };
        }
        # This type just sets attributes with no value
        else {
            *$AUTOLOAD = sub {
                my $self = shift;
                my (%param) = @_;
                my $elem = $self->{opts}->{$option} ||= [$option, {}];

                # Update each attribute
                foreach my $k (keys %param) {
                    $elem->[1]->{$k} = $param{$k};
                }
            };
        }
    } elsif ($type->[0] eq 'container') {
        *$AUTOLOAD = sub {
            my $self = shift;
            my $data = $self->{opts}->{$option} ||= [$option, undef, []];

            push @{$data->[2]}, (@_ % 2 ? [$type->[1], undef, $_[0]]
                                        : [$type->[1], {@_}]);
        };
    }

    goto &$AUTOLOAD;
}

sub xml {
    my $self = shift;
    my $output = '<?xml version="1.0" encoding="utf-8"?><chart>';

    # Output all the chart preferences and settings
    foreach my $opt (keys %{$self->{opts}}) {
        $output .= $self->_elem_as_string($self->{opts}->{$opt});
    }

    # Output the data for this chart
    $output .= '<chart_data>';
    my $rows = $self->{rows};

    # Write the labels for the chart
    $output .= $self->_xml_chart_data_labels($rows->[0]);

    # Write the rows
    foreach my $r (@$rows[1..$#$rows]) {
        $output .= $self->_xml_chart_data_row($r);
    }

    $output .= '</chart_data>';
    $output .= '</chart>';

    return $output;
}

#--------------------------------------#
# Private Instance Methods

sub _xml_chart_data_labels {
    my $self = shift;
    my ($row) = @_;
    my $output = '<row><null/>';

    foreach my $t (@$row[1..$#$row]) {
        $output .= "<string>$t</string>";
    }

    $output .= '</row>';

    return $output;
}

sub _xml_chart_data_row {
    my $self = shift;
    my ($row) = @_;
    my $output = '<row>';

    if ($row->[0]) {
        $output .= '<string>'.$row->[0].'</string>';
    } else {
        $output .= '<null/>';
    }

    foreach my $n (@$row[1..$#$row]) {
        $n ||= '' unless defined $n;
        $output .= "<number>$n</number>";
    }

    $output .= '</row>';

    return $output;
}

# ['name', {param => 1}, [$child1, $child2, $child3]]
sub _elem_as_string {
    my $self = shift;
    my ($node) = @_;
    my ($name, $attr, $value) = @$node;
    my $out = "<$name";

    $out .= ' '.join(' ', map { $_.'="'.$attr->{$_}.'"' } keys %$attr) if $attr;

    if ($value) {
        $out .= '>';

        if (ref $value) {
            foreach my $child (@$value) {
                $out .= $self->_elem_as_string($child);
            }
        } else {
            $out .= $value;
        }

        $out .= "</$name>";
    } else {
        $out .= ' />';
    }

    return $out;
}

1;

__END__

=pod

=head1 BUGS

No known bugs

=head1 AUTHOR

Garth Webb <garth@sixapart.com>

=head1 VERSION

Version 1.0 (27 June 2005)

=head1 SEE ALSO

L<perl>, L<http://www.maani.us/charts/index.php>

=head1 COPYRIGHT AND LICENSE

Copyright 2005, Six Apart, Ltd.

=cut
