Bug #85174 for SQL-Statement: Complex Literals

A simple solution for this bug is to implement a strict reporting switch in the parser instantiation method ie: $self->{strict} =1; This can be overridden by users wanting less stringent checking of columns like date and interval. All other users will see no difference. The minor changes required are only in subs new , ROW_VALUE and IDENTIFIER as shown below. ie: if (($self->{opts}->{reserved_words}->{$id}) and ($self->{strict}>0)) ############################# # PUBLIC METHODS ############################# sub new { my $class = shift; my $dialect = shift || 'ANSI'; $dialect = 'ANSI' if ( uc $dialect eq 'ANSI' ); $dialect = 'AnyData' if ( ( uc $dialect eq 'ANYDATA' ) or ( uc $dialect eq 'CSV' ) ); $dialect = 'AnyData' if ( $dialect eq 'SQL::Eval' ); my $flags = shift || {}; $flags->{dialect} = $dialect; $flags->{PrintError} = 1 unless ( defined( $flags->{PrintError} ) ); my $self = bless( $flags, $class ); $self->dialect( $self->{dialect} ); $self->set_feature_flags( $self->{select}, $self->{create} ); $self->LOAD('LOAD SQL::Statement::Functions'); $self->{strict} =1; return $self; } ################################################################### # ROW_VALUE ::= <literal> | <column_name> ################################################################### sub ROW_VALUE { my ( $self, $str ) = @_; ... my @newvalues; foreach my $val (@vals) { my $newval = $self->ROW_VALUE($val); if (( $newval && $newval->{type} !~ m/number|column|placeholder|function/ ) and ($self->{strict}>0)) { return $self->do_err(qq[String '$val' not allowed in Numeric expression!]); } push( @newvalues, $newval ); } return { type => 'function', name => 'numeric_exp', str => $str, value => \@newvalues, fullorg => $orgstr, }; } ################################################################### # IDENTIFIER ::= <alphabetic_char> { <alphanumeric_char> | _ }... # # and must not be a reserved word or over 128 chars in length ################################################################### sub IDENTIFIER { my ( $self, $id ) = @_; if ( $id =~ m/^\?QI(.+)\?$/ ) { return 1; } if ( $id =~ m/^(.+)\.([^\.]+)$/ ) { my $schema = $1; # ignored $id = $2; } return 1 if $id =~ m/^".+?"$/s; # QUOTED IDENTIFIER my $err = "Bad table or column name: '$id' "; # BAD CHARS if ( $id =~ /\W/ ) { $err .= "has chars not alphanumeric or underscore!"; return $self->do_err($err); } # CSV requires optional start with _ my $badStartRx = uc( $self->{dialect} ) eq 'ANYDATA' ? qr/^\d/ : qr/^[_\d]/; if ( $id =~ $badStartRx ) { # BAD START $err .= "starts with non-alphabetic character!"; return $self->do_err($err); } if ( length $id > 128 ) { # BAD LENGTH $err .= "contains more than 128 characters!"; return $self->do_err($err); } $id = uc $id; if (($self->{opts}->{reserved_words}->{$id}) and ($self->{strict}>0)) { # BAD RESERVED WORDS $err .= "is a SQL reserved word!"; return $self->do_err($err); } return 1; }