Skip to content

Commit

Permalink
Item13170: fixed complex regexp with T-SQL
Browse files Browse the repository at this point in the history
  • Loading branch information
@cdot
cdot committed Mar 19, 2017
1 parent 1c25ac3 commit f2c9fe9
Show file tree
Hide file tree
Showing 6 changed files with 54 additions and 53 deletions.
4 changes: 2 additions & 2 deletions lib/Foswiki/Contrib/DBIStoreContrib/HoistSQL.pm
View file
Expand Up @@ -251,8 +251,8 @@ my %bop_map = (
return ( $expr, BOOLEAN );
},
'=~' => sub {
my ( $lhs, $lhst, $rhs, $rhst ) = @_;
my $expr = personality->regexp( $lhs, $rhs );
my ( $sexpr, $lhst, $pat, $rhst ) = @_;
my $expr = personality->regexp( $sexpr, $pat );
return ( $expr, BOOLEAN );
},

Expand Down
12 changes: 6 additions & 6 deletions lib/Foswiki/Contrib/DBIStoreContrib/Personality.pm
View file
Expand Up @@ -160,19 +160,19 @@ SQL

=begin TML
---++ regexp($lhs, $rhs) -> $sql
---++ regexp($expr, $pat) -> $sql
Construct an SQL expression to execute the given regular expression
match.
* =$rhs= - right hand side of the match
* =$lhs= - the regular expression (perl syntax)
be different :-(
* =$expr= - string expression
* =$pat= - Foswiki (perl) regular expression
=cut

sub regexp {
my ( $this, $lhs, $rhs ) = @_;
my ( $this, $expr, $pat ) = @_;

return "$lhs REGEXP $rhs";
# Yeah, like any SQL DB is going to do this...
return "$expr REGEXP $pat";
}

=begin TML
Expand Down
50 changes: 25 additions & 25 deletions lib/Foswiki/Contrib/DBIStoreContrib/Personality/MySQL.pm
View file
Expand Up @@ -56,52 +56,52 @@ sub startup {
}

sub regexp {
my ( $this, $lhs, $rhs ) = @_;
my ( $this, $sexpr, $pat ) = @_;

unless ( $rhs =~ s/^'(.*)'$/$1/s ) {
unless ( $pat =~ s/^'(.*)'$/$1/s ) {

# Somewhat risky....
return "$lhs REGEXP ($rhs)";
return "$sexpr REGEXP ($pat)";
}

# MySQL uses POSIX regular expressions.

# POSIX has no support for (?i: etc
$rhs =~ s/^\(\?[a-z]+:(.*)\)$/$1/; # remove (?:i)
$pat =~ s/^\(\?[a-z]+:(.*)\)$/$1/; # remove (?:i)
# Nor hex character codes
$rhs =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$rhs =~ s/\\x{([0-9a-f]+)}/_char("0x$1")/gei;
$pat =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$pat =~ s/\\x{([0-9a-f]+)}/_char("0x$1")/gei;

# Nor \d, \D
$rhs =~ s/(^|(?<=[^\\]))\\d/[0-9]/g;
$rhs =~ s/(^|(?<=[^\\]))\\D/[^0-9]/g;
$pat =~ s/(^|(?<=[^\\]))\\d/[0-9]/g;
$pat =~ s/(^|(?<=[^\\]))\\D/[^0-9]/g;

# Nor \b, \B
$rhs =~ s/\\\\[bB](.*?)\\\\[bB]/\[\[:<:\]\]$1\[\[:>:\]\]/g;
$rhs =~ s/\\\\[bB]($|\|)/\[\[:>:\]\]$1/g;
$rhs =~ s/(^|\|)\\\\[bB]/$1\[\[:<:\]\]/g;
$pat =~ s/\\\\[bB](.*?)\\\\[bB]/\[\[:<:\]\]$1\[\[:>:\]\]/g;
$pat =~ s/\\\\[bB]($|\|)/\[\[:>:\]\]$1/g;
$pat =~ s/(^|\|)\\\\[bB]/$1\[\[:<:\]\]/g;

# Nor \s, \S, \w, \W
$rhs =~ s/(^|(?<=[^\\]))\\s/[ \011\012\015]/g;
$rhs =~ s/(^|(?<=[^\\]))\\S/[^ \011\012\015]/g;
$rhs =~ s/(^|(?<=[^\\]))\\w/[a-zA-Z0-9_]/g;
$rhs =~ s/(^|(?<=[^\\]))\\W/[^a-zA-Z0-9_]/g;
$pat =~ s/(^|(?<=[^\\]))\\s/[ \011\012\015]/g;
$pat =~ s/(^|(?<=[^\\]))\\S/[^ \011\012\015]/g;
$pat =~ s/(^|(?<=[^\\]))\\w/[a-zA-Z0-9_]/g;
$pat =~ s/(^|(?<=[^\\]))\\W/[^a-zA-Z0-9_]/g;

# Convert X? to (X|)
#$rhs =~ s/(?<=[^\\])(\(.*\)|\[.*?\]|\\.|.)\?/($1|)/g; # ?
$rhs =~ s/([\+\*])\?/$1/g;
$rhs =~ s/\?://g;
#$pat =~ s/(?<=[^\\])(\(.*\)|\[.*?\]|\\.|.)\?/($1|)/g; # ?
$pat =~ s/([\+\*])\?/$1/g;
$pat =~ s/\?://g;

# Handle special characters
$rhs =~ s/(?<=[^\\])\\n/\n/g; # will this work?
$rhs =~ s/(?<=[^\\])\\r/\r/g;
$rhs =~ s/(?<=[^\\])\\t/\t/g;
$rhs =~ s/(?<=[^\\])\\b//g; # not supported
$rhs =~ s/(?<=[^\\])\{\d+(,\d*)?\}//g; # not supported
$pat =~ s/(?<=[^\\])\\n/\n/g; # will this work?
$pat =~ s/(?<=[^\\])\\r/\r/g;
$pat =~ s/(?<=[^\\])\\t/\t/g;
$pat =~ s/(?<=[^\\])\\b//g; # not supported
$pat =~ s/(?<=[^\\])\{\d+(,\d*)?\}//g; # not supported
# Escape '
#$rhs =~ s/\\/\\\\/g;
#$pat =~ s/\\/\\\\/g;

return "$lhs REGEXP ('$rhs')";
return "$sexpr REGEXP ('$pat')";
}

sub cast_to_numeric {
Expand Down
14 changes: 7 additions & 7 deletions lib/Foswiki/Contrib/DBIStoreContrib/Personality/PostgreSQL.pm
View file
Expand Up @@ -107,20 +107,20 @@ sub _char {
}

sub regexp {
my ( $this, $lhs, $rhs ) = @_;
my ( $this, $sexpr, $pat ) = @_;

unless ( $rhs =~ s/^'(.*)'$/$1/s ) {
return "$lhs ~ $rhs"; # risky!
unless ( $pat =~ s/^'(.*)'$/$1/s ) {
return "$sexpr ~ $pat"; # risky!
}

my $i = ( $rhs =~ s/^\(\?i:(.*)\)$/$1/s ) ? '*' : '';
my $i = ( $pat =~ s/^\(\?i:(.*)\)$/$1/s ) ? '*' : '';

$rhs =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$rhs =~ s/\\x{([0-9a-f]+)}/_char("0x$1")/gei;
$pat =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$pat =~ s/\\x{([0-9a-f]+)}/_char("0x$1")/gei;

# Postgresql supports full POSIX regexes.

return "$lhs ~$i '$rhs'";
return "$sexpr ~$i '$pat'";
}

sub length {
Expand Down
16 changes: 8 additions & 8 deletions lib/Foswiki/Contrib/DBIStoreContrib/Personality/SQLite.pm
View file
Expand Up @@ -74,27 +74,27 @@ SQL
}

sub regexp {
my ( $this, $lhs, $rhs ) = @_;
my ( $this, $sexpr, $pat ) = @_;

unless ( $rhs =~ s/^'(.*)'$/$1/s ) {
unless ( $pat =~ s/^'(.*)'$/$1/s ) {

# Somewhat risky....
return "$lhs REGEXP $rhs";
return "$sexpr REGEXP $pat";
}

# The macro parser does horrible things with \, causing \\
# to become \\\. Force it back to \\
$rhs =~ s/\\{3}/\\\\/g;
$pat =~ s/\\{3}/\\\\/g;

# SQLite uses PCRE, which supports all of Perl except hex
# char codes
$rhs =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$rhs =~ s/\\x\{([0-9a-f]+)\}/_char("0x$1")/gei;
$pat =~ s/\\x([0-9a-f]{2})/_char("0x$1")/gei;
$pat =~ s/\\x\{([0-9a-f]+)\}/_char("0x$1")/gei;

# Escape '
$rhs =~ s/'/\\'/g;
$pat =~ s/'/\\'/g;

return "$lhs REGEXP '$rhs'";
return "$sexpr REGEXP '$pat'";
}

1;
Expand Down
11 changes: 6 additions & 5 deletions lib/Foswiki/Contrib/DBIStoreContrib/Personality/TransactSQL.pm
View file
Expand Up @@ -131,14 +131,15 @@ sub cast_to_numeric {
}

sub regexp {
my ( $this, $lhs, $rhs ) = @_;
my ( $this, $sexpr, $pat ) = @_;

unless ( $rhs =~ s/^'(.*)'$/$1/s ) {
return "dbo.fn_RegExIsMatch($lhs,$rhs,1)=1"; # risky!
# See https://www.codeproject.com/Articles/19502/A-T-SQL-Regular-Expression-Library-for-SQL-Server
unless ( $pat =~ s/^'(.*)'$/$1/s ) {
return "dbo.fn_RegExIsMatch($sexpr,$pat,1)=1"; # risky!
}
$rhs =~ s/\\/\\\\/g;
$pat =~ s/\\\\/\\/g;

return "dbo.fn_RegExIsMatch($lhs,'$rhs',1)=1";
return "dbo.fn_RegExIsMatch($sexpr,'$pat',1)=1";
}

1;
Expand Down

0 comments on commit f2c9fe9

Please sign in to comment.