File Coverage

blib/lib/App/TSVUtils.pm
Criterion Covered Total %
statement 27 29 93.1
branch 5 8 62.5
condition n/a
subroutine 6 6 100.0
pod 1 2 50.0
total 39 45 86.6


line stmt bran cond sub pod time code
1             package App::TSVUtils;
2              
3             our $DATE = '2019-05-21'; # DATE
4             our $VERSION = '0.002'; # VERSION
5              
6 1     1   172240 use 5.010001;
  1         6  
7 1     1   6 use strict;
  1         2  
  1         22  
8 1     1   12 use warnings;
  1         2  
  1         498  
9              
10             our %SPEC;
11              
12             my %args_common = (
13             );
14              
15             my %arg_filename_0 = (
16             filename => {
17             summary => 'Input TSV file',
18             schema => 'filename*',
19             req => 1,
20             pos => 0,
21             cmdline_aliases => {f=>{}},
22             },
23             );
24              
25             my %arg_filename_1 = (
26             filename => {
27             summary => 'Input TSV file',
28             schema => 'filename*',
29             req => 1,
30             pos => 1,
31             cmdline_aliases => {f=>{}},
32             },
33             );
34              
35             $SPEC{tsvutil} = {
36             v => 1.1,
37             summary => 'Perform action on a TSV file',
38             'x.no_index' => 1,
39             args => {
40             %args_common,
41             action => {
42             schema => ['str*', in=>[
43             'dump',
44             ]],
45             req => 1,
46             pos => 0,
47             cmdline_aliases => {a=>{}},
48             },
49             %arg_filename_1,
50             },
51             args_rels => {
52             },
53             };
54             sub tsvutil {
55 1     1 0 3 my %args = @_;
56 1         3 my $action = $args{action};
57              
58 1         2 my $res = "";
59 1         3 my $i = 0;
60              
61             open my($fh), "<:encoding(utf8)", $args{filename} or
62 1 50       41 return [500, "Can't open input filename '$args{filename}': $!"];
63              
64             my $code_getline = sub {
65 5     5   54 my $row0 = <$fh>;
66 5 100       24 return undef unless defined $row0;
67 4         8 chomp($row0);
68 4         23 [split /\t/, $row0];
69 1         84 };
70              
71 1         3 my $rows = [];
72              
73 1         3 while (my $row = $code_getline->()) {
74 4         5 $i++;
75 4 50       9 if ($action eq 'dump') {
76 4         9 push @$rows, $row;
77             } else {
78 0         0 return [400, "Unknown action '$action'"];
79             }
80             } # while getline()
81              
82 1 50       16 if ($action eq 'dump') {
83 1         22 return [200, "OK", $rows];
84             }
85              
86 0         0 [200, "OK", $res, {"cmdline.skip_format"=>1}];
87             } # tsvutil
88              
89             $SPEC{tsv_dump} = {
90             v => 1.1,
91             summary => 'Dump TSV as data structure (array of arrays)',
92             args => {
93             %args_common,
94             %arg_filename_0,
95             },
96             };
97             sub tsv_dump {
98 1     1 1 3027 my %args = @_;
99 1         5 tsvutil(%args, action=>'dump');
100             }
101              
102             1;
103             # ABSTRACT: CLI utilities related to TSV
104              
105             __END__
106              
107             =pod
108              
109             =encoding UTF-8
110              
111             =head1 NAME
112              
113             App::TSVUtils - CLI utilities related to TSV
114              
115             =head1 VERSION
116              
117             This document describes version 0.002 of App::TSVUtils (from Perl distribution App-TSVUtils), released on 2019-05-21.
118              
119             =head1 DESCRIPTION
120              
121             This distribution contains the following CLI utilities:
122              
123             =over
124              
125             =item * L<dump-tsv>
126              
127             =item * L<tsv-dump>
128              
129             =back
130              
131             =head1 FUNCTIONS
132              
133              
134             =head2 tsv_dump
135              
136             Usage:
137              
138             tsv_dump(%args) -> [status, msg, payload, meta]
139              
140             Dump TSV as data structure (array of arrays).
141              
142             This function is not exported.
143              
144             Arguments ('*' denotes required arguments):
145              
146             =over 4
147              
148             =item * B<filename>* => I<filename>
149              
150             Input TSV file.
151              
152             =back
153              
154             Returns an enveloped result (an array).
155              
156             First element (status) is an integer containing HTTP status code
157             (200 means OK, 4xx caller error, 5xx function error). Second element
158             (msg) is a string containing error message, or 'OK' if status is
159             200. Third element (payload) is optional, the actual result. Fourth
160             element (meta) is called result metadata and is optional, a hash
161             that contains extra information.
162              
163             Return value: (any)
164              
165             =for Pod::Coverage ^(tsvutil)$
166              
167             =head1 HOMEPAGE
168              
169             Please visit the project's homepage at L<https://metacpan.org/release/App-TSVUtils>.
170              
171             =head1 SOURCE
172              
173             Source repository is at L<https://github.com/perlancar/perl-App-TSVUtils>.
174              
175             =head1 BUGS
176              
177             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-TSVUtils>
178              
179             When submitting a bug or request, please include a test-file or a
180             patch to an existing test-file that illustrates the bug or desired
181             feature.
182              
183             =head1 SEE ALSO
184              
185             L<App::SerializeUtils>
186              
187             L<App::LTSVUtils> (which includes utilities like L<ltsv2tsv>, L<tsv2ltsv>, among
188             others).
189              
190             L<App::CSVUtils> (which includes L<csv2tsv>, L<tsv2csv> among others).
191              
192             =head1 AUTHOR
193              
194             perlancar <perlancar@cpan.org>
195              
196             =head1 COPYRIGHT AND LICENSE
197              
198             This software is copyright (c) 2019 by perlancar@cpan.org.
199              
200             This is free software; you can redistribute it and/or modify it under
201             the same terms as the Perl 5 programming language system itself.
202              
203             =cut