view release on metacpan or  search on metacpan

script/tchart  view on Meta::CPAN

#!perl

use 5.010001;
use strict;
use warnings;

#use App::chart;
use Getopt::Long qw(:config no_ignore_case bundling);
use Scalar::Util qw(looks_like_number);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-02-06'; # DATE
our $DIST = 'App-tchart'; # DIST
our $VERSION = '0.062'; # VERSION

my %Opts = (
    input        => undef,
    output       => 'text',
    type         => 'bar',
    data_column  => undef,
    label_column => undef,
    chart_height => undef,
    chart_width  => undef,
    y_scale      => 'linear',
);
my $Data;

sub parse_cmdline {
    my $res = GetOptions(
        'input|i=s'        => \$Opts{input},
        'output|o=s'       => \$Opts{output},
        'type|t=s'         => \$Opts{type},
        'data-column|d=s'  => sub { $Opts{data_column}  //= []; push @{ $Opts{data_column} } , $_[1] },
        'label-column|l=s' => sub { $Opts{label_column} //= []; push @{ $Opts{label_column} }, $_[1] },
        'chart-height|H=f' => \$Opts{chart_height},
        'chart-width|W=f'  => \$Opts{chart_width},
        'y-scale=s'        => \$Opts{y_scale},
        'version|v'        => sub {
            say "tchart version ", ($main::VERSION // '?');
            exit 0;
        },
        'help|h'     => sub {
            print <<USAGE;
Usage:
  tchart [OPTIONS] < INPUT
  tchart --version
  tchart --help
Examples:
  tchart -o YAML < data.json
Options:
  --input=s, -i          Input data format (json, yaml, perl; default is json).
  --output=s, -o         Output format (text).
  --type=s, -t           Choose chart type (e.g. bar, sparkline, ...).
  --data-column=s, -d    Can be specified multiple times.
  --label-column=s, -l   Can be specified multiple times.
  --chart-height=f, -H
  --chart-width=f, -W

Consult manpage/documentation for more details.
USAGE
            exit 0;
        },
    );
    exit 99 if !$res;
}

sub get_input {
    if (@ARGV) {
        $Data = [@ARGV];
        return;
    }

    my @lines = <>;

    my $fmt = $Opts{input};
    if (!$fmt) {
        if (looks_like_number($lines[0]) || $lines[0] =~ /\t/) {
            $fmt = "tsv";
        } else {
            $fmt = "json";
        }
    }

    if ($fmt eq 'tsv') {
        $Data = [];
        for my $line (@lines) {
            chomp $line;
            push @$Data, [split(/\t/, $line)];
        }
    } elsif ($fmt eq 'tsv+h') {
        # for now, we encode as
        my @colnames;
        if (my $firstline = shift @lines) {
            chomp $firstline;
            @colnames = split /\t/, $firstline;
        }
        $Data = [];
        for my $line (@lines) {
            chomp $line;
            my $row = [split /\t/, $line];
            push @$Data, { map { $colnames[$_] => $row->[$_]} 0..@$row-1 };
        }
    } elsif ($fmt eq 'json') {
        require JSON::MaybeXS;
        require Perinci::Result::Util;
        $Data = JSON::MaybeXS->new->allow_nonref->decode(join "", @lines);
        $Data = $Data->[2] if Perinci::Result::Util::is_env_res($Data);
    } elsif ($fmt eq 'yaml') {
        require Perinci::Result::Util;
        require YAML::Syck;
        $Data = YAML::Syck::Load(join "", @lines);
        $Data = $Data->[2] if Perinci::Result::Util::is_env_res($Data);
    } elsif ($fmt eq 'perl') {
        $Data = eval(join "", @lines); ## no critic: BuiltinFunctions::ProhibitStringyEval
    } else {
        warn "Unknown input format, ".
            "refer to documentation for available formats\n";
        exit 99;
    }
}

sub display_chart {
    if ($Opts{output} eq 'dump') {
        require JSON::MaybeXS;
        require Data::TableData::Object;
        my $tbl = Data::TableData::Object->new($Data);
        print JSON::MaybeXS->new->pretty->encode($tbl->as_aohos);
    } else {
        require Text::Chart;
        binmode(STDOUT, ":encoding(utf8)");
        print Text::Chart::gen_text_chart(
            data         => $Data,
            type         => $Opts{type},
            label_column => $Opts{label_column},
            data_column  => $Opts{data_column},
            chart_height => $Opts{chart_height},
            chart_width  => $Opts{chart_width},