| ... | ... |
@@ -124,7 +124,7 @@ sub assign_clause {
|
| 124 | 124 |
my ($self, $param, $opts) = @_; |
| 125 | 125 |
|
| 126 | 126 |
my $wrap = $opts->{wrap} || {};
|
| 127 |
- my ($q, $p) = split //, $self->q('');
|
|
| 127 |
+ my ($q, $p) = $self->_qp; |
|
| 128 | 128 |
|
| 129 | 129 |
# Assign clause (performance is important) |
| 130 | 130 |
join( |
| ... | ... |
@@ -155,7 +155,7 @@ sub column {
|
| 155 | 155 |
# Column clause |
| 156 | 156 |
my @column; |
| 157 | 157 |
$columns ||= []; |
| 158 |
- push @column, $self->q($table) . "." . $self->q($_) . |
|
| 158 |
+ push @column, $self->_tq($table) . "." . $self->q($_) . |
|
| 159 | 159 |
" as " . $self->q("${table}${separator}$_")
|
| 160 | 160 |
for @$columns; |
| 161 | 161 |
|
| ... | ... |
@@ -240,7 +240,7 @@ sub delete {
|
| 240 | 240 |
# Delete statement |
| 241 | 241 |
my $sql = "delete "; |
| 242 | 242 |
$sql .= "$opt{prefix} " if defined $opt{prefix};
|
| 243 |
- $sql .= "from " . $self->q($opt{table}) . " $w->{clause} ";
|
|
| 243 |
+ $sql .= "from " . $self->_tq($opt{table}) . " $w->{clause} ";
|
|
| 244 | 244 |
|
| 245 | 245 |
# Execute query |
| 246 | 246 |
$opt{statement} = 'delete';
|
| ... | ... |
@@ -734,7 +734,7 @@ sub insert {
|
| 734 | 734 |
# Insert statement |
| 735 | 735 |
my $sql = "insert "; |
| 736 | 736 |
$sql .= "$opt{prefix} " if defined $opt{prefix};
|
| 737 |
- $sql .= "into " . $self->q($opt{table}) . " ";
|
|
| 737 |
+ $sql .= "into " . $self->_tq($opt{table}) . " ";
|
|
| 738 | 738 |
if ($opt{bulk_insert}) {
|
| 739 | 739 |
$sql .= $self->_multi_values_clause($params, {wrap => $opt{wrap}}) . " ";
|
| 740 | 740 |
my $new_param = {};
|
| ... | ... |
@@ -886,7 +886,7 @@ sub mycolumn {
|
| 886 | 886 |
# Create column clause |
| 887 | 887 |
my @column; |
| 888 | 888 |
$columns ||= []; |
| 889 |
- push @column, $self->q($table) . "." . $self->q($_) . " as " . $self->q($_) |
|
| 889 |
+ push @column, $self->_tq($table) . "." . $self->q($_) . " as " . $self->q($_) |
|
| 890 | 890 |
for @$columns; |
| 891 | 891 |
|
| 892 | 892 |
return join (', ', @column);
|
| ... | ... |
@@ -932,8 +932,10 @@ sub order {
|
| 932 | 932 |
return DBIx::Custom::Order->new(dbi => $self, @_); |
| 933 | 933 |
} |
| 934 | 934 |
|
| 935 |
-sub q {
|
|
| 936 |
- my ($self, $value, $quotemeta) = @_; |
|
| 935 |
+sub q { shift->_tq($_[0], $_[1], whole => 1) }
|
|
| 936 |
+ |
|
| 937 |
+sub _tq {
|
|
| 938 |
+ my ($self, $value, $quotemeta, %opt) = @_; |
|
| 937 | 939 |
|
| 938 | 940 |
my $quote = $self->{reserved_word_quote}
|
| 939 | 941 |
|| $self->{quote} || $self->quote || '';
|
| ... | ... |
@@ -950,12 +952,34 @@ sub q {
|
| 950 | 952 |
$p = quotemeta($p); |
| 951 | 953 |
} |
| 952 | 954 |
|
| 953 |
- if ($value =~ /\./) {
|
|
| 955 |
+ if ($opt{whole}) { return "$q$value$p" }
|
|
| 956 |
+ else {
|
|
| 954 | 957 |
my @values = split /\./, $value; |
| 958 |
+ push @values, '' unless @values; |
|
| 955 | 959 |
for my $v (@values) { $v = "$q$v$p" }
|
| 956 | 960 |
return join '.', @values; |
| 957 | 961 |
} |
| 958 |
- else { return "$q$value$p" }
|
|
| 962 |
+} |
|
| 963 |
+ |
|
| 964 |
+sub _qp {
|
|
| 965 |
+ my ($self, %opt) = @_; |
|
| 966 |
+ |
|
| 967 |
+ my $quote = $self->{reserved_word_quote}
|
|
| 968 |
+ || $self->{quote} || $self->quote || '';
|
|
| 969 |
+ |
|
| 970 |
+ my $q = substr($quote, 0, 1) || ''; |
|
| 971 |
+ my $p; |
|
| 972 |
+ if (defined $quote && length $quote > 1) {
|
|
| 973 |
+ $p = substr($quote, 1, 1); |
|
| 974 |
+ } |
|
| 975 |
+ else { $p = $q }
|
|
| 976 |
+ |
|
| 977 |
+ if ($opt{quotemeta}) {
|
|
| 978 |
+ $q = quotemeta($q); |
|
| 979 |
+ $p = quotemeta($p); |
|
| 980 |
+ } |
|
| 981 |
+ |
|
| 982 |
+ return ($q, $p); |
|
| 959 | 983 |
} |
| 960 | 984 |
|
| 961 | 985 |
sub register_filter {
|
| ... | ... |
@@ -1032,11 +1056,11 @@ sub select {
|
| 1032 | 1056 |
if ($opt{relation}) {
|
| 1033 | 1057 |
my $found = {};
|
| 1034 | 1058 |
for my $table (@$tables) {
|
| 1035 |
- $sql .= $self->q($table) . ', ' unless $found->{$table};
|
|
| 1059 |
+ $sql .= $self->_tq($table) . ', ' unless $found->{$table};
|
|
| 1036 | 1060 |
$found->{$table} = 1;
|
| 1037 | 1061 |
} |
| 1038 | 1062 |
} |
| 1039 |
- else { $sql .= $self->q($tables->[-1] || '') . ' ' }
|
|
| 1063 |
+ else { $sql .= $self->_tq($tables->[-1] || '') . ' ' }
|
|
| 1040 | 1064 |
$sql =~ s/, $/ /; |
| 1041 | 1065 |
|
| 1042 | 1066 |
# Add tables in parameter |
| ... | ... |
@@ -1234,7 +1258,7 @@ sub update {
|
| 1234 | 1258 |
# Update statement |
| 1235 | 1259 |
my $sql = "update "; |
| 1236 | 1260 |
$sql .= "$opt{prefix} " if defined $opt{prefix};
|
| 1237 |
- $sql .= $self->q($opt{table}) . " set $assign_clause $w->{clause} ";
|
|
| 1261 |
+ $sql .= $self->_tq($opt{table}) . " set $assign_clause $w->{clause} ";
|
|
| 1238 | 1262 |
|
| 1239 | 1263 |
# Execute query |
| 1240 | 1264 |
$opt{statement} = 'update';
|
| ... | ... |
@@ -1280,7 +1304,7 @@ sub values_clause {
|
| 1280 | 1304 |
my $wrap = $opts->{wrap} || {};
|
| 1281 | 1305 |
|
| 1282 | 1306 |
# Create insert parameter tag |
| 1283 |
- my ($q, $p) = split //, $self->q('');
|
|
| 1307 |
+ my ($q, $p) = $self->_qp; |
|
| 1284 | 1308 |
|
| 1285 | 1309 |
# values clause(performance is important) |
| 1286 | 1310 |
'(' .
|
| ... | ... |
@@ -1306,7 +1330,7 @@ sub _multi_values_clause {
|
| 1306 | 1330 |
my $wrap = $opts->{wrap} || {};
|
| 1307 | 1331 |
|
| 1308 | 1332 |
# Create insert parameter tag |
| 1309 |
- my ($q, $p) = split //, $self->q('');
|
|
| 1333 |
+ my ($q, $p) = $self->_qp; |
|
| 1310 | 1334 |
|
| 1311 | 1335 |
# Multi values clause |
| 1312 | 1336 |
my $clause = '(' . join(', ', map { "$q$_$p" } sort keys %{$params->[0]}) . ') values ';
|
| ... | ... |
@@ -1664,12 +1688,15 @@ sub _search_tables {
|
| 1664 | 1688 |
|
| 1665 | 1689 |
# Search tables |
| 1666 | 1690 |
my $tables = []; |
| 1667 |
- my $safety_character = $self->{safety_character};
|
|
| 1668 |
- my $q = $self->_quote; |
|
| 1669 |
- my $quoted_safety_character_re = $self->q("?([$safety_character]+)", 1);
|
|
| 1670 |
- my $table_re = $q ? qr/(?:^|[^$safety_character])${quoted_safety_character_re}?\./
|
|
| 1671 |
- : qr/(?:^|[^$safety_character])([$safety_character]+)\./; |
|
| 1672 |
- while ($source =~ /$table_re/g) { push @$tables, $1 }
|
|
| 1691 |
+ my ($q, $p) = $self->_qp(quotemeta => 1); |
|
| 1692 |
+ $source =~ s/$q//g; |
|
| 1693 |
+ $source =~ s/$p//g; |
|
| 1694 |
+ my $c = $self->safety_character; |
|
| 1695 |
+ |
|
| 1696 |
+ while ($source =~ /((?:[$c]+?\.[$c]+?)|(?:[$c]+?))\.[$c]+/g) {
|
|
| 1697 |
+ $DB::single = 1; |
|
| 1698 |
+ push @$tables, $1; |
|
| 1699 |
+ } |
|
| 1673 | 1700 |
return $tables; |
| 1674 | 1701 |
} |
| 1675 | 1702 |
|
| ... | ... |
@@ -1688,13 +1715,13 @@ sub _where_clause_and_param {
|
| 1688 | 1715 |
$column_join .= $column; |
| 1689 | 1716 |
my $table; |
| 1690 | 1717 |
my $c; |
| 1691 |
- if ($column =~ /(?:(.*?)\.)?(.*)/) {
|
|
| 1718 |
+ if ($column =~ /(?:(.*)\.)?(.*)/) {
|
|
| 1692 | 1719 |
$table = $1; |
| 1693 | 1720 |
$c = $2; |
| 1694 | 1721 |
} |
| 1695 | 1722 |
|
| 1696 | 1723 |
my $table_quote; |
| 1697 |
- $table_quote = $self->q($table) if defined $table; |
|
| 1724 |
+ $table_quote = $self->_tq($table) if defined $table; |
|
| 1698 | 1725 |
my $column_quote = $self->q($c); |
| 1699 | 1726 |
$column_quote = $table_quote . '.' . $column_quote |
| 1700 | 1727 |
if defined $table_quote; |
| ... | ... |
@@ -2362,8 +2389,8 @@ Result class, default to L<DBIx::Custom::Result>. |
| 2362 | 2389 |
my $safety_character = $dbi->safety_character; |
| 2363 | 2390 |
$dbi = $dbi->safety_character($character); |
| 2364 | 2391 |
|
| 2365 |
-Regex of safety character for table and column name, default to '\w'. |
|
| 2366 |
-Note that you don't have to specify like '[\w]'. |
|
| 2392 |
+Regex of safety character for table and column name, default to 'a-zA-Z_'. |
|
| 2393 |
+Note that you don't have to specify like '[a-zA-Z_]'. |
|
| 2367 | 2394 |
|
| 2368 | 2395 |
=head2 C<separator> |
| 2369 | 2396 |
|