pass repaired csv string from error handler callback function back to the csv's getline loop for reparsing

igoryonya has asked for the wisdom of the Perl Monks concerning the following question:

When I parse a csv file, certain records get the following error:

2023/EIQ - QUO character not allowed/105/3/7
[download]

The data:

147;lakjfh lkjsfh ehjd;134-324-730 31;291;24.04.2020;15 000,00;severo-
+vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;347
+636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sber
+bank g. magadan;896868986;98375423895239529987;;96764128476876487264
148;lkjf fdkas fa;123-105-878 17;1;23.04.2020;15 000,00;severo-vostocn
+oe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;347636334;
+23452347344633423542;severo-vostocnoe otdelenie N8645 pao sberbank g.
+ magadan;896868986;98375423895239529987;;23236726352762456346
149;sdfg gdsgsdhsds shsddf;104-424-501 02;146;20.04.2020;15 000,00;sev
+ero-vostocnoe otdelenie pao "sberbank";4243972345;347636334;234523473
+44633423542;severo-vostocnoe otdelenie N8645 pao sberbank g. magadan;
+896868986;98375423895239529987;;23236726352762456346
150;dfgsdfgsdg sdgsdgsdgsdg sdfgdsgs;095-504-250 68;68;17.04.2020;15 0
+00,00;"aziatsko-tihookeanskiy bank" (pao) g. blagovesensk;3473446334;
+280101001;23452344637833423542;"aziatsko-tihookeanskiy bank" (pao) g.
+ blagovesensk;098676868;9837542asdfaas529987;;23236726352762456346
151;sdfgds fdsgd ssdgsd;108-437-022 37;258;23.04.2020;15 000,00;severo
+-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;34
+7636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sbe
+rbank g. magadan;896868986;98375423895239529987;;23236726352762456346
152;bgerghe egertge ertgeer;074-073-043 41;128;20.04.2020;15 000,00;se
+vero-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";424397234
+5;347636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao
+ sberbank g. magadan;896868986;98375423895239529987;;2323672635276245
+6346
153;lskdjfa sflaskjfd aslkdfjaslf;151-533-432 32;33;22.04.2020;15 000,
+00;severo-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243
+972345;347636334;23452347344633423542;severo-vostocnoe otdelenie N864
+5 pao sberbank g. magadan;896868986;98375423895239529987;;23236726352
+762456346
154;lasfnf fsdafasdfas afs;134-092-549 45;21;23.04.2020;5 000,00;sever
+o-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;3
+47636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sb
+erbank g. magadan;896868986;98375423895239529987;;2323672635276245634
+6
155;asdfasf asdf asdfasfd;110-497-874 55;50;24.04.2020;15 000,00;sever
+o-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;3
+47636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sb
+erbank g. magadan;896868986;98375423895239529987;;2323672635276245634
+6
156;sadfasf asdf asdfas;456-978-244 89;117;17.04.2020;15 000,00;severo
+-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;34
+7636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sbe
+rbank g. magadan;896868986;98375423895239529987;;23236726352762456346
157;asdfasfwer asfdasfs sadf;139-220-696 59;26;21.04.2020;15 000,00;se
+vero-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";424397234
+5;347636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao
+ sberbank g. magadan;896868986;98375423895239529987;;2323672635276245
+6346
158;lksj ljlkjlkjl lkjljlk;133-087-587 59;262;23.04.2020;15 000,00;sev
+ero-vostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345
+;347636334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao 
+sberbank g. magadan;896868986;98375423895239529987;;23236726352762456
+346
159;fghd g dfghdhdfgh;141-008-388 12;241;22.04.2020;30 000,00;severo-v
+ostocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;3476
+36334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sberb
+ank g. magadan;896868986;98375423895239529987;;23236726352762456346
160;lkkljh kljhk kjh;123-650-136 21;20;20.04.2020;15 000,00;severo-vos
+tocnoe otdelenie &#8470; 8645 pao "sberbank rossii";4243972345;347636
+334;23452347344633423542;severo-vostocnoe otdelenie N8645 pao sberban
+k g. magadan;896868986;98375423895239529987;;23236726352762456346
161;sdgfd sgdsgdsg sdfgds;154-978-292 22;93;17.04.2020;15 000,00;sever
+o-vostocnoe otdelenie 8645 pao sberbank;4243972345;347636334;23452347
+344633423542;severo-vostocnoe otdelenie N8645 pao sberbank g. magadan
+;896868986;98375423895239529987;;23236726352762456346
162;lkdasj alsdfka sflas;112-031-647 83;61;17.04.2020;15 000,00;severo
+-vostocnoe otdelenie 8645 pao sberbank;7707083893;347636334;234523473
+44633423542;severo-vostocnoe otdelenie N8645 pao sberbank g. magadan;
+896868986;89686898634243972345;;23236726352762456346
[download]

