File Coverage

blib/lib/Chart/ECharts.pm

Criterion	Covered	Total	%
statement	33	214	15.4
branch	0	48	0.0
condition	1	24	4.1
subroutine	11	46	23.9
pod	35	35	100.0
total	80	367	21.8

package Chart::ECharts;

use feature ':5.10';
use strict;
use utf8;
use warnings;

use Digest::SHA qw(sha1_hex);
use File::Basename;
use File::ShareDir qw(dist_file);
use File::Spec;
use IPC::Open3;
use JSON::PP ();

our $VERSION = '1.03';
$VERSION =~ tr/_//d;    ## no critic

use constant DEBUG => $ENV{ECHARTS_DEBUG} || 0;

sub new {

    my $class = shift;

    my %params = (
        charts_object    => 'ChartECharts',
        class            => 'chart-container',
        container_prefix => '',
        dataset          => [],
        events           => {},
        scripts          => [],
        height           => undef,
        id               => ('chart_' . get_random_id()),
        locale           => 'en',
        options          => {},
        renderer         => 'canvas',
        responsive       => 0,
        series           => [],
        styles           => ['min-width:auto', 'min-height:300px'],
        theme            => 'white',
        vertical         => 0,
        width            => undef,
        xAxis            => [],
        yAxis            => [],
        init_method      => 'event',
        init_event       => 'load',
        @_
    );

    my $self = {%params};

    $self->{js} = {};

    return bless $self, $class;

}

sub chart_id { shift->{id} }

sub init_function { join '_', 'init', shift->{id} }

sub set_options {
    my ($self, %options) = @_;
    $self->{options} = {%{$self->{options}}, %options};
}

sub set_option {
    Carp::carp 'DEPRECATED use $chart->set_options(%params)';
    shift->set_options(@_);
}

sub set_option_item {
    my ($self, $name, $params) = @_;
    $self->{options}->{$name} = $params;
}

sub set_title {
    my ($self, %params) = @_;
    $self->set_options(title => \%params);
}

sub set_tooltip {
    my ($self, %params) = @_;
    $self->set_options(tooltip => \%params);
}

sub set_toolbox {
    my ($self, %params) = @_;
    $self->set_options(toolbox => \%params);
}

sub set_legend {
    my ($self, %params) = @_;
    $self->set_options(legend => \%params);
}

sub set_timeline {
    my ($self, %params) = @_;
    $self->set_options(timeline => \%params);
}

sub set_data_zoom {
    my ($self, %params) = @_;
    $self->set_options(dataZoom => \%params);
}

sub add_data_zoom {

    my ($self, %params) = @_;

    $self->{options}->{dataZoom} //= [];
    push @{$self->{options}}, \%params;

}

sub get_random_id {
    return sha1_hex(join('', time, rand));
}

sub set_event {
    my ($self, $event, $callback) = @_;
    $self->{events}->{$event} = $callback;
}

sub add_script {
    my ($self, $script) = @_;
    push @{$self->{scripts}}, $script;
}

sub on { shift->set_event(@_) }

sub set_xAxis {
    my ($self, %axis) = @_;
    $self->{xAxis} = \%axis;
}

sub add_xAxis {
    my ($self, %axis) = @_;
    push @{$self->{xAxis}}, \%axis;
}

sub set_yAxis {
    my ($self, %axis) = @_;
    $self->{yAxis} = \%axis;
}

sub add_yAxis {
    my ($self, %axis) = @_;
    push @{$self->{yAxis}}, \%axis;
}

sub add_series {
    my ($self, %series) = @_;
    push @{$self->{series}}, \%series;
}

sub add_dataset {
    my ($self, %dataset) = @_;
    push @{$self->{dataset}}, \%dataset;
}

sub xAxis   { shift->{xAxis} }
sub yAxis   { shift->{yAxis} }
sub series  { shift->{series} }
sub dataset { shift->{dataset} }

sub default_options { {} }

sub options {

    my ($self) = @_;

    my $default_options = $self->default_options;
    my $global_options  = $self->{options};

    my $default_series_options = delete $default_options->{series} || {};
    my $series_options         = delete $global_options->{series}  || {};

    my $options = {series => $self->series};

    for (my $i = 0; $i < @{$options->{series}}; $i++) {
        $options->{series}->[$i] = {%{$options->{series}->[$i]}, %{$default_series_options}};
        $options->{series}->[$i] = {%{$options->{series}->[$i]}, %{$series_options}};
    }

    if (@{$self->dataset}) {
        if (scalar @{$self->dataset} == 1) {
            $options->{dataset} = $self->dataset->[0];
        }
        else {
            $options->{dataset} = \@{$self->dataset};
        }
    }

    $options = {%{$options}, %{$self->axies}, %{$default_options}, %{$global_options}};

    return $options;

}

sub axies {

    my ($self) = @_;

    if ($self->{vertical}) {
        return {xAxis => $self->yAxis, yAxis => $self->xAxis};
    }

    return {xAxis => $self->xAxis, yAxis => $self->yAxis};

}

