File Coverage

blib/lib/TableDataRole/Source/CSVInFiles.pm
Criterion Covered Total %
statement 83 92 90.2
branch 16 28 57.1
condition n/a
subroutine 12 13 92.3
pod 2 9 22.2
total 113 142 79.5


line stmt bran cond sub pod time code
1             package TableDataRole::Source::CSVInFiles;
2              
3 1     1   465 use 5.010001;
  1         3  
4 1     1   5 use strict;
  1         2  
  1         21  
5 1     1   5 use warnings;
  1         3  
  1         23  
6              
7 1     1   7 use Role::Tiny;
  1         2  
  1         5  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2023-02-24'; # DATE
11             our $DIST = 'TableDataRoles-Standard'; # DIST
12             our $VERSION = '0.015'; # VERSION
13              
14             with 'TableDataRole::Spec::Basic';
15              
16             sub new {
17 1     1 1 1113 require Text::CSV_XS;
18              
19 1         21025 my ($class, %args) = @_;
20              
21 1         3 my $fhs = [];
22 1 50       9 if (defined(my $filenames = delete $args{filenames})) {
    0          
23 1         4 for my $filename (@$filenames) {
24 3 50       114 open my $fh, "<", $filename
25             or die "Can't open file '$filename': $!";
26 3         15 push @$fhs, $fh;
27             }
28             } elsif (defined($fhs = delete $args{filehandles})) {
29             } else {
30 0         0 die "Please specify 'filenames' or 'filehandles'";
31             }
32 1 50       5 @$fhs or die "Please supply at least one filename/filehandle";
33 1 50       5 die "Unknown argument(s): ". join(", ", sort keys %args)
34             if keys %args;
35              
36 1         12 my $csv_parser = Text::CSV_XS->new({binary=>1});
37              
38 1         176 my $files = [];
39 1         3 my $columns;
40 1         3 for my $fh (@$fhs) {
41 3         11 my $fhpos_data_begin = tell $fh;
42 3 50       95 $columns = $csv_parser->getline($fh)
43             or die "Can't read columns from first row of CSV file";
44 3         160 my $fhpos_datarow_begin = tell $fh;
45 3         20 push @$files, {
46             fh => $fh,
47             fhpos_data_begin => $fhpos_data_begin,
48             fhpos_datarow_begin => $fhpos_datarow_begin,
49             };
50             }
51             bless {
52 1         31 files => $files,
53             csv_parser => $csv_parser,
54             columns => $columns,
55             file_pos => 0, # which file are we at
56             pos => 0, # iterator
57             }, $class;
58             }
59              
60             sub as_csv {
61 1     1 1 9 my $self = shift;
62              
63 1         3 my $res = "";
64 1         2 for my $i (0 .. $#{$self->{files}}) {
  1         9  
65 3         10 my $file = $self->{files}[$i];
66 3         7 my $fh = $file->{fh};
67 3         6 my $oldpos = tell $fh;
68 3 100       41 seek $fh, ($i ? $file->{fhpos_datarow_begin} : $file->{fhpos_data_begin}), 0;
69 3         16 local $/;
70 3         59 $res .= scalar <$fh>;
71             }
72 1         5 $self->{pos} = 0;
73 1         3 $self->{file_pos} = 0;
74 1         8 $res;
75             }
76              
77             sub get_column_count {
78 1     1 0 3 my $self = shift;
79              
80 1         2 scalar @{ $self->{columns} };
  1         6  
81             }
82              
83             sub get_column_names {
84 1     1 0 3 my $self = shift;
85 1 50       4 wantarray ? @{ $self->{columns} } : $self->{columns};
  1         10  
86             }
87              
88             sub has_next_item {
89 16     16 0 57 my $self = shift;
90 16         28 my $files = $self->{files};
91 16         24 my $seek = 0;
92 16         25 while (1) {
93 18         27 my $file = $self->{files}[$self->{file_pos}];
94 18         31 my $fh = $file->{fh};
95 18 100       36 if ($seek) {
96 2         15 seek $fh, $file->{fhpos_datarow_begin}, 0;
97 2         6 $seek = 0;
98             }
99 18 100       99 return 1 unless eof($fh);
100 3 100       10 return 0 if $self->{file_pos} >= $#{$self->{files}};
  3         14  
101 2         4 $self->{file_pos}++;
102 2         6 $seek++;
103             }
104             }
105              
106             sub get_next_item {
107 19     19 0 71 my $self = shift;
108 19         31 my $files = $self->{files};
109 19         30 my $seek = 0;
110 19         39 while (1) {
111 19         35 my $file = $self->{files}[$self->{file_pos}];
112 19         28 my $fh = $file->{fh};
113 19 50       43 if ($seek) {
114 0         0 seek $fh, $file->{fhpos_datarow_begin}, 0;
115 0         0 $seek = 0;
116             }
117 19 50       63 unless (eof($fh)) {
118 19         411 my $row = $self->{csv_parser}->getline($fh);
119 19         474 $self->{pos}++;
120 19         62 return $row;
121             }
122 0 0       0 die "StopIteration" if $self->{file_pos} >= $#{$self->{files}};
  0         0  
123 0         0 $self->{file_pos}++;
124 0         0 $seek++;
125             }
126             }
127              
128             sub get_next_row_hashref {
129 2     2 0 5 my $self = shift;
130 2         4 my $row = $self->get_next_item;
131 2         7 +{ map {($self->{columns}[$_] => $row->[$_])} 0..$#{$self->{columns}} };
  6         44  
  2         6  
132             }
133              
134             sub get_iterator_pos {
135 0     0 0 0 my $self = shift;
136 0         0 $self->{pos};
137             }
138              
139             sub reset_iterator {
140 3     3 0 18 my $self = shift;
141 3         7 $self->{file_pos} = 0;
142 3         6 my $fh = $self->{files}[0]{fh};
143 3         37 seek $fh, $self->{files}[0]{fhpos_datarow_begin}, 0;
144 3         12 $self->{pos} = 0;
145             }
146              
147             1;
148             # ABSTRACT: Role to access table data from CSV in a set of files/filehandles
149              
150             __END__