Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-Text-CSV for openSUSE:Factory checked in at 2023-09-13 20:43:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Text-CSV (Old) and /work/SRC/openSUSE:Factory/.perl-Text-CSV.new.1766 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Text-CSV" Wed Sep 13 20:43:28 2023 rev:27 rq:1110646 version:2.30.0 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Text-CSV/perl-Text-CSV.changes 2022-08-17 18:22:54.451148287 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Text-CSV.new.1766/perl-Text-CSV.changes 2023-09-13 20:43:44.168314569 +0200 @@ -1,0 +2,9 @@ +Sat Aug 12 03:09:28 UTC 2023 - Tina Müller <timueller+p...@suse.de> + +- updated to 2.03 + see /usr/share/doc/packages/perl-Text-CSV/Changes + + 2.03 2023-08-11 + - Imported tests/fixes from Text::CSV_XS 1.51 + +------------------------------------------------------------------- Old: ---- Text-CSV-2.02.tar.gz New: ---- Text-CSV-2.03.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Text-CSV.spec ++++++ --- /var/tmp/diff_new_pack.suzTXv/_old 2023-09-13 20:43:45.284354246 +0200 +++ /var/tmp/diff_new_pack.suzTXv/_new 2023-09-13 20:43:45.284354246 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-Text-CSV # -# Copyright (c) 2022 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,19 +18,26 @@ %define cpan_name Text-CSV Name: perl-Text-CSV -Version: 2.02 +Version: 2.30.0 Release: 0 +%define cpan_version 2.03 License: Artistic-1.0 OR GPL-1.0-or-later Summary: Comma-separated values manipulator (using XS or PurePerl) URL: https://metacpan.org/release/%{cpan_name} -Source0: https://cpan.metacpan.org/authors/id/I/IS/ISHIGAKI/%{cpan_name}-%{version}.tar.gz +Source0: https://cpan.metacpan.org/authors/id/I/IS/ISHIGAKI/%{cpan_name}-%{cpan_version}.tar.gz Source1: cpanspec.yml BuildArch: noarch BuildRequires: perl BuildRequires: perl-macros BuildRequires: perl(Test::More) >= 0.71 +BuildRequires: perl(Text::CSV_XS) >= 1.510.0 Requires: perl(Test::More) >= 0.71 -Recommends: perl(Text::CSV_XS) >= 1.48 +Requires: perl(Text::CSV_XS) >= 1.510.0 +Provides: perl(Text::CSV) = 2.30.0 +Provides: perl(Text::CSV::ErrorDiag) +Provides: perl(Text::CSV_PP) = 2.30.0 +%define __perllib_provides /bin/true +Recommends: perl(Text::CSV_XS) >= 1.510.0 %{perl_requires} %description @@ -41,7 +48,7 @@ Text::CSV_PP, which is bundled in the same distribution as this module. %prep -%autosetup -n %{cpan_name}-%{version} +%autosetup -n %{cpan_name}-%{cpan_version} %build perl Makefile.PL INSTALLDIRS=vendor ++++++ Text-CSV-2.02.tar.gz -> Text-CSV-2.03.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/Changes new/Text-CSV-2.03/Changes --- old/Text-CSV-2.02/Changes 2022-08-07 22:20:39.000000000 +0200 +++ new/Text-CSV-2.03/Changes 2023-08-11 09:07:51.000000000 +0200 @@ -1,5 +1,8 @@ Revision history for Perl extension Text::CSV. +2.03 2023-08-11 + - Imported tests/fixes from Text::CSV_XS 1.51 + 2.02 2022-08-08 - Imported tests/fixes from Text::CSV_XS 1.48 - Fixed a case where csv function is called as a method (GH#46) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/MANIFEST new/Text-CSV-2.03/MANIFEST --- old/Text-CSV-2.02/MANIFEST 2022-08-07 22:22:06.000000000 +0200 +++ new/Text-CSV-2.03/MANIFEST 2023-08-11 09:10:31.000000000 +0200 @@ -11,6 +11,7 @@ t/10_base.t t/12_acc.t t/15_flags.t +t/16_import.t t/20_file.t t/21_lexicalio.t t/22_scalario.t @@ -26,6 +27,8 @@ t/60_samples.t t/65_allow.t t/66_formula.t +t/67_emptrow.t +t/68_header.t t/70_rt.t t/71_pp.t t/75_hashref.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/META.json new/Text-CSV-2.03/META.json --- old/Text-CSV-2.02/META.json 2022-08-07 22:22:06.000000000 +0200 +++ new/Text-CSV-2.03/META.json 2023-08-11 09:10:31.000000000 +0200 @@ -4,7 +4,7 @@ "Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -32,12 +32,13 @@ }, "runtime" : { "recommends" : { - "Text::CSV_XS" : "1.48" + "Text::CSV_XS" : "1.51" }, "requires" : { "IO::Handle" : "0", "Test::Harness" : "0", "Test::More" : "0.71", + "Text::CSV_XS" : "1.51", "perl" : "5.006001" } } @@ -54,6 +55,6 @@ "url" : "https://github.com/makamaka/Text-CSV"; } }, - "version" : "2.02", - "x_serialization_backend" : "JSON::PP version 4.05" + "version" : "2.03", + "x_serialization_backend" : "JSON::PP version 4.16" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/META.yml new/Text-CSV-2.03/META.yml --- old/Text-CSV-2.02/META.yml 2022-08-07 22:22:06.000000000 +0200 +++ new/Text-CSV-2.03/META.yml 2023-08-11 09:10:31.000000000 +0200 @@ -7,7 +7,7 @@ configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -18,15 +18,16 @@ - t - inc recommends: - Text::CSV_XS: '1.48' + Text::CSV_XS: '1.51' requires: IO::Handle: '0' Test::Harness: '0' Test::More: '0.71' + Text::CSV_XS: '1.51' perl: '5.006001' resources: bugtracker: https://github.com/makamaka/Text-CSV/issues license: http://dev.perl.org/licenses/ repository: https://github.com/makamaka/Text-CSV -version: '2.02' +version: '2.03' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/lib/Text/CSV.pm new/Text-CSV-2.03/lib/Text/CSV.pm --- old/Text-CSV-2.02/lib/Text/CSV.pm 2022-08-07 22:20:44.000000000 +0200 +++ new/Text-CSV-2.03/lib/Text/CSV.pm 2023-08-11 09:09:36.000000000 +0200 @@ -8,14 +8,14 @@ @ISA = qw( Exporter ); BEGIN { - $VERSION = '2.02'; + $VERSION = '2.03'; $DEBUG = 0; } # if use CSV_XS, requires version my $Module_XS = 'Text::CSV_XS'; my $Module_PP = 'Text::CSV_PP'; -my $XS_Version = '1.48'; +my $XS_Version = '1.51'; my $Is_Dynamic = 0; @@ -174,7 +174,7 @@ headers => "auto"); # as array of hash # Write array of arrays as csv file - csv (in => $aoa, out => "file.csv", sep_char=> ";"); + csv (in => $aoa, out => "file.csv", sep_char => ";"); # Only show lines where "code" is odd csv (in => "data.csv", filter => { code => sub { $_ % 2 }}); @@ -482,14 +482,82 @@ =head3 skip_empty_rows my $csv = Text::CSV->new ({ skip_empty_rows => 1 }); - $csv->skip_empty_rows (0); + $csv->skip_empty_rows ("eof"); my $f = $csv->skip_empty_rows; -If this attribute is set to C<1>, any row that has an L</eol> immediately -following the start of line will be skipped. Default behavior is to return -one single empty field. +This attribute defines the behavior for empty rows: an L</eol> immediately +following the start of line. Default behavior is to return one single empty +field. + +This attribute is only used in parsing. This attribute is ineffective when +using L</parse> and L</fields>. + +Possible values for this attribute are + +=over 2 + +=item 0 | undef + + my $csv = Text::CSV->new ({ skip_empty_rows => 0 }); + $csv->skip_empty_rows (undef); + +No special action is taken. The result will be one single empty field. + +=item 1 | "skip" + + my $csv = Text::CSV->new ({ skip_empty_rows => 1 }); + $csv->skip_empty_rows ("skip"); + +The row will be skipped. + +=item 2 | "eof" | "stop" + + my $csv = Text::CSV->new ({ skip_empty_rows => 2 }); + $csv->skip_empty_rows ("eof"); + +The parsing will stop as if an L</eof> was detected. + +=item 3 | "die" + + my $csv = Text::CSV->new ({ skip_empty_rows => 3 }); + $csv->skip_empty_rows ("die"); -This attribute is only used in parsing. +The parsing will stop. The internal error code will be set to 2015 and the +parser will C<die>. + +=item 4 | "croak" + + my $csv = Text::CSV->new ({ skip_empty_rows => 4 }); + $csv->skip_empty_rows ("croak"); + +The parsing will stop. The internal error code will be set to 2015 and the +parser will C<croak>. + +=item 5 | "error" + + my $csv = Text::CSV->new ({ skip_empty_rows => 5 }); + $csv->skip_empty_rows ("error"); + +The parsing will fail. The internal error code will be set to 2015. + +=item callback + + my $csv = Text::CSV->new ({ skip_empty_rows => sub { [] } }); + $csv->skip_empty_rows (sub { [ 42, $., undef, "empty" ] }); + +The callback is invoked and its result used instead. If you want the parse +to stop after the callback, make sure to return a false value. + +The returned value from the callback should be an array-ref. Any other type +will cause the parse to stop, so these are equivalent in behavior: + + csv (in => $fh, skip_empty_rows => "stop"); + csv (in => $fh. skip_empty_rows => sub { 0; }); + +=back + +Without arguments, the current value is returned: C<0>, C<1>, C<eof>, C<die>, +C<croak> or the callback. =head3 formula_handling @@ -1107,7 +1175,8 @@ This will return a reference to a list of L<getline ($fh)|/getline> results. In this call, C<keep_meta_info> is disabled. If C<$offset> is negative, as with C<splice>, only the last C<abs ($offset)> records of C<$fh> are taken -into consideration. +into consideration. Parameters C<$offset> and C<$length> are expected to be +an integers. Non-integer values are interpreted as integer without check. Given a CSV file with 10 lines: @@ -2015,6 +2084,8 @@ my $aoa = csv (in => $fh, headers => "skip"); +C<skip> is invalid/ignored in combinations with L<C<detect_bom>|/detect_bom>. + =item auto If C<auto> is used, the first line of the C<CSV> source will be read as the @@ -2278,7 +2349,9 @@ If C<sep_set> is set, the method L</header> is invoked on the opened stream to detect and set L<C<sep_char>|/sep_char> with the given set. -C<sep_set> can be abbreviated to C<seps>. +C<sep_set> can be abbreviated to C<seps>. If neither C<sep_set> not C<seps> +is given, but C<sep> is defined, C<sep_set> defaults to C<[ sep ]>. This is +only supported for perl version 5.10 and up. Note that as the L</header> method is invoked, its default is to also set the headers. @@ -2860,6 +2933,11 @@ Inconsistent number of fields under strict parsing. =item * +2015 "ERW - Empty row" + +An empty row was not allowed. + +=item * 2021 "EIQ - NL char inside quotes, binary off" Sequences like C<1,"foo\nbar",22,1> are allowed only when the binary option diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/lib/Text/CSV_PP.pm new/Text-CSV-2.03/lib/Text/CSV_PP.pm --- old/Text-CSV-2.02/lib/Text/CSV_PP.pm 2022-08-07 22:20:44.000000000 +0200 +++ new/Text-CSV-2.03/lib/Text/CSV_PP.pm 2023-08-11 09:08:38.000000000 +0200 @@ -12,7 +12,7 @@ use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); use Carp; -$VERSION = '2.02'; +$VERSION = '2.03'; @ISA = qw(Exporter); sub PV { 0 } @@ -51,7 +51,7 @@ CSV_TYPE_NV )], ); -@EXPORT_OK = (qw(csv PV IV NV), @{$EXPORT_TAGS{CONSTANTS}}); +@EXPORT_OK = (qw(csv PV IV NV), @{$EXPORT_TAGS{'CONSTANTS'}}); my $ERRORS = { # Generic errors @@ -83,6 +83,7 @@ 2012 => "EOF - End of data in parsing input stream", 2013 => "ESP - Specification error for fragments RFC7111", 2014 => "ENF - Inconsistent number of fields", + 2015 => "ERW - Empty row", # EIQ - Error Inside Quotes 2021 => "EIQ - NL char inside quotes, binary off", @@ -239,6 +240,7 @@ _BOUND_COLUMNS => undef, _AHEAD => undef, _FORMULA_CB => undef, + _EMPTROW_CB => undef, ENCODING => undef, ); @@ -384,8 +386,9 @@ $last_new_error = Text::CSV_PP->SetDiag(0); defined $\ && !exists $attr{eol} and $self->{eol} = $\; bless $self, $class; - defined $self->{types} and $self->types ($self->{types}); - defined $attr_formula and $self->{formula} = _supported_formula($self, $attr_formula); + defined $self->{'types'} and $self->types($self->{'types'}); + defined $self->{'skip_empty_rows'} and $self->{'skip_empty_rows'} = _supported_skip_empty_rows($self, $self->{'skip_empty_rows'}); + defined $attr_formula and $self->{'formula'} = _supported_formula($self, $attr_formula); $self; } @@ -600,10 +603,33 @@ $self->{strict}; } -sub skip_empty_rows { +sub _supported_skip_empty_rows { + my ($self, $f) = @_; + defined $f or return 0; + if ($self && $f && ref $f && ref $f eq "CODE") { + $self->{'_EMPTROW_CB'} = $f; + return 6; + } + $f =~ m/^(?: 0 | undef )$/xi ? 0 : + $f =~ m/^(?: 1 | skip )$/xi ? 1 : + $f =~ m/^(?: 2 | eof | stop )$/xi ? 2 : + $f =~ m/^(?: 3 | die )$/xi ? 3 : + $f =~ m/^(?: 4 | croak )$/xi ? 4 : + $f =~ m/^(?: 5 | error )$/xi ? 5 : + $f =~ m/^(?: 6 | cb )$/xi ? 6 : do { + $self ||= "Text::CSV_PP"; + croak ($self->_SetDiagInfo (1500, "skip_empty_rows '$f' is not supported")); + }; + } + + sub skip_empty_rows { my $self = shift; - @_ and $self->_set_attr_X ("skip_empty_rows", shift); - $self->{skip_empty_rows}; + @_ and $self->_set_attr_N ("skip_empty_rows", _supported_skip_empty_rows ($self, shift)); + my $ser = $self->{'skip_empty_rows'}; + $ser == 6 or $self->{'_EMPTROW_CB'} = undef; + $ser <= 1 ? $ser : $ser == 2 ? "eof" : $ser == 3 ? "die" : + $ser == 4 ? "croak" : $ser == 5 ? "error" : + $self->{'_EMPTROW_CB'}; } sub _SetDiagInfo { @@ -1115,7 +1141,7 @@ ref $args{munge_column_names} eq "HASH" and @hdr = map { $args{munge_column_names}->{$_} || $_ } @hdr; my %hdr; $hdr{$_}++ for @hdr; - exists $hdr{""} and croak ($self->SetDiag (1012)); + exists $hdr{''} and croak ($self->SetDiag (1012)); unless (keys %hdr == @hdr) { croak ($self->_SetDiagInfo (1013, join ", " => map { "$_ ($hdr{$_})" } grep { $hdr{$_} > 1 } keys %hdr)); @@ -1507,10 +1533,14 @@ my @row1; if (defined $c->{hd_s} || defined $c->{hd_b} || defined $c->{hd_m} || defined $c->{hd_c}) { my %harg; - defined $c->{hd_s} and $harg{sep_set} = $c->{hd_s}; - defined $c->{hd_d} and $harg{detect_bom} = $c->{hd_b}; - defined $c->{hd_m} and $harg{munge_column_names} = $hdrs ? "none" : $c->{hd_m}; - defined $c->{hd_c} and $harg{set_column_names} = $hdrs ? 0 : $c->{hd_c}; + !defined $c->{'hd_s'} && $c->{'attr'}{'sep_char'} and + $c->{'hd_s'} = [ $c->{'attr'}{'sep_char'} ]; + !defined $c->{'hd_s'} && $c->{'attr'}{'sep'} and + $c->{'hd_s'} = [ $c->{'attr'}{'sep'} ]; + defined $c->{'hd_s'} and $harg{'sep_set'} = $c->{'hd_s'}; + defined $c->{'hd_b'} and $harg{'detect_bom'} = $c->{'hd_b'}; + defined $c->{'hd_m'} and $harg{'munge_column_names'} = $hdrs ? "none" : $c->{'hd_m'}; + defined $c->{'hd_c'} and $harg{'set_column_names'} = $hdrs ? 0 : $c->{'hd_c'}; @row1 = $csv->header ($fh, \%harg); my @hdr = $csv->column_names; @hdr and $hdrs ||= \@hdr; @@ -1535,28 +1565,33 @@ $c->{fltr} && grep m/\D/ => keys %{$c->{fltr}} and $hdrs ||= "auto"; if (defined $hdrs) { - if (!ref $hdrs) { - if ($hdrs eq "skip") { - $csv->getline ($fh); # discard; + if (!ref $hdrs or ref $hdrs eq "CODE") { + my $h = $c->{'hd_b'} + ? [ $csv->column_names () ] + : $csv->getline ($fh); + my $has_h = $h && @$h; + + if (ref $hdrs) { + $has_h or return; + my $cr = $hdrs; + $hdrs = [ map { $cr->($hdr{$_} || $_) } @{$h} ]; + } + elsif ($hdrs eq "skip") { + # discard; } elsif ($hdrs eq "auto") { - my $h = $csv->getline ($fh) or return; + $has_h or return; $hdrs = [ map { $hdr{$_} || $_ } @$h ]; } elsif ($hdrs eq "lc") { - my $h = $csv->getline ($fh) or return; + $has_h or return; $hdrs = [ map { lc ($hdr{$_} || $_) } @$h ]; } elsif ($hdrs eq "uc") { - my $h = $csv->getline ($fh) or return; + $has_h or return; $hdrs = [ map { uc ($hdr{$_} || $_) } @$h ]; } } - elsif (ref $hdrs eq "CODE") { - my $h = $csv->getline ($fh) or return; - my $cr = $hdrs; - $hdrs = [ map { $cr->($hdr{$_} || $_) } @$h ]; - } $c->{kh} and $hdrs and @{$c->{kh}} = @$hdrs; } @@ -1588,7 +1623,7 @@ do { my @h = $csv->column_names ($hdrs); my %h; $h{$_}++ for @h; - exists $h{""} and croak ($csv->SetDiag (1012)); + exists $h{''} and croak ($csv->SetDiag (1012)); unless (keys %h == @h) { croak ($csv->_SetDiagInfo (1013, join ", " => map { "$_ ($h{$_})" } grep { $h{$_} > 1 } keys %h)); @@ -2539,12 +2574,46 @@ elsif (defined $c and ($c eq "\012" or $c eq '' or (defined $eol and $c eq $eol and $eol ne "\015"))) { # EOL EOLX: if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref || $$v_ref eq '') && $ctx->{skip_empty_rows}) { - $ctx->{fld_idx} = 0; - $c = $self->__get($ctx, $src); - if (!defined $c) { # EOF - $v_ref = undef; - $waitingForField = 0; - last LOOP; + ### SkipEmptyRow + my $ser = $ctx->{skip_empty_rows}; + if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 5) { $self->SetDiag(2015); return undef; } + + if ($ser <= 2) { # skip & eof + $ctx->{fld_idx} = 0; + $c = $self->__get($ctx, $src); + if (!defined $c or $ser == 2) { # EOF + $v_ref = undef; + $waitingForField = 0; + if ($ser == 2) { return undef; } + last LOOP; + } + } + + if ($ser == 6) { + my $cb = $self->{_EMPTROW_CB}; + unless ($cb && ref $cb eq 'CODE') { + return undef; # A callback is wanted, but none found + } + local $_ = $v_ref; + my $rv = $cb->(); + # Result should be a ref to a list. + unless (ref $rv eq 'ARRAY') { + return undef; + } + my $n = @$rv; + if ($n <= 0) { + return 1; + } + if ($ctx->{is_bound} && $ctx->{is_bound} < $n) { + $n = $ctx->{is_bound} - 1; + } + for (my $i = 0; $i < $n; $i++) { + my $rvi = $rv->[$i]; + $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum); + } + return 1; } goto RESTART; } @@ -2644,13 +2713,47 @@ $ctx->{used}--; $ctx->{has_ahead} = 1; if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref or $$v_ref eq '') && $ctx->{skip_empty_rows}) { - $ctx->{fld_idx} = 0; - $c = $self->__get($ctx, $src); - if (!defined $c) { # EOF - $v_ref = undef; - $waitingForField = 0; - last LOOP; + ### SkipEmptyRow + my $ser = $ctx->{skip_empty_rows}; + if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 5) { $self->SetDiag(2015); return undef; } + + if ($ser <= 2) { # skip & eof + $ctx->{fld_idx} = 0; + $c = $self->__get($ctx, $src); + if (!defined $c) { # EOF + $v_ref = undef; + $waitingForField = 0; + last LOOP; + } + } + + if ($ser == 6) { + my $cb = $self->{_EMPTROW_CB}; + unless ($cb && ref $cb eq 'CODE') { + return undef; # A callback is wanted, but none found + } + local $_ = $v_ref; + my $rv = $cb->(); + # Result should be a ref to a list. + unless (ref $rv eq 'ARRAY') { + return undef; + } + my $n = @$rv; + if ($n <= 0) { + return 1; + } + if ($ctx->{is_bound} && $ctx->{is_bound} < $n) { + $n = $ctx->{is_bound} - 1; + } + for (my $i = 0; $i < $n; $i++) { + my $rvi = $rv->[$i]; + $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum); + } + return 1; } + $$v_ref = $c2; goto RESTART; } @@ -2702,12 +2805,45 @@ $ctx->{used}--; $ctx->{has_ahead} = 1; if ($fnum == 1 && $ctx->{flag} == 0 && (!$v_ref or $$v_ref eq '') && $ctx->{skip_empty_rows}) { - $ctx->{fld_idx} = 0; - $c = $self->__get($ctx, $src); - if (!defined $c) { # EOL - $v_ref = undef; - $waitingForField = 0; - last LOOP; + ### SKipEmptyRow + my $ser = $ctx->{skip_empty_rows}; + if ($ser == 3) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 4) { $self->SetDiag(2015); die "Empty row\n"; } + if ($ser == 5) { $self->SetDiag(2015); return undef; } + + if ($ser <= 2) { # skip & eof + $ctx->{fld_idx} = 0; + $c = $self->__get($ctx, $src); + if (!defined $c) { # EOL + $v_ref = undef; + $waitingForField = 0; + last LOOP; + } + } + + if ($ser == 6) { + my $cb = $self->{_EMPTROW_CB}; + unless ($cb && ref $cb eq 'CODE') { + return undef; # A callback is wanted, but none found + } + local $_ = $v_ref; + my $rv = $cb->(); + # Result should be a ref to a list. + unless (ref $rv eq 'ARRAY') { + return undef; + } + my $n = @$rv; + if ($n <= 0) { + return 1; + } + if ($ctx->{is_bound} && $ctx->{is_bound} < $n) { + $n = $ctx->{is_bound} - 1; + } + for (my $i = 0; $i < $n; $i++) { + my $rvi = $rv->[$i]; + $self->__push_value($ctx, \$rvi, $fields, $fflags, $ctx->{flag}, $fnum); + } + return 1; } goto RESTART; } @@ -2807,6 +2943,8 @@ if ($v_ref) { $self->__push_value($ctx, $v_ref, $fields, $fflags, $ctx->{flag}, $fnum); + } elsif ($ctx->{flag} == 0 && $fnum == 1 && $ctx->{skip_empty_rows} == 1) { + return undef; } return 1; } @@ -2939,7 +3077,7 @@ sub __push_value { # AV_PUSH (part of) my ($self, $ctx, $v_ref, $fields, $fflags, $flag, $fnum) = @_; utf8::encode($$v_ref) if $ctx->{utf8}; - if ($ctx->{formula} && $$v_ref && substr($$v_ref, 0, 1) eq '=') { + if ($ctx->{formula} && defined $$v_ref && substr($$v_ref, 0, 1) eq '=') { my $value = $self->_formula($ctx, $$v_ref, $fnum); push @$fields, defined $value ? $value : undef; return; @@ -3144,7 +3282,7 @@ headers => "auto"); # as array of hash # Write array of arrays as csv file - csv (in => $aoa, out => "file.csv", sep_char=> ";"); + csv (in => $aoa, out => "file.csv", sep_char => ";"); # Only show lines where "code" is odd csv (in => "data.csv", filter => { code => sub { $_ % 2 }}); @@ -3428,14 +3566,82 @@ =head3 skip_empty_rows my $csv = Text::CSV_PP->new ({ skip_empty_rows => 1 }); - $csv->skip_empty_rows (0); + $csv->skip_empty_rows ("eof"); my $f = $csv->skip_empty_rows; -If this attribute is set to C<1>, any row that has an L</eol> immediately -following the start of line will be skipped. Default behavior is to return -one single empty field. +This attribute defines the behavior for empty rows: an L</eol> immediately +following the start of line. Default behavior is to return one single empty +field. + +This attribute is only used in parsing. This attribute is ineffective when +using L</parse> and L</fields>. + +Possible values for this attribute are + +=over 2 -This attribute is only used in parsing. +=item 0 | undef + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 0 }); + $csv->skip_empty_rows (undef); + +No special action is taken. The result will be one single empty field. + +=item 1 | "skip" + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 1 }); + $csv->skip_empty_rows ("skip"); + +The row will be skipped. + +=item 2 | "eof" | "stop" + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 2 }); + $csv->skip_empty_rows ("eof"); + +The parsing will stop as if an L</eof> was detected. + +=item 3 | "die" + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 3 }); + $csv->skip_empty_rows ("die"); + +The parsing will stop. The internal error code will be set to 2015 and the +parser will C<die>. + +=item 4 | "croak" + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 4 }); + $csv->skip_empty_rows ("croak"); + +The parsing will stop. The internal error code will be set to 2015 and the +parser will C<croak>. + +=item 5 | "error" + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => 5 }); + $csv->skip_empty_rows ("error"); + +The parsing will fail. The internal error code will be set to 2015. + +=item callback + + my $csv = Text::CSV_PP->new ({ skip_empty_rows => sub { [] } }); + $csv->skip_empty_rows (sub { [ 42, $., undef, "empty" ] }); + +The callback is invoked and its result used instead. If you want the parse +to stop after the callback, make sure to return a false value. + +The returned value from the callback should be an array-ref. Any other type +will cause the parse to stop, so these are equivalent in behavior: + + csv (in => $fh, skip_empty_rows => "stop"); + csv (in => $fh. skip_empty_rows => sub { 0; }); + +=back + +Without arguments, the current value is returned: C<0>, C<1>, C<eof>, C<die>, +C<croak> or the callback. =head3 formula_handling @@ -4053,7 +4259,8 @@ This will return a reference to a list of L<getline ($fh)|/getline> results. In this call, C<keep_meta_info> is disabled. If C<$offset> is negative, as with C<splice>, only the last C<abs ($offset)> records of C<$fh> are taken -into consideration. +into consideration. Parameters C<$offset> and C<$length> are expected to be +an integers. Non-integer values are interpreted as integer without check. Given a CSV file with 10 lines: @@ -4942,6 +5149,8 @@ my $aoa = csv (in => $fh, headers => "skip"); +C<skip> is invalid/ignored in combinations with L<C<detect_bom>|/detect_bom>. + =item auto If C<auto> is used, the first line of the C<CSV> source will be read as the @@ -5205,7 +5414,9 @@ If C<sep_set> is set, the method L</header> is invoked on the opened stream to detect and set L<C<sep_char>|/sep_char> with the given set. -C<sep_set> can be abbreviated to C<seps>. +C<sep_set> can be abbreviated to C<seps>. If neither C<sep_set> not C<seps> +is given, but C<sep> is defined, C<sep_set> defaults to C<[ sep ]>. This is +only supported for perl version 5.10 and up. Note that as the L</header> method is invoked, its default is to also set the headers. @@ -5787,6 +5998,11 @@ Inconsistent number of fields under strict parsing. =item * +2015 "ERW - Empty row" + +An empty row was not allowed. + +=item * 2021 "EIQ - NL char inside quotes, binary off" Sequences like C<1,"foo\nbar",22,1> are allowed only when the binary option diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/12_acc.t new/Text-CSV-2.03/t/12_acc.t --- old/Text-CSV-2.02/t/12_acc.t 2022-08-07 21:51:04.000000000 +0200 +++ new/Text-CSV-2.03/t/12_acc.t 2023-08-07 20:08:29.000000000 +0200 @@ -192,19 +192,26 @@ foreach my $quo (undef, "", " ", "\t", "!!!!!!") { defined $esc && $esc =~ m/[ \t]/ or defined $quo && $quo =~ m/[ \t]/ or next; + my $wc = join " " => map { + !defined $_ ? "<undef>" : + $_ eq "" ? "<empty>" : + $_ eq " " ? "<sp>" : + $_ eq "\t" ? "<tab>" : $_ } + "esc:", $esc, "quo:", $quo; eval { $csv = Text::CSV->new ({ escape => $esc, quote => $quo, allow_whitespace => 1, }) }; - like ((Text::CSV::error_diag)[1], qr{^INI - allow_whitespace}, "Wrong combo - error message"); - is ((Text::CSV::error_diag)[0], 1002, "Wrong combo - numeric error"); + like ((Text::CSV::error_diag)[1], qr{^INI - allow_whitespace}, "Wrong combo - error message: $wc"); + is ((Text::CSV::error_diag)[0], 1002, "Wrong combo - numeric error: $wc"); } } # Test 1003 in constructor foreach my $x ("\r", "\n", "\r\n", "x\n", "\rx") { foreach my $attr (qw( sep_char quote_char escape_char )) { + #ok (1, "attr: $attr => ", $x =~ s/\n/\\n/gr =~ s/\r/\\r/gr); eval { $csv = Text::CSV->new ({ $attr => $x }) }; is ((Text::CSV::error_diag)[0], 1003, "eol in $attr"); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/16_import.t new/Text-CSV-2.03/t/16_import.t --- old/Text-CSV-2.02/t/16_import.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Text-CSV-2.03/t/16_import.t 2023-08-07 20:08:29.000000000 +0200 @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +use strict; +$^W = 1; + +use Test::More tests => 41; + +BEGIN { + $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; + use_ok "Text::CSV", qw( :CONSTANTS PV IV NV ); + plan skip_all => "Cannot load Text::CSV" if $@; + } + +is ( PV, 0, "Type PV"); +is ( IV, 1, "Type IV"); +is ( NV, 2, "Type NV"); + +is ( PV (), 0, "Type PV f"); +is ( IV (), 1, "Type IV f"); +is ( NV (), 2, "Type NV f"); + +is (Text::CSV::PV, 0, "Type T:C:PV"); +is (Text::CSV::IV, 1, "Type T:C:IV"); +is (Text::CSV::NV, 2, "Type T:C:NV"); + +is (Text::CSV::PV (), 0, "Type T:C:PV f"); +is (Text::CSV::IV (), 1, "Type T:C:IV f"); +is (Text::CSV::NV (), 2, "Type T:C:NV f"); + +is ( CSV_TYPE_PV, 0, "Type CT_PV"); +is ( CSV_TYPE_IV, 1, "Type CT_IV"); +is ( CSV_TYPE_NV, 2, "Type CT_NV"); + +is ( CSV_TYPE_PV (), 0, "Type CT_PV f"); +is ( CSV_TYPE_IV (), 1, "Type CT_IV f"); +is ( CSV_TYPE_NV (), 2, "Type CT_NV f"); + +is (Text::CSV::CSV_TYPE_PV, 0, "Type T:C:CT_PV"); +is (Text::CSV::CSV_TYPE_IV, 1, "Type T:C:CT_IV"); +is (Text::CSV::CSV_TYPE_NV, 2, "Type T:C:CT_NV"); + +is (Text::CSV::CSV_TYPE_PV (), 0, "Type T:C:CT_PV f"); +is (Text::CSV::CSV_TYPE_IV (), 1, "Type T:C:CT_IV f"); +is (Text::CSV::CSV_TYPE_NV (), 2, "Type T:C:CT_NV f"); + +is ( CSV_FLAGS_IS_QUOTED, 1, "is_Q"); +is ( CSV_FLAGS_IS_BINARY, 2, "is_B"); +is ( CSV_FLAGS_ERROR_IN_FIELD, 4, "is_E"); +is ( CSV_FLAGS_IS_MISSING, 16, "is_M"); + +is ( CSV_FLAGS_IS_QUOTED (), 1, "is_Q f"); +is ( CSV_FLAGS_IS_BINARY (), 2, "is_B f"); +is ( CSV_FLAGS_ERROR_IN_FIELD (), 4, "is_E f"); +is ( CSV_FLAGS_IS_MISSING (), 16, "is_M f"); + +is (Text::CSV::CSV_FLAGS_IS_QUOTED, 1, "is_Q"); +is (Text::CSV::CSV_FLAGS_IS_BINARY, 2, "is_B"); +is (Text::CSV::CSV_FLAGS_ERROR_IN_FIELD, 4, "is_E"); +is (Text::CSV::CSV_FLAGS_IS_MISSING, 16, "is_M"); + +is (Text::CSV::CSV_FLAGS_IS_QUOTED (), 1, "T:C:is_Q f"); +is (Text::CSV::CSV_FLAGS_IS_BINARY (), 2, "T:C:is_B f"); +is (Text::CSV::CSV_FLAGS_ERROR_IN_FIELD (), 4, "T:C:is_E f"); +is (Text::CSV::CSV_FLAGS_IS_MISSING (), 16, "T:C:is_M f"); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/67_emptrow.t new/Text-CSV-2.03/t/67_emptrow.t --- old/Text-CSV-2.02/t/67_emptrow.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Text-CSV-2.03/t/67_emptrow.t 2023-08-11 08:24:05.000000000 +0200 @@ -0,0 +1,126 @@ +#!/usr/bin/perl + +use strict; +$^W = 1; + +use Test::More; + +BEGIN { + if ($] < 5.008001) { + plan skip_all => "This test unit requires perl-5.8.1 or higher"; + } + else { + plan tests => 47; + } + + $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; + + use_ok "Text::CSV", ("csv"); + plan skip_all => "Cannot load Text::CSV" if $@; + } +my $tfn = "_67test.csv"; END { -f $tfn and unlink $tfn; } + +ok (my $csv = Text::CSV->new, "new"); + +is ($csv->skip_empty_rows, 0, "default"); +is ($csv->skip_empty_rows (1), 1, "+1"); +is ($csv->skip_empty_rows ("skip"), 1, "skip"); +is ($csv->skip_empty_rows ("SKIP"), 1, "SKIP"); +is ($csv->skip_empty_rows (2), "eof", "+2"); +is ($csv->skip_empty_rows ("eof"), "eof", "eof"); +is ($csv->skip_empty_rows ("EOF"), "eof", "EOF"); +is ($csv->skip_empty_rows ("stop"), "eof", "stop"); +is ($csv->skip_empty_rows ("STOP"), "eof", "STOP"); +is ($csv->skip_empty_rows (3), "die", "+3"); +is ($csv->skip_empty_rows ("die"), "die", "die"); +is ($csv->skip_empty_rows ("DIE"), "die", "DIE"); +is ($csv->skip_empty_rows (4), "croak", "+4"); +is ($csv->skip_empty_rows ("croak"), "croak", "croak"); +is ($csv->skip_empty_rows ("CROAK"), "croak", "CROAK"); +is ($csv->skip_empty_rows (5), "error", "+5"); +is ($csv->skip_empty_rows ("error"), "error", "error"); +is ($csv->skip_empty_rows ("ERROR"), "error", "ERROR"); + +sub cba { [ 3, 42, undef, 3 ] } +sub cbh { { a => 3, b => 42, c => undef, d => 3 } } + +is ($csv->skip_empty_rows (\&cba), \&cba, "callback"); + +is ($csv->skip_empty_rows (0), 0, "+0"); +is ($csv->skip_empty_rows (undef), 0, "undef"); + +open my $fh, ">", $tfn; +print $fh "a,b,c,d\n"; +print $fh "1,2,0,4\n"; +print $fh "4,0,9,1\n"; +print $fh "\n"; +print $fh "8,2,7,1\n"; +print $fh "\n"; +print $fh "\n"; +print $fh "5,7,9,3\n"; +print $fh "\n"; +close $fh; + +my @parg = (auto_diag => 0, in => $tfn); +my @head = ([qw( a b c d )], [1,2,0,4], [4,0,9,1]); +my @repl = (1..4); +my $ea = \@repl; + +# Array behavior +is_deeply (csv (@parg, skip_empty_rows => 0), [ @head, + [""],[8,2,7,1],[""],[""],[5,7,9,3],[""]], "A Default"); + +is_deeply (csv (@parg, skip_empty_rows => 1), [ @head, + [8,2,7,1],[5,7,9,3]], "A Skip"); + +is_deeply (csv (@parg, skip_empty_rows => 2), \@head, "A EOF"); + +is (eval { csv (@parg, skip_empty_rows => 3); }, undef, "A die"); +like ($@, qr{^Empty row}, "A msg"); + +is (eval { csv (@parg, skip_empty_rows => 4); }, undef, "A croak"); +like ($@, qr{^Empty row}, "A msg"); + +$@ = ""; +$csv = Text::CSV->new ({ skip_empty_rows => 5 }); +is_deeply ($csv->csv (@parg), \@head, "A error"); +is ($@, "", "A msg"); +is (0 + $csv->error_diag, 2015, "A code"); + +is_deeply (csv (@parg, skip_empty_rows => sub {\@repl}), [ @head, + $ea,[8,2,7,1],$ea,$ea,[5,7,9,3],$ea], "A Callback"); +is_deeply (csv (@parg, skip_empty_rows => sub {0}), \@head, "A Callback 0"); + +# Hash behavior +push @parg => bom => 1; +my $eh = { a => "", b => undef, c => undef, d => undef }, +@head = ({ a => 1, b => 2, c => 0, d => 4 }, + { a => 4, b => 0, c => 9, d => 1 }); +is_deeply (csv (@parg, skip_empty_rows => 0), [ @head, $eh, + { a => 8, b => 2, c => 7, d => 1 },$eh,$eh, + { a => 5, b => 7, c => 9, d => 3 },$eh], "H Default"); + +is_deeply (csv (@parg, skip_empty_rows => 1), [ @head, + { a => 8, b => 2, c => 7, d => 1 }, + { a => 5, b => 7, c => 9, d => 3 }], "H Skip"); + +is_deeply (csv (@parg, skip_empty_rows => 2), \@head, "H EOF"); + +is (eval { csv (@parg, skip_empty_rows => 3); }, undef, "H die"); +like ($@, qr{^Empty row}, "H msg"); + +is (eval { csv (@parg, skip_empty_rows => 4); }, undef, "H croak"); +like ($@, qr{^Empty row}, "H msg"); + +$@ = ""; +$csv = Text::CSV->new ({ skip_empty_rows => 5 }); +is_deeply ($csv->csv (@parg), \@head, "H error"); +is ($@, "", "H msg"); +is (0 + $csv->error_diag, 2015, "H code"); + +$eh = { a => 1, b => 2, c => 3, d => 4 }; +is_deeply (csv (@parg, skip_empty_rows => sub {\@repl}), [ @head, $eh, + { a => 8, b => 2, c => 7, d => 1 },$eh,$eh, + { a => 5, b => 7, c => 9, d => 3 },$eh], "H Callback"); + +is_deeply (csv (@parg, skip_empty_rows => sub {0}), \@head, "H Callback 0"); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/68_header.t new/Text-CSV-2.03/t/68_header.t --- old/Text-CSV-2.02/t/68_header.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Text-CSV-2.03/t/68_header.t 2023-08-07 20:08:29.000000000 +0200 @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +use strict; +$^W = 1; + +use Test::More; + +BEGIN { + if ($] < 5.008001) { + plan skip_all => "This test unit requires perl-5.8.1 or higher"; + } + else { + plan tests => 32; + } + + $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; + + use_ok "Text::CSV", "csv"; + require "./t/util.pl"; + } + +my $tfn = "_68test.csv"; END { unlink $tfn, "_$tfn"; } + +my @dta = ( + [qw( foo bar zap )], + [qw( mars venus pluto )], + [qw( 1 2 3 )], + ); +my @dth = ( + { foo => "mars", bar => "venus", zap => "pluto" }, + { foo => 1, bar => 2, zap => 3 }, + ); + +{ open my $fh, ">", $tfn or die "$tfn: $!\n"; + local $" = ","; + print $fh "@$_\n" for @dta; + close $fh; + } + +is_deeply (csv (in => $tfn), \@dta, "csv ()"); +is_deeply (csv (in => $tfn, bom => 1), \@dth, "csv (bom)"); +is_deeply (csv (in => $tfn, headers => "auto"), \@dth, "csv (headers)"); +is_deeply (csv (in => $tfn, bom => 1, headers => "auto"), \@dth, "csv (bom, headers)"); + +foreach my $arg ("", "bom", "auto", "bom, auto") { + open my $fh, "<", $tfn or die "$tfn: $!\n"; + my %attr; + $arg =~ m/bom/ and $attr{bom} = 1; + $arg =~ m/auto/ and $attr{headers} = "auto"; + ok (my $csv = Text::CSV->new (), "New ($arg)"); + is ($csv->record_number, 0, "start"); + if ($arg) { + is_deeply ([ $csv->header ($fh, \%attr) ], $dta[0], "Header") if $arg; + is ($csv->record_number, 1, "first data-record"); + is_deeply ($csv->getline_hr ($fh), $dth[$_], "getline $_") for 0..$#dth; + } + else { + is_deeply ($csv->getline ($fh), $dta[$_], "getline $_") for 0..$#dta; + } + is ($csv->record_number, 3, "done"); + close $fh; + } + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/77_getall.t new/Text-CSV-2.03/t/77_getall.t --- old/Text-CSV-2.02/t/77_getall.t 2022-08-07 21:51:04.000000000 +0200 +++ new/Text-CSV-2.03/t/77_getall.t 2023-08-07 20:08:29.000000000 +0200 @@ -3,7 +3,7 @@ use strict; $^W = 1; -use Test::More tests => 61; +use Test::More tests => 81; BEGIN { $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; @@ -29,13 +29,19 @@ $sub->(\@list); $sub->(\@list, 0); $sub->([@list[2,3]], 2); - $sub->([], 0, 0); - $sub->(\@list, 0, 10); - $sub->([@list[0,1]], 0, 2); - $sub->([@list[1,2]], 1, 2); + $sub->([], 0, 0); + $sub->(\@list, 0, 10); + $sub->([@list[0,1]], 0, 2); + $sub->([@list[1,2]], 1, 2); + $sub->([@list[1,2]], 1e0, 2); + $sub->([@list[1,2]], "1", 2); $sub->([@list[1..3]], -3); - $sub->([@list[1,2]], -3, 2); - $sub->([@list[1..3]], -3, 3); + $sub->([@list[1,2]], -3, 2); + $sub->([@list[1..3]], -3, 3); + + $sub->([$list[0]], 0, 1); + $sub->([$list[0]], 0, 1e0); + $sub->([$list[0]], 0, "1"); } # do_tests foreach my $eol ("\n", "\r") { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/80_diag.t new/Text-CSV-2.03/t/80_diag.t --- old/Text-CSV-2.02/t/80_diag.t 2022-08-07 21:51:04.000000000 +0200 +++ new/Text-CSV-2.03/t/80_diag.t 2023-08-07 20:08:29.000000000 +0200 @@ -3,7 +3,7 @@ use strict; $^W = 1; - use Test::More tests => 335; + use Test::More tests => 345; #use Test::More "no_plan"; my %err; @@ -62,7 +62,7 @@ parse_err 2037, 1, 11, 1, qq{\0 }; { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; $csv->error_diag (); ok (@warn == 1, "Got error message"); like ($warn[0], qr{^# CSV_(?:PP|XS) ERROR: 2037 - EIF}, "error content"); @@ -75,26 +75,26 @@ is (Text::CSV->new ({ ecs_char => ":" }), undef, "Unsupported option"); { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; Text::CSV::error_diag (); ok (@warn == 1, "Error_diag in void context ::"); like ($warn[0], qr{^# CSV_(?:PP|XS) ERROR: 1000 - INI}, "error content"); } { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; Text::CSV->error_diag (); ok (@warn == 1, "Error_diag in void context ->"); like ($warn[0], qr{^# CSV_(?:PP|XS) ERROR: 1000 - INI}, "error content"); } { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; is (Text::CSV->new ({ auto_diag => 0, ecs_char => ":" }), undef, "Unsupported option"); ok (@warn == 0, "Error_diag in from new ({ auto_diag => 0})"); } { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; is (Text::CSV->new ({ auto_diag => 1, ecs_char => ":" }), undef, "Unsupported option"); ok (@warn == 1, "Error_diag in from new ({ auto_diag => 1})"); @@ -117,7 +117,7 @@ ok (1, "Test auto_diag"); $csv = Text::CSV->new ({ auto_diag => 1 }); { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; is ($csv->{_RECNO}, 0, "No records read yet"); is ($csv->parse ('"","'), 0, "1 - bad parse"); ok (@warn == 1, "1 - One error"); @@ -125,7 +125,7 @@ is ($csv->{_RECNO}, 1, "One record read"); } { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; is ($csv->diag_verbose (3), 3, "Set diag_verbose"); is ($csv->parse ('"","'), 0, "1 - bad parse"); ok (@warn == 1, "1 - One error"); @@ -142,7 +142,7 @@ } { my @warn; - local $SIG{__WARN__} = sub { push @warn, @_ }; + local $SIG{__WARN__} = sub { push @warn => @_ }; # Invalid error_input calls is (Text::CSV::error_input (undef), undef, "Bad error_input call"); @@ -300,7 +300,7 @@ is_deeply ($aoh, [{ 1 => 1, 2 => 2, 3 => 3 }], "Column dropped"); my @e; eval { - local $SIG{__WARN__} = sub { push @e, @_ }; + local $SIG{__WARN__} = sub { push @e => @_ }; $aoh = Text::CSV::csv (in => $tfn, headers => "auto", strict => 1); }; is_deeply ($aoh, [], "Fail under strict"); @@ -315,7 +315,7 @@ is_deeply ($aoh, [{ 1 => 1, 2 => 2, 3 => 3, 4 => undef }], "Column added"); @e = (); eval { - local $SIG{__WARN__} = sub { push @e, @_ }; + local $SIG{__WARN__} = sub { push @e => @_ }; $aoh = Text::CSV::csv (in => $tfn, headers => "auto", strict => 1); }; is_deeply ($aoh, [], "Fail under strict"); @@ -340,7 +340,7 @@ } SKIP: { - $] < 5.008 and skip qq{$] does not support ScalarIO}, 14; + $] < 5.008 and skip qq{$] does not support ScalarIO}, 24; foreach my $key ({}, sub {}, []) { my $csv = Text::CSV->new; my $x = eval { $csv->csv (in => \"a,b", key => $key) }; @@ -363,6 +363,17 @@ my @diag = $csv->error_diag; is ($diag[0], 1503, "Invalid value type"); } + + foreach my $ser ("die", 4) { + ok (my $csv = Text::CSV->new ({ skip_empty_rows => $ser }), + "New CSV for SER $ser"); + is (eval { $csv->csv (in => \"\n") }, undef, + "Parse empty line for SER $ser"); + like ($@, qr{^Empty row}, "Message"); + my @diag = $csv->error_diag; + is ($diag[0], 2015, "Empty row"); + like ($diag[1], qr{^ERW - Empty row}, "Error description"); + } } # Issue 19: auto_diag > 1 does not die if ->header () is used @@ -379,8 +390,8 @@ my $ok = eval { open $fh, "<", $tfn or die "$tfn: $!\n"; my $csv = Text::CSV->new ({ auto_diag => 2 }); - $h and push @row, [ $csv->header ($fh) ]; - while (my $row = $csv->getline ($fh)) { push @row, $row } + $h and push @row => [ $csv->header ($fh) ]; + while (my $row = $csv->getline ($fh)) { push @row => $row } close $fh; 1; }; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/90_csv.t new/Text-CSV-2.03/t/90_csv.t --- old/Text-CSV-2.02/t/90_csv.t 2022-08-07 22:18:09.000000000 +0200 +++ new/Text-CSV-2.03/t/90_csv.t 2023-08-07 20:08:29.000000000 +0200 @@ -72,8 +72,9 @@ is_deeply (\@hdr, [qw( foo bar baz )], "Headers kept for $alias"); } foreach my $alias (qw( internal true yes 1 )) { + my $buf = ""; ok (my $ref = csv (in => $tfn, kh => $alias), "csv (kh => $alias)"); - ok (csv (in => $ref, out => \my $buf, kh => $alias, quote_space => 0, eol => "\n"), "get it back"); + ok (csv (in => $ref, out => \$buf, kh => $alias, quote_space => 0, eol => "\n"), "get it back"); is ($buf, $data, "Headers kept for $alias"); } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Text-CSV-2.02/t/91_csv_cb.t new/Text-CSV-2.03/t/91_csv_cb.t --- old/Text-CSV-2.02/t/91_csv_cb.t 2022-08-07 21:51:04.000000000 +0200 +++ new/Text-CSV-2.03/t/91_csv_cb.t 2023-08-07 20:08:29.000000000 +0200 @@ -4,7 +4,7 @@ $^W = 1; #use Test::More "no_plan"; - use Test::More tests => 58; + use Test::More tests => 79; BEGIN { $ENV{PERL_TEXT_CSV} = $ENV{TEST_PERL_TEXT_CSV} || 0; @@ -69,18 +69,21 @@ { foo => 2, bar => "a b", baz => "" }, ], "AOH with filter on column name"); -is_deeply (csv (in => $tfn, headers => "lc"), - [ { foo => 1, bar => 2, baz => 3 }, - { foo => 2, bar => "a b", baz => "" }], - "AOH with lc headers"); -is_deeply (csv (in => $tfn, headers => "uc"), - [ { FOO => 1, BAR => 2, BAZ => 3 }, - { FOO => 2, BAR => "a b", BAZ => "" }], - "AOH with lc headers"); -is_deeply (csv (in => $tfn, headers => sub { lcfirst uc $_[0] }), - [ { fOO => 1, bAR => 2, bAZ => 3 }, - { fOO => 2, bAR => "a b", bAZ => "" }], - "AOH with mangled headers"); +SKIP: { + $] < 5.008001 and skip "No HOH/xx support in $]", 3; + is_deeply (csv (in => $tfn, headers => "lc"), + [ { foo => 1, bar => 2, baz => 3 }, + { foo => 2, bar => "a b", baz => "" }], + "AOH with lc headers"); + is_deeply (csv (in => $tfn, headers => "uc"), + [ { FOO => 1, BAR => 2, BAZ => 3 }, + { FOO => 2, BAR => "a b", BAZ => "" }], + "AOH with lc headers"); + is_deeply (csv (in => $tfn, headers => sub { lcfirst uc $_[0] }), + [ { fOO => 1, bAR => 2, bAZ => 3 }, + { fOO => 2, bAR => "a b", bAZ => "" }], + "AOH with mangled headers"); + } SKIP: { $] < 5.008001 and skip "No BOM support in $]", 1; @@ -134,7 +137,9 @@ }); } # Check content ref in on_in AOH with aliases %_ -{ %_ = ( brt => 42 ); +SKIP: { + $] < 5.008001 and skip "No AOH/alias support in $]", 7; # 6 in on_in, 1 is_deeply + %_ = ( brt => 42 ); my $aoa = csv ( in => $tfn, headers => "auto", @@ -177,7 +182,9 @@ } -{ ok (my $hr = csv (in => $tfn, key => "foo", on_in => sub { +SKIP: { + $] < 5.008001 and skip "Too complicated test for $]", 2; + ok (my $hr = csv (in => $tfn, key => "foo", on_in => sub { $_[1]{quz} = "B"; $_{ziq} = 2; }), "Get into hashref with key and on_in"); is_deeply ($hr->{8}, {qw( bar 13 baz 18 foo 8 quz B ziq 2 )}, @@ -199,21 +206,24 @@ EOD close $fh; -is_deeply (csv (in => $tfn, filter => "not_blank"), - [[3,3,3],[5,7,9],["",""],["",""],["",""," ",""], - ["","",""],["",""," ",""],[8,13,18]], - "filter => not_blank"); -is_deeply (csv (in => $tfn, filter => "not_empty"), - [[3,3,3],[5,7,9],["",""," ",""],["",""," ",""],[8,13,18]], - "filter => not_empty"); -is_deeply (csv (in => $tfn, filter => "filled"), - [[3,3,3],[5,7,9],[8,13,18]], - "filter => filled"); - -is_deeply (csv (in => $tfn, filter => sub { - grep { defined && m/\S/ } @{$_[1]} }), - [[3,3,3],[5,7,9],[8,13,18]], - "filter => filled"); +SKIP: { + $] < 5.008001 and skip "Too complicated test for $]", 4; + is_deeply (csv (in => $tfn, filter => "not_blank"), + [[3,3,3],[5,7,9],["",""],["",""],["",""," ",""], + ["","",""],["",""," ",""],[8,13,18]], + "filter => not_blank"); + is_deeply (csv (in => $tfn, filter => "not_empty"), + [[3,3,3],[5,7,9],["",""," ",""],["",""," ",""],[8,13,18]], + "filter => not_empty"); + is_deeply (csv (in => $tfn, filter => "filled"), + [[3,3,3],[5,7,9],[8,13,18]], + "filter => filled"); + + is_deeply (csv (in => $tfn, filter => sub { + grep { defined && m/\S/ } @{$_[1]} }), + [[3,3,3],[5,7,9],[8,13,18]], + "filter => filled"); + } # Count rows in different ways open $fh, ">", $tfn or die "$tfn: $!"; @@ -241,11 +251,51 @@ my $aoa = csv (in => $tfn, filter => { 0 => sub { $n++; 0; }}); is ($n, 4, "Count rows with filter hash"); } -{ my $n = 0; +SKIP: { + $] < 5.008001 and skip "Too complicated test for $]", 1; + my $n = 0; my $aoa = csv (in => $tfn, filter => sub { $n++; 0; }); is ($n, 4, "Count rows with filter sub"); } -{ my $n = 0; +SKIP: { + $] < 5.008001 and skip "Too complicated test for $]", 1; + my $n = 0; csv (in => $tfn, on_in => sub { $n++; 0; }, out => \"skip"); is ($n, 4, "Count rows with on_in and skipped out"); } + +# sep_set, seps, sep on problematic header +foreach my $sep (",", ";", "\t") { + my $ph = "Problematic header"; + + open $fh, ">", $tfn or die "$tfn: $!"; + print $fh qq{foo${sep}"bar: a, b"${sep}"c;d"${sep}"e"\n}; + print $fh qq{1${sep}2${sep}3${sep}4\n}; + close $fh; + + my $exp = [{ + "foo" => 1, + "bar: a, b" => 2, + "c;d" => 3, + "e" => 4, + }]; + + ok (csv (in => $tfn, allow_loose_quotes => 1), "$ph, AoA"); + + if ($] < 5.010000) { + ok (1, "Unsupported header feature for $] - sep: $sep") for 1..6; + next; + } + + my @err; + is (eval { + local $SIG{__WARN__} = sub { push @err => @_ }; + csv (in => $tfn, bom => 1); + }, undef, "$ph: cannot decide on sep"); + like ($err[0], qr{ERROR: 1011\b}, "$ph: error 1011"); + + is_deeply (csv (in => $tfn, bom => 1, sep_set => [ $sep ]), $exp, "$ph: sep_set"); + is_deeply (csv (in => $tfn, bom => 1, seps => [ $sep ]), $exp, "$ph: seps"); + is_deeply (csv (in => $tfn, bom => 1, sep_char => $sep ), $exp, "$ph: sep_char"); + is_deeply (csv (in => $tfn, bom => 1, sep => $sep ), $exp, "$ph: sep"); + }