sub render_script {

    my ($self, %params) = @_;

    my $chart_id      = $self->{id};
    my $charts_object = $self->{charts_object};
    my $theme         = $self->{theme};
    my $renderer      = $self->{renderer};
    my $locale        = $self->{locale};
    my $container     = join '', $self->{container_prefix}, $chart_id;
    my $init_event    = $self->{init_event};
    my $init_method   = $self->{init_method};

    my $wrap = $params{wrap} //= 0;

    Carp::croak 'Malformed chart "id" name'      if ($chart_id      !~ /^[a-zA-Z0-9_-]*$/);
    Carp::croak 'Malformed "charts_object" name' if ($charts_object !~ /^[a-zA-Z0-9_-]*$/);
    Carp::croak 'Malformed chart "theme"'        if ($theme         !~ /^[a-zA-Z0-9_-]*$/);
    Carp::croak 'Malformed chart "container"'    if ($container     !~ /^[a-zA-Z0-9_-]*$/);
    Carp::croak 'Malformed chart "locale"'       if ($locale        !~ /^[a-zA-Z_-]*$/);
    Carp::croak 'Malformed chart "renderer"'     if ($renderer      !~ /^(svg|canvas)$/);
    Carp::croak 'Malformed init event name'      if ($init_event    !~ /^[a-zA-Z\_\-\:]*$/);
    Carp::croak 'Unknown "init_method"'          if ($init_method   !~ /^(event|iife)$/);

    my $json = JSON::PP->new;

    $json->utf8->canonical->allow_nonref->allow_unknown->allow_blessed->convert_blessed->escape_slash(0);

    my $option = $json->encode($self->options);

    foreach my $identifier (keys %{$self->{js}}) {

        my $search  = qr/"\{JS:$identifier\}"/;
        my $replace = $self->{js}->{$identifier};

        $option =~ s/$search/$replace/;

    }

    my @script = ();

    my $init_options = $json->encode({locale => $locale, renderer => $renderer});

    my $extra_script = '';
    my $chart_events = '';
    my $responsive   = '';
    my $init_script  = qq[window.addEventListener('$init_event', init_$chart_id);];

    foreach my $script (@{$self->{scripts}}) {
        $extra_script .= qq[
            $script
        ];
    }

    foreach my $event (keys %{$self->{events}}) {
        my $callback = $self->{events}->{$event};
        $chart_events .= qq[
            chart.on('$event', function (params) { $callback });
        ];
    }

    if ($self->{responsive}) {
        $responsive = qq[
            window.addEventListener('resize', function () { chart.resize() });
        ];
    }

    if ($self->{init_method} eq 'iife') {
        $init_script = qq[(function(){ init_$chart_id() })();];
    }

    my $script = qq[
        if (!window.$charts_object) { window.$charts_object = {} }
        if (!window.$charts_object.charts) { window.$charts_object.charts = {} }

        function init_$chart_id() {

            let chartContainer = document.getElementById('$container');

            if (! chartContainer) { return false }

            let chart  = echarts.init(chartContainer, '$theme', $init_options);
            let option = $option;

            option && chart.setOption(option);

            window.$charts_object.charts["$chart_id"] = chart;

            $chart_events
            $extra_script
            $responsive

            return chart;

        }

        $init_script
    ];

    return "\n$script\n" if $wrap;

    return $script;

}

sub render_html {

    my ($self) = @_;

    my $style  = '';
    my @styles = @{$self->{styles}};

    push @styles, sprintf('width:%s',  $self->{width})  if ($self->{width});
    push @styles, sprintf('height:%s', $self->{height}) if ($self->{height});

    my $script = $self->render_script;

    my $chart_id        = $self->{id};
    my $container_id    = join '',  $self->{container_prefix}, $chart_id;
    my $styles          = join ';', @styles, $style;
    my $class_container = $self->{class};

    my $html = qq[

         </td>
</tr>

<tr>
<td  class="h" >
<a name="337">337</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">             $script </td>
</tr>

<tr>
<td  class="h" >
<a name="338">338</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">

    ];

    return $html;

}

sub render_image {

    my ($self, %params) = @_;

    my $render_script = dist_file('Chart-ECharts', 'render.cjs');

    my $node_path = delete $params{node_path};
    my $node_bin  = delete $params{node_bin} || '/usr/bin/node';
    my $output    = delete $params{output}   || Carp::croak 'Specify "output" file';
    my $format    = delete $params{format};
    my $width     = delete $params{width};
    my $height    = delete $params{height};
    my $option    = JSON::PP->new->encode($self->options);

    if (!$format) {

        my ($file, $dir, $suffix) = fileparse($output, ('.png', ',svg'));

        Carp::croak 'Unsupported output "format"' unless $suffix;

        ($format = $suffix) =~ s/\.//;

    }

    if ($format ne 'png' && $format ne 'svg') {
        Carp::croak 'Unknown output "format"';
    }

    if ($node_bin !~ /(node|node.exe)$/i) {
        Carp::croak 'Unknown node command';
    }

    if (!-e $node_bin && !-x _) {
        Carp::croak 'Node binary not found';
    }

    local $ENV{NODE_PATH} //= $node_path if $node_path;

    my @cmd = ($node_bin, $render_script, '--output', $output, '--format', $format, '--option', $option);

    push @cmd, '--width',  $width  if ($width);
    push @cmd, '--height', $height if ($height);

    DEBUG and say STDERR sprintf('Command: %s', join ' ', @cmd);

    my $pid = open3(my $stdin, my $stdout, my $stderr, @cmd);

    waitpid($pid, 0);
    my $exit_status = $? >> 8;

    if (DEBUG) {

        say STDERR "Enviroment Variables:";
        say STDERR sprintf("NODE_PATH=%s\n", $ENV{NODE_PATH} || '');

        if ($stderr) {
            say STDERR 'Command STDERR:';
            say STDERR <$stderr>;
        }

        if ($stdout) {
            say STDERR 'Command STDOUT:';
            say STDERR <$stdout>;
        }

        say STDERR "Command exit status: $exit_status";

    }


}

sub js {

    my ($self, $expression) = @_;

    my $identifier = sha1_hex($expression);
    $self->{js}->{$identifier} = $expression;

    return "{JS:$identifier}";

}

sub TO_JSON { shift->options }


1;

__END__