File Coverage

blib/lib/SVG/Sparkline.pm

Criterion	Covered	Total	%
statement	139	141	98.5
branch	50	52	96.1
condition	8	9	88.8
subroutine	32	34	94.1
pod	4	4	100.0
total	233	240	97.0

package SVG::Sparkline;

use warnings;
use strict;
use Carp;
use SVG;

use overload  '""' => \&to_string;

use 5.008000;
our $VERSION = 1.12;

my %valid_parms = map { $_ => 1 } qw(
        -allns color -sized
        height width xscale yscale pady padx
        color bgcolor mark values
);

sub new
{
    my ($class, $type, $args) = @_;
    croak "No Sparkline type specified.\n" unless defined $type;
    croak "'$type' is not a valid Sparkline type.\n" unless $type =~ m/\A[A-Z]\w+\z/;
    # Use eval to load plugin. Should be safe because of the test above.
    eval "use SVG::Sparkline::$type;";  ## no critic (ProhibitStringyEval)
    croak "Unrecognized Sparkline type '$type'.\n" if $@;
    croak "Missing arguments hash.\n" unless defined $args;
    croak "Arguments not supplied as a hash reference.\n" unless 'HASH' eq ref $args;
    _no_unrecognized_parameters( $type, $args );

    my $self = bless {
        -allns => 0,
        color => '#000',
        -sized => 1,
        %{$args},
    }, $class;

    $self->_validate_pos_param( 'height', 12 );
    $self->_validate_pos_param( 'width', 0 );
    $self->_validate_pos_param( 'xscale' );
    $self->_validate_pos_param( 'yscale' );
    $self->_validate_nonneg_param( 'pady', 1 );
    $self->_validate_nonneg_param( 'padx', 0 );
    $self->_validate_mark_param();
    foreach my $arg (qw/color bgcolor/)
    {
        next unless exists $self->{$arg};
        croak "The value of $arg is not a valid color.\n"
            unless _is_color( $self->{$arg} );
    }

    $self->{xoff} = -$self->{padx};
    $self->_make( $type );

    return $self;
}

sub get_height { return $_[0]->{height}; }
sub get_width { return $_[0]->{width}; }

sub to_string
{
    my ($self) = @_;
    my $str = $self->{_SVG}->xmlify();
    # Cleanup
    $str =~ s/ xmlns:(?:svg|xlink)="[^"]+"//g unless $self->{'-allns'};
    unless( $self->{'-sized'} )
    {
        # If I try to keep them from being created, default '100%' values
        # show up instead.
        $str =~ s/(]*) height="[^"]+"/$1/;
        $str =~ s/(]*) width="[^"]+"/$1/;
    }
    return $str;
}

sub _make
{
    my ($self, $type) = @_;
    $self->{_SVG} = "SVG::Sparkline::$type"->make( $self );
    return;
}

sub _no_unrecognized_parameters {
    my ( $type, $args ) = @_;
    my $class = "SVG::Sparkline::$type";
    foreach my $parm (keys %{$args}) {
        croak "Parameter '$parm' not recognized for '$type'\n"
            unless exists $valid_parms{$parm} || $class->valid_param( $parm );
    }
    return;
}

sub _validate_pos_param
{
    my ($self, $name, $default) = @_;
    croak "'$name' must have a positive numeric value.\n"
        if exists $self->{$name} && $self->{$name} <= 0;
    return if exists $self->{$name};

    $self->{$name} = $default if defined $default;
    return;
}

sub _validate_nonneg_param
{
    my ($self, $name, $default) = @_;
    croak "'$name' must be a non-negative numeric value.\n"
        if exists $self->{$name} && $self->{$name} < 0;
    return if exists $self->{$name};

    $self->{$name} = $default if defined $default;
    return;
}

sub _validate_mark_param
{
    my ($self) = @_;

    return unless exists $self->{mark};

    croak "'mark' parameter must be an array reference.\n"
        unless 'ARRAY' eq ref $self->{mark};
    croak "'mark' array parameter must have an even number of elements.\n"
        unless 0 == (@{$self->{mark}}%2);

    my @marks = @{$self->{mark}};
    while(@marks)
    {
        my ($index, $color) = splice( @marks, 0, 2 );
        croak "'$index' is not a valid mark index.\n"
            unless $index =~ /^(?:first|last|high|low|\d+)$/;
        croak "'$color' is not a valid mark color.\n"
            unless _is_color( $color );
    }
    return;
}

sub _is_color
{
    my ($color) = @_;
    return 1 if $color =~ /^#[[:xdigit:]]{3}$/;
    return 1 if $color =~ /^#[[:xdigit:]]{6}$/;
    return 1 if $color =~ /^rgb\(\d+,\d+,\d+\)$/;
    return 1 if $color =~ /^rgb\(\d+%,\d+%,\d+%\)$/;
    return 1 if $color =~ /^[[:alpha:]]+$/;
    return;
}

1;

__END__