1# This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Ireland Ltd. 2# Feedback and improvements are welcome. 3# 4# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 5# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 6# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 7# 8# This program is free software; you can redistribute it and/or modify it under 9# the terms of the GNU General Public License as published by the Free Software 10# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar 11# systems, you can issue `man perlgpl' or `man perlartistic' to read these 12# licenses. 13# 14# You should have received a copy of the GNU General Public License along with 15# this program; if not, write to the Free Software Foundation, Inc., 59 Temple 16# Place, Suite 330, Boston, MA 02111-1307 USA. 17# ########################################################################### 18# Quoter package 19# ########################################################################### 20{ 21# Package: Quoter 22# Quoter handles value quoting, unquoting, escaping, etc. 23package Quoter; 24 25use strict; 26use warnings FATAL => 'all'; 27use English qw(-no_match_vars); 28use constant PTDEBUG => $ENV{PTDEBUG} || 0; 29 30use Data::Dumper; 31$Data::Dumper::Indent = 1; 32$Data::Dumper::Sortkeys = 1; 33$Data::Dumper::Quotekeys = 0; 34 35# Sub: new 36# 37# Parameters: 38# %args - Arguments 39# 40# Returns: 41# Quoter object 42sub new { 43 my ( $class, %args ) = @_; 44 return bless {}, $class; 45} 46 47# Sub: quote 48# Quote values in backticks. 49# 50# Parameters: 51# @vals - List of values to quote 52# 53# Returns: 54# Array of backtick-quoted values 55sub quote { 56 my ( $self, @vals ) = @_; 57 foreach my $val ( @vals ) { 58 $val =~ s/`/``/g; 59 } 60 return join('.', map { '`' . $_ . '`' } @vals); 61} 62 63# Sub: quote_val 64# Quote a value for use in a SQL statement. Examples: undef = "NULL", 65# empty string = '', etc. 66# 67# Parameters: 68# $val - Value to quote 69# 70# Returns: 71# Quoted value 72sub quote_val { 73 my ( $self, $val, %args ) = @_; 74 75 return 'NULL' unless defined $val; # undef = NULL 76 return "''" if $val eq ''; # blank string = '' 77 return $val if $val =~ m/^0x[0-9a-fA-F]+$/ # quote hex data 78 && !$args{is_char}; # unless is_char is true 79 80 # https://bugs.launchpad.net/percona-toolkit/+bug/1229861 81 return $val if $args{is_float}; 82 83 # Quote and return non-numeric vals. 84 $val =~ s/(['\\])/\\$1/g; 85 return "'$val'"; 86} 87 88# Sub: split_unquote 89# Split and unquote a table name. The table name can be database-qualified 90# or not, like `db`.`table`. The table name can be backtick-quoted or not. 91# 92# Parameters: 93# $db_tbl - Table name 94# $default_db - Default database name to return if $db_tbl is not 95# database-qualified 96# 97# Returns: 98# Array: unquoted database (possibly undef), unquoted table 99# 100# See Also: 101# <join_quote> 102sub split_unquote { 103 my ( $self, $db_tbl, $default_db ) = @_; 104 my ( $db, $tbl ) = split(/[.]/, $db_tbl); 105 if ( !$tbl ) { 106 $tbl = $db; 107 $db = $default_db; 108 } 109 for ($db, $tbl) { 110 next unless $_; 111 s/\A`//; 112 s/`\z//; 113 s/``/`/g; 114 } 115 116 return ($db, $tbl); 117} 118 119# Sub: literal_like 120# Escape LIKE wildcard % and _. 121# 122# Parameters: 123# $like - LIKE value to escape 124# 125# Returns: 126# Escaped LIKE value 127sub literal_like { 128 my ( $self, $like ) = @_; 129 return unless $like; 130 $like =~ s/([%_])/\\$1/g; 131 return "'$like'"; 132} 133 134# Sub: join_quote 135# Join and backtick-quote a database name with a table name. This sub does 136# the opposite of split_unquote. 137# 138# Parameters: 139# $default_db - Default database name to use if $db_tbl is not 140# database-qualified 141# $db_tbl - Table name, optionally database-qualified, optionally 142# quoted 143# 144# Returns: 145# Backtick-quoted, database-qualified table like `database`.`table` 146# 147# See Also: 148# <split_unquote> 149sub join_quote { 150 my ( $self, $default_db, $db_tbl ) = @_; 151 return unless $db_tbl; 152 my ($db, $tbl) = split(/[.]/, $db_tbl); 153 if ( !$tbl ) { 154 $tbl = $db; 155 $db = $default_db; 156 } 157 $db = "`$db`" if $db && $db !~ m/^`/; 158 $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; 159 return $db ? "$db.$tbl" : $tbl; 160} 161 162# Return the list passed in, with the elements passed through quotemeta, 163# and the results concatenated with ','. 164sub serialize_list { 165 my ( $self, @args ) = @_; 166 PTDEBUG && _d('Serializing', Dumper(\@args)); 167 return unless @args; 168 169 my @parts; 170 foreach my $arg ( @args ) { 171 if ( defined $arg ) { 172 $arg =~ s/,/\\,/g; # escape commas 173 $arg =~ s/\\N/\\\\N/g; # escape literal \N 174 push @parts, $arg; 175 } 176 else { 177 push @parts, '\N'; 178 } 179 } 180 181 my $string = join(',', @parts); 182 PTDEBUG && _d('Serialized: <', $string, '>'); 183 return $string; 184} 185 186sub deserialize_list { 187 my ( $self, $string ) = @_; 188 PTDEBUG && _d('Deserializing <', $string, '>'); 189 die "Cannot deserialize an undefined string" unless defined $string; 190 191 my @parts; 192 foreach my $arg ( split(/(?<!\\),/, $string) ) { 193 if ( $arg eq '\N' ) { 194 $arg = undef; 195 } 196 else { 197 $arg =~ s/\\,/,/g; 198 $arg =~ s/\\\\N/\\N/g; 199 } 200 push @parts, $arg; 201 } 202 203 if ( !@parts ) { 204 # Perl split() won't split ",,", so handle it manually. 205 my $n_empty_strings = $string =~ tr/,//; 206 $n_empty_strings++; 207 PTDEBUG && _d($n_empty_strings, 'empty strings'); 208 map { push @parts, '' } 1..$n_empty_strings; 209 } 210 elsif ( $string =~ m/(?<!\\),$/ ) { 211 PTDEBUG && _d('Last value is an empty string'); 212 push @parts, ''; 213 } 214 215 PTDEBUG && _d('Deserialized', Dumper(\@parts)); 216 return @parts; 217} 218 219sub _d { 220 my ($package, undef, $line) = caller 0; 221 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } 222 map { defined $_ ? $_ : 'undef' } 223 @_; 224 print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; 225} 226 2271; 228} 229# ########################################################################### 230# End Quoter package 231# ########################################################################### 232