File Coverage

lib/Text/ASCIITable/EasyTable.pm

Criterion	Covered	Total	%
statement	89	123	72.3
branch	23	38	60.5
condition	9	16	56.2
subroutine	14	17	82.3
pod	1	5	20.0
total	136	199	68.3

package Text::ASCIITable::EasyTable;

use strict;
use warnings;

use Data::Dumper;
use JSON;
use List::Util   qw(pairs);
use Scalar::Util qw(reftype);
use Text::ASCIITable;

use parent qw(Exporter);

our @EXPORT = qw(easy_table); ## no critic (ProhibitAutomaticExportation)

our $VERSION = '1.005';

########################################################################
{
  ## no critic (RequireArgUnpacking)

  sub is_array { push @_, 'ARRAY'; goto &_is_type; }
  sub is_hash  { push @_, 'HASH';  goto &_is_type; }
  sub _is_type { return ref $_[0] && reftype( $_[0] ) eq $_[1]; }
}
########################################################################

########################################################################
sub uncamel {
########################################################################
  my ($str) = @_;

  while ( $str =~ s/^(.)(.*?)([[:upper:]])/\l$1$2_\l$3/xsmg ) { }

  return $str;
}

########################################################################
sub wordify {
########################################################################
  my ($str) = @_;

  $str = uncamel($str);

  $str =~ s/_(.)/ \u$1/xsmg;

  return ucfirst $str;
}

########################################################################
sub easy_table {
########################################################################
  my (%options) = @_;

  die "'data' must be ARRAY\n"
    if !is_array $options{data};

  my @columns;

  if ( $options{columns} && !$options{index} ) {
    die "'columns' must be an ARRAY\n"
      if !is_array $options{columns};

    @columns = @{ $options{columns} };
  }
  elsif ( $options{rows} ) {
    die "'rows' must be ARRAY\n"
      if !is_array $options{rows};

    die "'rows' must be key/value pairs\n"
      if @{ $options{rows} } % 2;

    @columns = map { $_->[0] } pairs @{ $options{rows} };
  }
  elsif ( $options{index} ) {

    @columns = map { $_->[0] } pairs @{ $options{index} };

    my %index = @{ $options{index} };

    $options{rows} = [
      map {
        ( $_ => sub { return shift->{ $index{ shift() } } } )
      } @columns
    ];
  }
  else {
    @columns = keys %{ $options{data}->[0] };
  }

  $options{columns} = \@columns;

  my $data = _render_data( %options, columns => \@columns, );

  return _render_table( %options, data => $data )
    if !$options{json};

  # return an array of hashes
  my @json_data;

  foreach my $row ( @{$data} ) {
    my %hashed_row = map { $_ => shift @{$row} } @columns;
    push @json_data, \%hashed_row;
  }

  return JSON->new->pretty->encode( \@json_data );
}

########################################################################
sub _render_table {
########################################################################
  my (%options) = @_;

  # build a table...
  my $table_options = $options{table_options};
  $table_options //= {};

  die "'table_options' must be HASH\n"
    if !is_hash $table_options;

  $table_options->{headingText} //= 'Table';

  my $t = Text::ASCIITable->new($table_options);

  my @columns = @{ $options{columns} };

  if ( $options{fix_headings} ) {
    @columns = map { wordify $_ } @columns;
  }

  $t->setCols(@columns);

  for ( @{ $options{data} } ) {

    if ( !@{$_} ) {
      $t->addRowLine;
      next;
    }

    $t->addRow( @{$_} );
  }

  return $t;
}

########################################################################
sub _render_data {
########################################################################
  my (%options) = @_;

  my ( $data, $rows, $columns, $sort_key )
    = @options{qw(data rows columns sort_key)};

  my @sorted_data;

  if ($sort_key) {
    if ( reftype($sort_key) eq 'CODE' ) {
      @sorted_data = $sort_key->( @{$data} );
    }
    else {
      @sorted_data
        = sort { lc $a->{$sort_key} cmp lc $b->{$sort_key} } @{$data};
    }
  }
  else {
    @sorted_data = @{$data};
  }

  my %row_lu = $rows ? @{$rows} : ();

  my @rendered_data;

  my $row_count = 0;

  for my $row ( @{$data} ) {

    print {*STDERR} Dumper( [ row => $row ] );

    if ( !$row ) {
      push @rendered_data, [];
      next;
    }

    last
      if defined $options{max_rows} && ++$row_count > $options{max_rows};

    if ($rows) {
      push @rendered_data, [
        map {
          ref $row_lu{$_}
            && reftype( $row_lu{$_} ) eq 'CODE' ? $row_lu{$_}->( $row, $_ )
            : $row_lu{$_}                       ? $row->{ $row_lu{$_} }
            : $row->{$_}
        } @{$columns},
      ];
    }
    else {
      push @rendered_data, [ @{$row}{ @{$columns} } ];
    }
  }

  return \@rendered_data;
}

1;

## no critic (RequirePodSections)

__END__