File Coverage

blib/lib/File/Process/Utils.pm
Criterion Covered Total %
statement 100 104 96.1
branch 40 46 86.9
condition 10 17 58.8
subroutine 17 17 100.0
pod 1 4 25.0
total 168 188 89.3


line stmt bran cond sub pod time code
1             package File::Process::Utils;
2              
3 5     5   35 use strict;
  5         11  
  5         150  
4 5     5   34 use warnings;
  5         9  
  5         119  
5              
6 5     5   39 use Carp;
  5         9  
  5         273  
7 5     5   4019 use Text::CSV_XS;
  5         80159  
  5         264  
8 5     5   49 use Data::Dumper;
  5         14  
  5         278  
9 5     5   2402 use ReadonlyX;
  5         7779  
  5         286  
10 5     5   35 use Scalar::Util qw(reftype);
  5         11  
  5         1002  
11              
12             Readonly our $SUCCESS => 1;
13             Readonly our $FAILURE => 0;
14             Readonly our $TRUE => 1;
15             Readonly our $FALSE => 0;
16              
17             Readonly our $EMPTY => q{};
18             Readonly our $NL => "\n";
19             Readonly our $TAB => "\t";
20             Readonly our $PIPE => q{|};
21             Readonly our $COMMA => q{,};
22              
23 5     5   2257 use parent qw(Exporter);
  5         1540  
  5         27  
24              
25             our @EXPORT_OK = qw(
26             $COMMA
27             $EMPTY
28             $FAILURE
29             $FALSE
30             $NL
31             $PIPE
32             $SUCCESS
33             $TAB
34             $TRUE
35             is_array
36             is_hash
37             process_csv
38             );
39              
40             our %EXPORT_TAGS = (
41             'booleans' => [qw($TRUE $FALSE $SUCCESS $FAILURE is_array is_hash)],
42             'chars' => [qw($NL $EMPTY $PIPE $TAB $COMMA)],
43             'all' => \@EXPORT_OK,
44             );
45              
46             our $VERSION = '0.10';
47              
48             ########################################################################
49 236     236   384 sub _is_array { push @_, 'ARRAY'; goto &_is_type; }
  236         474  
50 136     136   238 sub _is_hash { push @_, 'HASH'; goto &_is_type; }
  136         266  
51 108     108 0 155 sub is_code { push @_, 'CODE'; goto &_is_type; }
  108         192  
