# This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Ireland Ltd. # Feedback and improvements are welcome. # # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # This program is free software; you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar # systems, you can issue `man perlgpl' or `man perlartistic' to read these # licenses. # # You should have received a copy of the GNU General Public License along with # this program; if not, write to the Free Software Foundation, Inc., 59 Temple # Place, Suite 330, Boston, MA 02111-1307 USA. # ########################################################################### # Quoter package # ########################################################################### { # Package: Quoter # Quoter handles value quoting, unquoting, escaping, etc. package Quoter; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; use Data::Dumper; $Data::Dumper::Indent = 1; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Quotekeys = 0; # Sub: new # # Parameters: # %args - Arguments # # Returns: # Quoter object sub new { my ( $class, %args ) = @_; return bless {}, $class; } # Sub: quote # Quote values in backticks. # # Parameters: # @vals - List of values to quote # # Returns: # Array of backtick-quoted values sub quote { my ( $self, @vals ) = @_; foreach my $val ( @vals ) { $val =~ s/`/``/g; } return join('.', map { '`' . $_ . '`' } @vals); } # Sub: quote_val # Quote a value for use in a SQL statement. Examples: undef = "NULL", # empty string = '', etc. # # Parameters: # $val - Value to quote # # Returns: # Quoted value sub quote_val { my ( $self, $val, %args ) = @_; return 'NULL' unless defined $val; # undef = NULL return "''" if $val eq ''; # blank string = '' return $val if $val =~ m/^0x[0-9a-fA-F]+$/ # quote hex data && !$args{is_char}; # unless is_char is true # https://bugs.launchpad.net/percona-toolkit/+bug/1229861 return $val if $args{is_float}; # Quote and return non-numeric vals. $val =~ s/(['\\])/\\$1/g; return "'$val'"; } # Sub: split_unquote # Split and unquote a table name. The table name can be database-qualified # or not, like `db`.`table`. The table name can be backtick-quoted or not. # # Parameters: # $db_tbl - Table name # $default_db - Default database name to return if $db_tbl is not # database-qualified # # Returns: # Array: unquoted database (possibly undef), unquoted table # # See Also: # sub split_unquote { my ( $self, $db_tbl, $default_db ) = @_; my ( $db, $tbl ) = split(/[.]/, $db_tbl); if ( !$tbl ) { $tbl = $db; $db = $default_db; } for ($db, $tbl) { next unless $_; s/\A`//; s/`\z//; s/``/`/g; } return ($db, $tbl); } # Sub: literal_like # Escape LIKE wildcard % and _. # # Parameters: # $like - LIKE value to escape # # Returns: # Escaped LIKE value sub literal_like { my ( $self, $like ) = @_; return unless $like; $like =~ s/([%_])/\\$1/g; return "'$like'"; } # Sub: join_quote # Join and backtick-quote a database name with a table name. This sub does # the opposite of split_unquote. # # Parameters: # $default_db - Default database name to use if $db_tbl is not # database-qualified # $db_tbl - Table name, optionally database-qualified, optionally # quoted # # Returns: # Backtick-quoted, database-qualified table like `database`.`table` # # See Also: # sub join_quote { my ( $self, $default_db, $db_tbl ) = @_; return unless $db_tbl; my ($db, $tbl) = split(/[.]/, $db_tbl); if ( !$tbl ) { $tbl = $db; $db = $default_db; } $db = "`$db`" if $db && $db !~ m/^`/; $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; return $db ? "$db.$tbl" : $tbl; } # Return the list passed in, with the elements passed through quotemeta, # and the results concatenated with ','. sub serialize_list { my ( $self, @args ) = @_; PTDEBUG && _d('Serializing', Dumper(\@args)); return unless @args; my @parts; foreach my $arg ( @args ) { if ( defined $arg ) { $arg =~ s/,/\\,/g; # escape commas $arg =~ s/\\N/\\\\N/g; # escape literal \N push @parts, $arg; } else { push @parts, '\N'; } } my $string = join(',', @parts); PTDEBUG && _d('Serialized: <', $string, '>'); return $string; } sub deserialize_list { my ( $self, $string ) = @_; PTDEBUG && _d('Deserializing <', $string, '>'); die "Cannot deserialize an undefined string" unless defined $string; my @parts; foreach my $arg ( split(/(?