Code used:

#!/usr/bin/env perl

my $codepage = 'utf8';
use utf8;
binmode(STDOUT, ":$codepage");
binmode(STDOIN, ":$codepage");

use Text::CSV;

#get file names:
my $fileTable = shift;

my @tblRows = ();
my @fldNames = ('id', 'fio', 'snils', 'no0', 'data', 'vyplata', 'adres
+_bank0', 'no1', 'no2', 'no3', 'adres_bank1', 'no4', 'no5', 'blank', '
+no6');
my %fldNames = ();
map { $fldNames{$fldNames[$_]} = $_ } 0..$#fldNames;
my $qtyChild = 0;

#CSV handle
$CSV_H = Text::CSV->new({
    sep_char=>";",
    binary=>1,
    blank_is_undef=>1,
    empty_is_undef=>1,
    allow_whitespace=>0,
    allow_loose_quotes=>1
    ,auto_diag=>1
});
$CSV_H->callbacks(error=>\&csverror2023);

if(open my $TBL_H, "<:encoding($codepage)", "$fileTable"){
    until($CSV_H->eof){
        my $row = $CSV_H->getline($TBL_H);

        unless($row->[$fldNames{'id'}] !~ /^[[:digit:]]+$/ || $row->[$
+fldNames{'fio'}] =~ /^[[:digit:]]+$/){
            map { printf "%12s: %s\n", $fldNames[$_], $row->[$_] } 0..
+$#{$row};

            push @tblRows, $row;
        }
        print '=' x 100, "\n";
    }

    close $TBL_H;
}

sub csverror2023{
    print join('/', @_), "\n";
    my $charpos = $_[2];

    my $srcstr = $CSV_H->error_input();
    printf "ERROR_INPUT: %s\n", $srcstr;
    unless($CSV_H->eof){
        my $badchar = quotemeta(substr($srcstr, $charpos - 1, 1));
        printf "BadChar: (%s)\n", $badchar;
        my $prestr = substr($srcstr, 0, $charpos - 1);
        printf "PreMatch: (%s)\n", $prestr;
        $prestr =~ /$badchar[^$badchar]*$/;
        printf "MATCH_iNDEXES: (%s-%s)\n", $-[0], $+[0];
        printf "BadChar0: (%s)\n", substr($prestr, $-[0], 1);
        substr($srcstr, $-[0], 0, '\\');
        printf "ModifiedString: (%s)\n", $srcstr;
    }

    $CSV_H->SetDiag(0);
}
[download]

Command to execute:

csv-prog.pl csv-file.csv
[download]

I added a callback to an error handling function, which gets an invalid record string and fixes the problemmatic areas.
After fixing, I'd like for the fixed string to replace the source string, so it could be reparced in the loop again, but I didn't find any way to pass it back to the loop or to the $CSV_H, so, it replaces the original erroneous string.

Comment on pass repaired csv string from error handler callback function back to the csv's getline loop for reparsing Select or Download Code

Replies are listed 'Best First'.
Re: pass repaired csv string from error handler callback function back to the csv's getline loop for reparsing by choroba (Cardinal) on May 22, 2020 at 07:35 UTC
You can't return a value from the callback, but you can set a variable in it. I changed a bit more in the code, see the comments for explanations. #!/usr/bin/perl use warnings; use strict; use Text::CSV_XS; # Why not get the full strenth of XS? my $codepage = 'utf8'; binmode(STDOUT, ":$codepage"); binmode(STDIN, ":$codepage"); # STDOIN? #get file names: my $fileTable = shift; my @fldNames = qw( id fio snils no0 data vyplata adres_bank0 no1 no2 n +o3 adres_bank1 no4 no5 blank no6 ); my %fldNum; # Better name @fldNum{@fldNames} = 0 .. $#fldNames; # Shorter, faster. my @tblRows; my $CSV_H = Text::CSV_XS->new({ # Missing "my". sep_char => ';', binary => 1, blank_is_undef => 1, empty_is_undef => 1, allow_whitespace => 0, allow_loose_quotes => 1, auto_diag => 1 }); $CSV_H->callbacks(error => \&csverror2023); my $fixed; sub csverror2023{ print join('/', @_), "\n"; my $charpos = $_[2]; my $srcstr = $CSV_H->error_input(); printf "ERROR_INPUT: %s\n", $srcstr; unless($CSV_H->eof){ my $badchar = quotemeta(substr($srcstr, $charpos - 1, 1)); printf "BadChar: (%s)\n", $badchar; my $prestr = substr($srcstr, 0, $charpos - 1); printf "PreMatch: (%s)\n", $prestr; $prestr =~ /$badchar[^$badchar]$/; printf "MATCH_iNDEXES: (%s-%s)\n", $-[0], $+[0]; printf "BadChar0: (%s)\n", substr($prestr, $-[0], 1); substr($srcstr, $-[0], 0, '\\'); printf "ModifiedString: (%s)\n", $srcstr; $fixed = $srcstr; } $CSV_H->SetDiag(0); } if(open my $TBL_H, "<:encoding($codepage)", $fileTable){ # No need to + double quote a single variable. until($CSV_H->eof){ undef $fixed; my $row = $CSV_H->getline($TBL_H); while ($fixed) { my $line = $fixed; undef $fixed; $CSV_H->parse($line); $row = [$CSV_H->fields]; } unless($row->[$fldNum{id}] !~ /^[[:digit:]]+$/ \|\| $row->[$fldN +um{fio}] =~ /^[[:digit:]]+$/){ printf "%12s: %s\n", $fldNames[$_], $row->[$_] for 0 .. $# +{$row}; push @tblRows, $row; } print '=' x 100, "\n"; } close $TBL_H; } [download] `map{substr$_->[0],$_->[1]\|\|0,1}[\\|\|{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]`	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re: pass repaired csv string from error handler callback function back to the csv's getline loop for reparsing
by choroba (Cardinal) on May 22, 2020 at 07:35 UTC

#!/usr/bin/perl
use warnings;
use strict;

use Text::CSV_XS;  # Why not get the full strenth of XS?

my $codepage = 'utf8';
binmode(STDOUT, ":$codepage");
binmode(STDIN, ":$codepage");  # STDOIN?


#get file names:
my $fileTable = shift;

my @fldNames = qw( id fio snils no0 data vyplata adres_bank0 no1 no2 n
+o3 adres_bank1 no4 no5 blank no6 );
my %fldNum;  # Better name
@fldNum{@fldNames} = 0 .. $#fldNames;  # Shorter, faster.


my @tblRows;
my $CSV_H = Text::CSV_XS->new({  # Missing "my".
    sep_char           => ';',
    binary             => 1,
    blank_is_undef     => 1,
    empty_is_undef     => 1,
    allow_whitespace   => 0,
    allow_loose_quotes => 1,
    auto_diag          => 1
});
$CSV_H->callbacks(error => \&csverror2023);

my $fixed;
sub csverror2023{
    print join('/', @_), "\n";
    my $charpos = $_[2];

    my $srcstr = $CSV_H->error_input();
    printf "ERROR_INPUT: %s\n", $srcstr;
    unless($CSV_H->eof){
        my $badchar = quotemeta(substr($srcstr, $charpos - 1, 1));
        printf "BadChar: (%s)\n", $badchar;
        my $prestr = substr($srcstr, 0, $charpos - 1);
        printf "PreMatch: (%s)\n", $prestr;
        $prestr =~ /$badchar[^$badchar]*$/;
        printf "MATCH_iNDEXES: (%s-%s)\n", $-[0], $+[0];
        printf "BadChar0: (%s)\n", substr($prestr, $-[0], 1);
        substr($srcstr, $-[0], 0, '\\');
        printf "ModifiedString: (%s)\n", $srcstr;
        $fixed = $srcstr;
    }
    $CSV_H->SetDiag(0);
}


if(open my $TBL_H, "<:encoding($codepage)", $fileTable){  # No need to
+ double quote a single variable.
    until($CSV_H->eof){
        undef $fixed;
        my $row = $CSV_H->getline($TBL_H);
        while ($fixed) {
            my $line = $fixed;
            undef $fixed;
            $CSV_H->parse($line);
            $row = [$CSV_H->fields];
        }


        unless($row->[$fldNum{id}] !~ /^[[:digit:]]+$/ || $row->[$fldN
+um{fio}] =~ /^[[:digit:]]+$/){
            printf "%12s: %s\n", $fldNames[$_], $row->[$_] for 0 .. $#
+{$row};

            push @tblRows, $row;
        }
        print '=' x 100, "\n";
    }

    close $TBL_H;
}
[download]

map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

[reply]
[d/l]
[select]