File Coverage

lib/Sweet/File/DSV.pm
Criterion Covered Total %
statement 58 64 90.6
branch 11 18 61.1
condition 1 3 33.3
subroutine 14 16 87.5
pod 1 3 33.3
total 85 104 81.7


line stmt bran cond sub pod time code
1             package Sweet::File::DSV;
2 5     5   5176472 use v5.12;
  5         17  
  5         238  
3 5     5   302 use Moose;
  5         275353  
  5         21  
4 5     5   20175 use namespace::autoclean;
  5         1043  
  5         21  
5              
6 5     5   218 use Carp;
  5         7  
  5         270  
7 5     5   22 use Try::Tiny;
  5         6  
  5         2892  
8              
9             extends 'Sweet::File';
10              
11             sub BUILDARGS {
12 4     4 1 11     my ($class, %attribute) = @_;
13              
14 4         7     my $fields_arrayref = $attribute{fields};
15 4         5     my $header = $attribute{header};
16 4         3     my $no_header = $attribute{no_header};
17              
18 4 50 33     12     if ($no_header and $header) {
19 0         0         croak "Argument no_header conflicts with header: $header";
20                 }
21              
22             # Needed 'cause init_arg does not work with Array trait.
23 4 100       10     if (defined $fields_arrayref) {
24 1         1         $attribute{_fields} = $fields_arrayref;
25 1         2         delete $attribute{fields};
26                 }
27              
28 4         88     return \%attribute;
29             }
30              
31             sub BUILD {
32 4     4 0 4     my $self = shift;
33              
34 4         4     my (@fields, $header);
35              
36 4         94     my $separator = $self->separator;
37              
38             # If file exists and attribute fields is provided, fill header.
39 4 100       19     if ($self->is_a_plain_file) {
40                     try {
41 2     2   115             $header = $self->header;
42                     }
43                     catch {
44 0     0   0             @fields = $self->fields;
45 0         0             $header = join($separator, @fields);
46 2         67         };
47              
48 2         80         $self->_write_header($header);
49                 }
50                 else {
51 2 100       108         if ($self->has_fields) {
52 1         25             @fields = $self->fields;
53 1         2             $header = join($separator, @fields);
54              
55             # Check if fields and header does not conflict.
56 1 50       28             if ($self->has_header) {
57 0 0       0                 croak "Conflict header and fields" unless $header eq $self->header;
58                         }
59                         else {
60 1         23                 $self->_write_header($header);
61                         }
62                     }
63                 }
64              
65             }
66              
67             has _fields => (
68                 builder => '_build_fields',
69                 handles => {
70                     field => 'get',
71                     fields => 'elements',
72                     num_fields => 'count',
73                 },
74                 is => 'rw',
75                 isa => 'ArrayRef[Str]',
76                 lazy => 1,
77                 predicate => 'has_fields',
78                 traits => ['Array'],
79             );
80              
81             sub _build_fields {
82 2     2   3     my $self = shift;
83              
84 2         2     my ($header, $separator, @fields);
85              
86                 try {
87 2     2   93         $header = $self->header;
88 2         40         $separator = $self->separator;
89              
90 2         16         @fields = $self->split_line->($separator)->(0);
91                 }
92                 catch {
93 0     0   0         croak "Cannot compute file fields", $_;
94 2         14     };
95              
96 2         87     return \@fields;
97             }
98              
99             has no_header => (
100                 default => sub { 0 },
101                 is => 'ro',
102                 isa => 'Bool',
103                 lazy => 1,
104             );
105              
106             has header => (
107                 builder => '_build_header',
108                 is => 'rw',
109                 isa => 'Maybe[Str]',
110                 lazy => 1,
111                 predicate => 'has_header',
112                 writer => '_write_header',
113             );
114              
115             sub _build_header {
116 2     2   3     my $self = shift;
117              
118 2 50       42     return if $self->no_header;
119              
120 2         53     my $header = $self->line(0);
121              
122 2         43     return $header;
123             }
124              
125             has separator => (
126                 builder => '_build_separator',
127                 is => 'ro',
128                 isa => 'Str',
129                 lazy => 1,
130             );
131              
132             has _rows => (
133                 builder => '_build_rows',
134                 traits => ['Array'],
135                 handles => {
136                     num_rows => 'count',
137                     row => 'get',
138                     rows => 'elements',
139                 },
140                 is => 'ro',
141                 isa => 'ArrayRef[Str]',
142                 lazy => 1,
143             );
144              
145             sub _build_rows {
146 2     2   2     my $self = shift;
147              
148 2         55     my @rows = $self->lines;
149              
150             # Remove header, if any.
151 2 50       41     shift @rows unless $self->no_header;
152              
153 2         50     return \@rows;
154             }
155              
156             sub split_row {
157 2     2 0 2     my $self = shift;
158              
159 2         44     my $no_header = $self->no_header;
160 2         41     my $separator = $self->separator;
161              
162 2 50       4     if ($no_header) {
163 0         0         return $self->split_line->($separator);
164                 }
165                 else {
166                     return sub {
167 2     2   2             my $num_line = shift;
168              
169 2         5             return $self->split_line->($separator)->($num_line + 1);
170                       }
171 2         13     }
172             }
173              
174             __PACKAGE__->meta->make_immutable;
175              
176             1;
177              
178             =head1 NAME
179            
180             Sweet::File::DSV
181            
182             =head1 SYNOPSIS
183            
184             Given a C<file.dat> in your home dir.
185            
186             FIELD_A|FIELD_B
187             foo|bar
188             2|3
189            
190             Create a pipe separated value file instance.
191            
192             my $dir = Sweet::HomeDir->new;
193             my $file = Sweet::File::DSV->new(
194             dir => $dir,
195             name => 'file.dat',
196             sep => '|',
197             );
198            
199             =head1 INHERITANCE
200            
201             Inherits from C<Sweet::File>.
202            
203             =head1 ATTRIBUTES
204            
205             =head2 header
206            
207             =head2 no_header
208            
209             =head2 separator
210            
211             Field separator. Must be provided at creation time or in a sub class with C<_build_sep> method.
212            
213             =head1 METHODS
214            
215             =head2 num_rows
216            
217             say $file->num_rows; # 2
218            
219             =head2 field
220            
221             say $file->field(0); # FIELD_A
222             say $file->field(1); # FIELD_B
223            
224             =head2 fields
225            
226             my @fields = $file->fields; # ('FIELD_A', 'FIELD_B')
227            
228             =head1 split_row
229            
230             my $cells = $self->split_row->(0);
231            
232             say $_ for @$cells;
233             # foo
234             # bar
235            
236             =head2 rows
237            
238             say $_ for $file->rows;
239             # foo|bar
240             # 2|3
241            
242             =head1 SEE ALSO
243            
244             L<Delimiter-separated values|https://en.wikipedia.org/wiki/Delimiter-separated_values> Wikipedia page.
245            
246             =cut
247              
248