52             ########################################################################
53              
54             ########################################################################
55             sub is_hash { ## no critic (RequireArgUnpacking)
56             ########################################################################
57 136     136 0 3653 my $result = _is_hash( $_[0] );
58              
59             return
60 136 100       379 if !$result;
61              
62 20 50       42 return wantarray ? %{ ref $_[0] ? $_[0] : {} } : $result;
  19 100       86  
63             }
64              
65             ########################################################################
66             sub is_array { ## no critic (RequireArgUnpacking)
67             ########################################################################
68 236     236 0 3046 my $result = _is_array( $_[0] );
69              
70             return
71 236 100       691 if !$result;
72              
73 58 50       160 return wantarray ? @{ ref $_[0] ? $_[0] : [] } : $result;
  11 100       38  
74             }
75              
76             ########################################################################
77 480   100 480   1537 sub _is_type { return ref $_[0] && reftype( $_[0] ) eq $_[1]; }
78             ########################################################################
79              
80             ########################################################################
81             sub process_csv {
82             ########################################################################
83 9     9 1 49 my ( $file, %options ) = @_;
84              
85 9         32 require File::Process;
86              
87 9   50     40 my $csv_options = $options{csv_options} // {};
88              
89 9         38 my $csv = Text::CSV_XS->new($csv_options);
90              
91 9   33     1151 $options{chomp} //= $TRUE;
92              
93             my ( $csv_lines, %info ) = File::Process::process_file(
94             $file,
95             csv => $csv,
96             %options,
97             pre => sub {
98 9     9   20 my ( $file, $args ) = @_;
99              
100 9         34 my ( $fh, $all_lines ) = File::Process::pre( $file, $args );
101              
102 9 100       28 if ( $args->{'has_headers'} ) {
103 1         57 my @column_names = $args->{csv}->getline($fh);
104 1         58 $args->{csv}->column_names(@column_names);
105             }
106              
107 9         62 return ( $fh, $all_lines );
108             },
109             next_line => sub {
110 90     90   186 my ( $fh, $all_lines, $args ) = @_;
111              
112             return
113             if defined $args->{max_rows}
114 0         0 && @{$all_lines}
115 90 0 33     200 && @{$all_lines} >= $args->{max_rows};
  0   33     0  
116              
117 90         109 my $ref;
118              
119 90 100       161 if ( $args->{has_headers} ) {
120 10         28 $ref = $args->{csv}->getline_hr($fh);
121              
122 10 50       653 if ( my (%skips) = is_hash( $args->{skip_list} ) ) {
123 0         0 for ( keys %skips ) {
124 0         0 delete $ref->{$_};
125             }
126             }
127             }
128             else {
129 80         1926 $ref = $args->{csv}->getline($fh);
130              
131 80 100       2430 return $ref
132             if !$ref;
133              
134 72 100 100     265 if ( !$args->{keep_list} && is_array( $args->{skip_list} ) ) {
135              
136 1         4 my @keep_list = ( 0 .. $#{$ref} );
  1         16  
137              
138 1         3 for ( @{ $args->{skip_list} } ) {
  1         4  
139 1         4 splice @keep_list, $_, 1;
140             }
141              
142 1         3 $args->{keep_list} = \@keep_list;
143             }
144              
145 72 100       175 if ( $args->{keep_list} ) {
146 9         12 $ref = [ @{$ref}[ @{ $args->{keep_list} } ] ];
  9         24  
  9         13  
147             }
148             }
149              
150 82         119 my %row;
151              
152 82         124 my $column_keys = $args->{column_names};
153              
154 82 100       127 if ( is_array($column_keys) ) {
155              
156 45 100       62 if ( !@{$column_keys} ) {
  45         94  
157             # generated extra column names as needed
158 4         6 $column_keys = [ map {"col$_"} ( 0 .. $#{$ref} ) ];
  16         39  
  4         12  
159 4         11 $args->{column_names} = $column_keys;
160             }
161             }
162              
163 82 100       196 if ($column_keys) {
164 45         68 %row = map { $column_keys->[$_] => $ref->[$_] } ( 0 .. $#{$ref} );
  180         428  
  45         96  
165 45 100       138 if ( my (%skips) = is_hash( $args->{skip_list} ) ) {
166 9         20 for ( keys %skips ) {
167 9         22 delete $row{$_};
168             }
169             }
170             }
171              
172             # hooks?
173 82 100       234 if ( my (@hooks) = is_array( $args->{hooks} ) ) {
    100          
174              
175 9         16 for my $col ( 0 .. $#{$ref} ) {
  9         21  
176 36         119 is_code $hooks[$col];
177              
178 36 100       72 next if !is_code $hooks[$col];
179              
180 18         39 $ref->[$col] = $hooks[$col]->( $ref->[$col] );
181             }
182             }
183             elsif ( my (%hooks) = is_hash( $args->{hooks} ) ) {
184              
185             croak "you just define column_names when 'hooks' is a hash\n"
186 9 50       16 if !@{$column_keys};
  9         26  
187              
188 9         12 for my $column_name ( @{$column_keys} ) {
  9         19  
189 36 100       120 next if !is_code $hooks{$column_name};
190              
191             $row{$column_name}
192 18         42 = $hooks{$column_name}->( $row{$column_name} );
193             }
194             }
195              
196 82 100       334 return $column_keys ? \%row : $ref;
197             }
198 9         98 );
199              
200 9         104 return ( $csv_lines, %info );
201             }
202              
203             1;
204              
205             __END__