File Coverage

blib/lib/File/Process/Utils.pm

Criterion	Covered	Total	%
statement	98	102	96.0
branch	40	46	86.9
condition	10	17	58.8
subroutine	16	16	100.0
pod	1	4	25.0
total	165	185	89.1

package File::Process::Utils;

use strict;
use warnings;

use Carp;
use Data::Dumper;
use Scalar::Util qw(reftype);

use Readonly;

Readonly::Scalar our $SUCCESS => 1;
Readonly::Scalar our $FAILURE => 0;
Readonly::Scalar our $TRUE    => 1;
Readonly::Scalar our $FALSE   => 0;

Readonly::Scalar our $EMPTY => q{};
Readonly::Scalar our $NL    => "\n";
Readonly::Scalar our $TAB   => "\t";
Readonly::Scalar our $PIPE  => q{|};
Readonly::Scalar our $COMMA => q{,};

use parent qw(Exporter);

our @EXPORT_OK = qw(
  $COMMA
  $EMPTY
  $FAILURE
  $FALSE
  $NL
  $PIPE
  $SUCCESS
  $TAB
  $TRUE
  is_array
  is_hash
  process_csv
);

our %EXPORT_TAGS = (
  'booleans' => [qw($TRUE $FALSE $SUCCESS $FAILURE is_array is_hash)],
  'chars'    => [qw($NL $EMPTY $PIPE $TAB $COMMA)],
  'all'      => \@EXPORT_OK,
);

our $VERSION = '1.0.0';

########################################################################
sub _is_array { push @_, 'ARRAY'; goto &_is_type; }
sub _is_hash  { push @_, 'HASH';  goto &_is_type; }
sub is_code   { push @_, 'CODE';  goto &_is_type; }
########################################################################

########################################################################
sub is_hash { ## no critic (RequireArgUnpacking)
########################################################################
  my $result = _is_hash( $_[0] );

  return
    if !$result;

  return wantarray ? %{ ref $_[0] ? $_[0] : {} } : $result;
}

########################################################################
sub is_array { ## no critic (RequireArgUnpacking)
########################################################################
  my $result = _is_array( $_[0] );

  return
    if !$result;

  return wantarray ? @{ ref $_[0] ? $_[0] : [] } : $result;
}

########################################################################
sub _is_type { return ref $_[0] && reftype( $_[0] ) eq $_[1]; }
########################################################################

########################################################################
sub process_csv {
########################################################################
  my ( $file, %options ) = @_;

  require File::Process;

  my $csv_options = $options{csv_options} // {};

  require Text::CSV_XS;

  my $csv = Text::CSV_XS->new($csv_options);

  $options{chomp} //= $TRUE;

  my ( $csv_lines, %info ) = File::Process::process_file(
    $file,
    csv => $csv,
    %options,
    pre => sub {
      my ( $file, $args ) = @_;

      my ( $fh, $all_lines ) = File::Process::pre( $file, $args );

      if ( $args->{'has_headers'} ) {
        my @column_names = $args->{csv}->getline($fh);
        $args->{csv}->column_names(@column_names);
      }

      return ( $fh, $all_lines );
    },
    next_line => sub {
      my ( $fh, $all_lines, $args ) = @_;

      return
           if defined $args->{max_rows}
        && @{$all_lines}
        && @{$all_lines} >= $args->{max_rows};

      my $ref;

      if ( $args->{has_headers} ) {
        $ref = $args->{csv}->getline_hr($fh);

        if ( my (%skips) = is_hash( $args->{skip_list} ) ) {
          for ( keys %skips ) {
            delete $ref->{$_};
          }
        }
      }
      else {
        $ref = $args->{csv}->getline($fh);

        return $ref
          if !$ref;

        if ( !$args->{keep_list} && is_array( $args->{skip_list} ) ) {

          my @keep_list = ( 0 .. $#{$ref} );

          for ( @{ $args->{skip_list} } ) {
            splice @keep_list, $_, 1;
          }

          $args->{keep_list} = \@keep_list;
        }

        if ( $args->{keep_list} ) {
          $ref = [ @{$ref}[ @{ $args->{keep_list} } ] ];
        }
      }

      my %row;

      my $column_keys = $args->{column_names};

      if ( is_array($column_keys) ) {

        if ( !@{$column_keys} ) {
          # generated extra column names as needed
          $column_keys = [ map {"col$_"} ( 0 .. $#{$ref} ) ];
          $args->{column_names} = $column_keys;
        }
      }

      if ($column_keys) {
        %row = map { $column_keys->[$_] => $ref->[$_] } ( 0 .. $#{$ref} );
        if ( my (%skips) = is_hash( $args->{skip_list} ) ) {
          for ( keys %skips ) {
            delete $row{$_};
          }
        }
      }

      # hooks?
      if ( my (@hooks) = is_array( $args->{hooks} ) ) {

        for my $col ( 0 .. $#{$ref} ) {
          is_code $hooks[$col];

          next if !is_code $hooks[$col];

          $ref->[$col] = $hooks[$col]->( $ref->[$col] );
        }
      }
      elsif ( my (%hooks) = is_hash( $args->{hooks} ) ) {

        croak "you just define column_names when 'hooks' is a hash\n"
          if !@{$column_keys};

        for my $column_name ( @{$column_keys} ) {
          next if !is_code $hooks{$column_name};

          $row{$column_name}
            = $hooks{$column_name}->( $row{$column_name} );
        }
      }

      return $column_keys ? \%row : $ref;
    }
  );

  return ( $csv_lines, %info );
}

1;

__END__