perl5-dbi / sql-statement Goto Github PK

We have created an SQL UPDATE statement with a WHERE clause that has ORed 239 conditions. We are getting

Deep recursion on subroutine "SQL::Parser::non_parens_search"

because SQL::Parser escalates all warnings into fatal errors. Any suggestion how we could turn this off from case to case would be very much appreciated?

SQL::Parser, 1.414, L583

if ( $remainder =~ m/^NATURAL (.+)/ )

use case-insensitive pattern matching modifier /i

Lest we forget ...

use 5.18.2;
use warnings;
use Text::CSV_XS qw( csv );
use DBI;

my $tbl = "issue$$";

csv (out => "$tbl.csv", in => [
    [qw( c_issue issue color size )],
    [1,234,"Black",4],
    [2,345,"Red",8],
    [3,345,"Pink",8],
    [4,456,"White",16]]);

my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
    RaiseError		=> 1,
    PrintError		=> 1,
    ShowErrorStatement	=> 1,
    f_ext		=> ".csv/r",
    }) or die DBI->errstr;
my $sth = $dbh->prepare (qq;
    select   issue, count (*)
    from     $tbl
    group by issue
    having   count (*) > 1;
    );
$sth->execute;
while (my @row = $sth->fetchrow) {
    say "@row";
    }

END { unlink "$tbl.csv"; }

=>

$ perl -MV=Text::CSV_XS,DBI,DBD::File,SQL::Statement
Text::CSV_XS
        /pro/lib/perl5/site_perl/5.24.0/x86_64-linux-thread-multi-ld/Text/CSV_XS.pm: 1.27
DBI
        /pro/lib/perl5/site_perl/5.24.0/x86_64-linux-thread-multi-ld/DBI.pm: 1.636
DBD::File
        /pro/lib/perl5/site_perl/5.24.0/x86_64-linux-thread-multi-ld/DBD/File.pm: 0.44
SQL::Statement
        /pro/lib/perl5/site_perl/5.24.0/SQL/Statement.pm: 1.410
$ perl issue.pl
Bad table or column name: '>' has chars not alphanumeric or underscore! at /pro/lib/perl5/site_perl/5.24.0/SQL/Statement.pm line 90.
DBD::CSV::db prepare failed: Bad table or column name: '>' has chars not alphanumeric or underscore! at /pro/lib/perl5/site_perl/5.24.0/SQL/Statement.pm line 90.
 [for Statement "
    select   issue, count (*)
    from     issue31889
    group by issue
    having   count (*) > 1"] at issue.pl line 23.
DBD::CSV::db prepare failed: Bad table or column name: '>' has chars not alphanumeric or underscore! at /pro/lib/perl5/site_perl/5.24.0/SQL/Statement.pm line 90.
 [for Statement "
    select   issue, count (*)
    from     issue31889
    group by issue
    having   count (*) > 1"] at issue.pl line 23.

my $sql ="SELECT AR.*
FROM
HTF13.AR AR LEFT OUTER JOIN HTF13.AR_X_AGN_REESTR_1
ON
HTF13.AR_X_AGN_REESTR_1.CST_AR_ID = AR.AR_ID AND
HTF13.AR_X_AGN_REESTR_1.CST_SUB_AR_ID = AR.AR_ID
WHERE
AR.AR_PPS_TP_ID = 1527 AND
AR.AR_TP_ID <> 1467 AND
HTF13.AR_X_AGN_REESTR_1.CST_AR_ID IS NULL

"
;

use SQL::Statement;
my $parser = SQL::Parser->new();
$parser->{RaiseError} = 1;
$parser->{PrintError} = 1;

my $stmt = SQL::Statement->new($sql, $parser);

printf("( %s => %s ) \n",, '', join(',', map { $_->name } $stmt->tables()));

my $sql ="SELECT AR.*
FROM
HTF13.AR AR LEFT OUTER JOIN HTF13.AR_X_AGN_REESTR_1
ON
HTF13.AR_X_AGN_REESTR_1.CST_AR_ID = AR.AR_ID OR
HTF13.AR_X_AGN_REESTR_1.CST_SUB_AR_ID = AR.AR_ID
WHERE
AR.AR_PPS_TP_ID = 1527 AND
AR.AR_TP_ID <> 1467 AND
HTF13.AR_X_AGN_REESTR_1.CST_AR_ID IS NULL

"
;

use SQL::Statement;
my $parser = SQL::Parser->new();
$parser->{RaiseError} = 1;
$parser->{PrintError} = 1;

my $stmt = SQL::Statement->new($sql, $parser);

printf("( %s => %s ) \n",, '', join(',', map { $_->name } $stmt->tables()));