| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::CSVUtils::csv_map; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 6763 | use 5.010001; | 
|  | 1 |  |  |  |  | 4 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 20 |  | 
| 5 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 68 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY | 
| 8 |  |  |  |  |  |  | our $DATE = '2023-04-01'; # DATE | 
| 9 |  |  |  |  |  |  | our $DIST = 'App-CSVUtils'; # DIST | 
| 10 |  |  |  |  |  |  | our $VERSION = '1.024'; # VERSION | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 1 |  |  |  |  | 350 | use App::CSVUtils qw( | 
| 13 |  |  |  |  |  |  | gen_csv_util | 
| 14 |  |  |  |  |  |  | compile_eval_code | 
| 15 |  |  |  |  |  |  | eval_code | 
| 16 | 1 |  |  | 1 |  | 6 | ); | 
|  | 1 |  |  |  |  | 2 |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | gen_csv_util( | 
| 19 |  |  |  |  |  |  | name => 'csv_map', | 
| 20 |  |  |  |  |  |  | summary => 'Return result of Perl code for every row', | 
| 21 |  |  |  |  |  |  | description => <<'_', | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | This is like Perl's `map` performed over rows of CSV. In `$_`, your Perl code | 
| 24 |  |  |  |  |  |  | will find the CSV row as an arrayref (or, if you specify `-H`, as a hashref). | 
| 25 |  |  |  |  |  |  | `$main::row` is also set to the row (always as arrayref). `$main::rownum` | 
| 26 |  |  |  |  |  |  | contains the row number (2 means the first data row). `$main::csv` is the | 
| 27 |  |  |  |  |  |  | <pm:Text::CSV_XS> object. `$main::fields_idx` is also available for additional | 
| 28 |  |  |  |  |  |  | information. | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | Your code is then free to return a string based on some operation against these | 
| 31 |  |  |  |  |  |  | data. This utility will then print out the resulting string. | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | _ | 
| 34 |  |  |  |  |  |  | add_args => { | 
| 35 |  |  |  |  |  |  | %App::CSVUtils::argspecopt_hash, | 
| 36 |  |  |  |  |  |  | %App::CSVUtils::argspec_eval, | 
| 37 |  |  |  |  |  |  | add_newline => { | 
| 38 |  |  |  |  |  |  | summary => 'Whether to make sure each string ends with newline', | 
| 39 |  |  |  |  |  |  | 'summary.alt.bool.not' => 'Do not add newline to each output', | 
| 40 |  |  |  |  |  |  | schema => 'bool*', | 
| 41 |  |  |  |  |  |  | default => 1, | 
| 42 |  |  |  |  |  |  | }, | 
| 43 |  |  |  |  |  |  | }, | 
| 44 |  |  |  |  |  |  | tags => ['category:iterating', 'accepts-code'], | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | examples => [ | 
| 47 |  |  |  |  |  |  | { | 
| 48 |  |  |  |  |  |  | summary => 'Create SQL insert statements (escaping is left as an exercise for users)', | 
| 49 |  |  |  |  |  |  | argv => ['-He', '"INSERT INTO mytable (id,amount) VALUES ($_->{id}, $_->{amount});"', 'file.csv'], | 
| 50 |  |  |  |  |  |  | test => 0, | 
| 51 |  |  |  |  |  |  | 'x.doc.show_result' => 0, | 
| 52 |  |  |  |  |  |  | }, | 
| 53 |  |  |  |  |  |  | ], | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | writes_csv => 0, | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | on_begin => sub { | 
| 58 |  |  |  |  |  |  | my $r = shift; | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | # for when we are called directly as a function without wrapper to set | 
| 61 |  |  |  |  |  |  | # defaults etc. | 
| 62 |  |  |  |  |  |  | $r->{util_args}{add_newline} //= 1; | 
| 63 |  |  |  |  |  |  | }, | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | on_input_header_row => sub { | 
| 66 |  |  |  |  |  |  | my $r = shift; | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | # we add the following keys to the stash | 
| 69 |  |  |  |  |  |  | $r->{code} = compile_eval_code($r->{util_args}{eval}, 'eval'); | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | $r->{wants_input_row_as_hashref} = 1 if $r->{util_args}{hash}; | 
| 72 |  |  |  |  |  |  | }, | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | on_input_data_row => sub { | 
| 75 |  |  |  |  |  |  | my $r = shift; | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | my $rowres = eval_code($r->{code}, $r, $r->{wants_input_row_as_hashref} ? $r->{input_row_as_hashref} : $r->{input_row}) // ''; | 
| 78 |  |  |  |  |  |  | $rowres .= "\n" if $r->{util_args}{add_newline} && $rowres !~ /\R\z/; | 
| 79 |  |  |  |  |  |  | $r->{code_print}->($rowres); | 
| 80 |  |  |  |  |  |  | }, | 
| 81 |  |  |  |  |  |  | ); | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | 1; | 
| 84 |  |  |  |  |  |  | # ABSTRACT: Return result of Perl code for every row | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | __END__ | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | =pod | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | =encoding UTF-8 | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | =head1 NAME | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | App::CSVUtils::csv_map - Return result of Perl code for every row | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | =head1 VERSION | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | This document describes version 1.024 of App::CSVUtils::csv_map (from Perl distribution App-CSVUtils), released on 2023-04-01. | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | =head1 FUNCTIONS | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  |  | 
| 103 |  |  |  |  |  |  | =head2 csv_map | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | Usage: | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | csv_map(%args) -> [$status_code, $reason, $payload, \%result_meta] | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | Return result of Perl code for every row. | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | Examples: | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | =over | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =item * Create SQL insert statements (escaping is left as an exercise for users): | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | csv_map( | 
| 118 |  |  |  |  |  |  | input_filename => "file.csv", | 
| 119 |  |  |  |  |  |  | eval => "\"INSERT INTO mytable (id,amount) VALUES (\$_->{id}, \$_->{amount});\"", | 
| 120 |  |  |  |  |  |  | hash => 1 | 
| 121 |  |  |  |  |  |  | ); | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | =back | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | This is like Perl's C<map> performed over rows of CSV. In C<$_>, your Perl code | 
| 126 |  |  |  |  |  |  | will find the CSV row as an arrayref (or, if you specify C<-H>, as a hashref). | 
| 127 |  |  |  |  |  |  | C<$main::row> is also set to the row (always as arrayref). C<$main::rownum> | 
| 128 |  |  |  |  |  |  | contains the row number (2 means the first data row). C<$main::csv> is the | 
| 129 |  |  |  |  |  |  | L<Text::CSV_XS> object. C<$main::fields_idx> is also available for additional | 
| 130 |  |  |  |  |  |  | information. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | Your code is then free to return a string based on some operation against these | 
| 133 |  |  |  |  |  |  | data. This utility will then print out the resulting string. | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | This function is not exported. | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | Arguments ('*' denotes required arguments): | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =over 4 | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | =item * B<add_newline> => I<bool> (default: 1) | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | Whether to make sure each string ends with newline. | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | =item * B<eval>* => I<str|code> | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | Perl code. | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | =item * B<hash> => I<bool> | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | Provide row in $_ as hashref instead of arrayref. | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | =item * B<input_escape_char> => I<str> | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | Specify character to escape value in field in input CSV, will be passed to Text::CSV_XS. | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | Defaults to C<\\> (backslash). Overrides C<--input-tsv> option. | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | =item * B<input_filename> => I<filename> (default: "-") | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | Input CSV file. | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | Use C<-> to read from stdin. | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | Encoding of input file is assumed to be UTF-8. | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =item * B<input_header> => I<bool> (default: 1) | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | Specify whether input CSV has a header row. | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | By default, the first row of the input CSV will be assumed to contain field | 
| 172 |  |  |  |  |  |  | names (and the second row contains the first data row). When you declare that | 
| 173 |  |  |  |  |  |  | input CSV does not have header row (C<--no-input-header>), the first row of the | 
| 174 |  |  |  |  |  |  | CSV is assumed to contain the first data row. Fields will be named C<field1>, | 
| 175 |  |  |  |  |  |  | C<field2>, and so on. | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | =item * B<input_quote_char> => I<str> | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | Specify field quote character in input CSV, will be passed to Text::CSV_XS. | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | Defaults to C<"> (double quote). Overrides C<--input-tsv> option. | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | =item * B<input_sep_char> => I<str> | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | Specify field separator character in input CSV, will be passed to Text::CSV_XS. | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | Defaults to C<,> (comma). Overrides C<--input-tsv> option. | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | =item * B<input_tsv> => I<true> | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | Inform that input file is in TSV (tab-separated) format instead of CSV. | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | Overriden by C<--input-sep-char>, C<--input-quote-char>, C<--input-escape-char> | 
| 194 |  |  |  |  |  |  | options. If one of those options is specified, then C<--input-tsv> will be | 
| 195 |  |  |  |  |  |  | ignored. | 
| 196 |  |  |  |  |  |  |  | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | =back | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | Returns an enveloped result (an array). | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | First element ($status_code) is an integer containing HTTP-like status code | 
| 203 |  |  |  |  |  |  | (200 means OK, 4xx caller error, 5xx function error). Second element | 
| 204 |  |  |  |  |  |  | ($reason) is a string containing error message, or something like "OK" if status is | 
| 205 |  |  |  |  |  |  | 200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth | 
| 206 |  |  |  |  |  |  | element (%result_meta) is called result metadata and is optional, a hash | 
| 207 |  |  |  |  |  |  | that contains extra information, much like how HTTP response headers provide additional metadata. | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | Return value:  (any) | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | =head1 HOMEPAGE | 
| 212 |  |  |  |  |  |  |  | 
| 213 |  |  |  |  |  |  | Please visit the project's homepage at L<https://metacpan.org/release/App-CSVUtils>. | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | =head1 SOURCE | 
| 216 |  |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  | Source repository is at L<https://github.com/perlancar/perl-App-CSVUtils>. | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | =head1 AUTHOR | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | perlancar <perlancar@cpan.org> | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | =head1 CONTRIBUTING | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | To contribute, you can send patches by email/via RT, or send pull requests on | 
| 227 |  |  |  |  |  |  | GitHub. | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | Most of the time, you don't need to build the distribution yourself. You can | 
| 230 |  |  |  |  |  |  | simply modify the code, then test via: | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | % prove -l | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | If you want to build the distribution (e.g. to try to install it locally on your | 
| 235 |  |  |  |  |  |  | system), you can install L<Dist::Zilla>, | 
| 236 |  |  |  |  |  |  | L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, | 
| 237 |  |  |  |  |  |  | L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other | 
| 238 |  |  |  |  |  |  | Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond | 
| 239 |  |  |  |  |  |  | that are considered a bug and can be reported to me. | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | This software is copyright (c) 2023, 2022, 2021, 2020, 2019, 2018, 2017, 2016 by perlancar <perlancar@cpan.org>. | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  | This is free software; you can redistribute it and/or modify it under | 
| 246 |  |  |  |  |  |  | the same terms as the Perl 5 programming language system itself. | 
| 247 |  |  |  |  |  |  |  | 
| 248 |  |  |  |  |  |  | =head1 BUGS | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-CSVUtils> | 
| 251 |  |  |  |  |  |  |  | 
| 252 |  |  |  |  |  |  | When submitting a bug or request, please include a test-file or a | 
| 253 |  |  |  |  |  |  | patch to an existing test-file that illustrates the bug or desired | 
| 254 |  |  |  |  |  |  | feature. | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | =cut |