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