Merge lp:~percona-toolkit-dev/percona-toolkit/pt-kill-log-dsn into lp:percona-toolkit/2.1
- pt-kill-log-dsn
- Merge into 2.1
Proposed by
Daniel Nichter
Status: | Merged |
---|---|
Approved by: | Daniel Nichter |
Approved revision: | 315 |
Merged at revision: | 315 |
Proposed branch: | lp:~percona-toolkit-dev/percona-toolkit/pt-kill-log-dsn |
Merge into: | lp:percona-toolkit/2.1 |
Diff against target: |
1155 lines (+915/-33) 4 files modified
bin/pt-kill (+720/-7) lib/Processlist.pm (+16/-3) t/lib/Processlist.t (+23/-21) t/pt-kill/kill.t (+156/-2) |
To merge this branch: | bzr merge lp:~percona-toolkit-dev/percona-toolkit/pt-kill-log-dsn |
Related bugs: | |
Related blueprints: |
Make pt-kill log its actions
(High)
|
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Daniel Nichter | Approve | ||
Review via email: mp+114910@code.launchpad.net |
Commit message
Description of the change
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) : | # |
review:
Needs Fixing
Revision history for this message
Daniel Nichter (daniel-nichter) wrote : | # |
- 313. By Brian Fraser
-
t/pt-kill/kill.t: Make a test 5.0 compatible
- 314. By Daniel Nichter
-
Move certain vars to outer scope to avoid Perl 5.8 scoping bug.
- 315. By Brian Fraser
-
Really make a test 5.0 compatible
Revision history for this message
Daniel Nichter (daniel-nichter) : | # |
review:
Approve
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file 'bin/pt-kill' | |||
2 | --- bin/pt-kill 2012-07-15 02:58:17 +0000 | |||
3 | +++ bin/pt-kill 2012-07-19 16:42:35 +0000 | |||
4 | @@ -1280,7 +1280,7 @@ | |||
5 | 1280 | } | 1280 | } |
6 | 1281 | 1281 | ||
7 | 1282 | foreach my $key ( keys %given_props ) { | 1282 | foreach my $key ( keys %given_props ) { |
9 | 1283 | die "Unknown DSN option '$key' in '$dsn'. For more details, " | 1283 | die "DSN option '$key' in '$dsn'. For more details, " |
10 | 1284 | . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " | 1284 | . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " |
11 | 1285 | . "for complete documentation." | 1285 | . "for complete documentation." |
12 | 1286 | unless exists $opts->{$key}; | 1286 | unless exists $opts->{$key}; |
13 | @@ -2087,6 +2087,436 @@ | |||
14 | 2087 | # ########################################################################### | 2087 | # ########################################################################### |
15 | 2088 | 2088 | ||
16 | 2089 | # ########################################################################### | 2089 | # ########################################################################### |
17 | 2090 | # TableParser package | ||
18 | 2091 | # This package is a copy without comments from the original. The original | ||
19 | 2092 | # with comments and its test file can be found in the Bazaar repository at, | ||
20 | 2093 | # lib/TableParser.pm | ||
21 | 2094 | # t/lib/TableParser.t | ||
22 | 2095 | # See https://launchpad.net/percona-toolkit for more information. | ||
23 | 2096 | # ########################################################################### | ||
24 | 2097 | { | ||
25 | 2098 | package TableParser; | ||
26 | 2099 | |||
27 | 2100 | use strict; | ||
28 | 2101 | use warnings FATAL => 'all'; | ||
29 | 2102 | use English qw(-no_match_vars); | ||
30 | 2103 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
31 | 2104 | |||
32 | 2105 | use Data::Dumper; | ||
33 | 2106 | $Data::Dumper::Indent = 1; | ||
34 | 2107 | $Data::Dumper::Sortkeys = 1; | ||
35 | 2108 | $Data::Dumper::Quotekeys = 0; | ||
36 | 2109 | |||
37 | 2110 | sub new { | ||
38 | 2111 | my ( $class, %args ) = @_; | ||
39 | 2112 | my @required_args = qw(Quoter); | ||
40 | 2113 | foreach my $arg ( @required_args ) { | ||
41 | 2114 | die "I need a $arg argument" unless $args{$arg}; | ||
42 | 2115 | } | ||
43 | 2116 | my $self = { %args }; | ||
44 | 2117 | return bless $self, $class; | ||
45 | 2118 | } | ||
46 | 2119 | |||
47 | 2120 | sub get_create_table { | ||
48 | 2121 | my ( $self, $dbh, $db, $tbl ) = @_; | ||
49 | 2122 | die "I need a dbh parameter" unless $dbh; | ||
50 | 2123 | die "I need a db parameter" unless $db; | ||
51 | 2124 | die "I need a tbl parameter" unless $tbl; | ||
52 | 2125 | my $q = $self->{Quoter}; | ||
53 | 2126 | |||
54 | 2127 | my $new_sql_mode | ||
55 | 2128 | = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
56 | 2129 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
57 | 2130 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
58 | 2131 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
59 | 2132 | |||
60 | 2133 | my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
61 | 2134 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
62 | 2135 | |||
63 | 2136 | PTDEBUG && _d($new_sql_mode); | ||
64 | 2137 | eval { $dbh->do($new_sql_mode); }; | ||
65 | 2138 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
66 | 2139 | |||
67 | 2140 | my $use_sql = 'USE ' . $q->quote($db); | ||
68 | 2141 | PTDEBUG && _d($dbh, $use_sql); | ||
69 | 2142 | $dbh->do($use_sql); | ||
70 | 2143 | |||
71 | 2144 | my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); | ||
72 | 2145 | PTDEBUG && _d($show_sql); | ||
73 | 2146 | my $href; | ||
74 | 2147 | eval { $href = $dbh->selectrow_hashref($show_sql); }; | ||
75 | 2148 | if ( $EVAL_ERROR ) { | ||
76 | 2149 | PTDEBUG && _d($EVAL_ERROR); | ||
77 | 2150 | |||
78 | 2151 | PTDEBUG && _d($old_sql_mode); | ||
79 | 2152 | $dbh->do($old_sql_mode); | ||
80 | 2153 | |||
81 | 2154 | return; | ||
82 | 2155 | } | ||
83 | 2156 | |||
84 | 2157 | PTDEBUG && _d($old_sql_mode); | ||
85 | 2158 | $dbh->do($old_sql_mode); | ||
86 | 2159 | |||
87 | 2160 | my ($key) = grep { m/create (?:table|view)/i } keys %$href; | ||
88 | 2161 | if ( !$key ) { | ||
89 | 2162 | die "Error: no 'Create Table' or 'Create View' in result set from " | ||
90 | 2163 | . "$show_sql: " . Dumper($href); | ||
91 | 2164 | } | ||
92 | 2165 | |||
93 | 2166 | return $href->{$key}; | ||
94 | 2167 | } | ||
95 | 2168 | |||
96 | 2169 | sub parse { | ||
97 | 2170 | my ( $self, $ddl, $opts ) = @_; | ||
98 | 2171 | return unless $ddl; | ||
99 | 2172 | |||
100 | 2173 | if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | ||
101 | 2174 | die "Cannot parse table definition; is ANSI quoting " | ||
102 | 2175 | . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; | ||
103 | 2176 | } | ||
104 | 2177 | |||
105 | 2178 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; | ||
106 | 2179 | (undef, $name) = $self->{Quoter}->split_unquote($name) if $name; | ||
107 | 2180 | |||
108 | 2181 | $ddl =~ s/(`[^`]+`)/\L$1/g; | ||
109 | 2182 | |||
110 | 2183 | my $engine = $self->get_engine($ddl); | ||
111 | 2184 | |||
112 | 2185 | my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; | ||
113 | 2186 | my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; | ||
114 | 2187 | PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); | ||
115 | 2188 | |||
116 | 2189 | my %def_for; | ||
117 | 2190 | @def_for{@cols} = @defs; | ||
118 | 2191 | |||
119 | 2192 | my (@nums, @null); | ||
120 | 2193 | my (%type_for, %is_nullable, %is_numeric, %is_autoinc); | ||
121 | 2194 | foreach my $col ( @cols ) { | ||
122 | 2195 | my $def = $def_for{$col}; | ||
123 | 2196 | my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/; | ||
124 | 2197 | die "Can't determine column type for $def" unless $type; | ||
125 | 2198 | $type_for{$col} = $type; | ||
126 | 2199 | if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) { | ||
127 | 2200 | push @nums, $col; | ||
128 | 2201 | $is_numeric{$col} = 1; | ||
129 | 2202 | } | ||
130 | 2203 | if ( $def !~ m/NOT NULL/ ) { | ||
131 | 2204 | push @null, $col; | ||
132 | 2205 | $is_nullable{$col} = 1; | ||
133 | 2206 | } | ||
134 | 2207 | $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0; | ||
135 | 2208 | } | ||
136 | 2209 | |||
137 | 2210 | my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable); | ||
138 | 2211 | |||
139 | 2212 | my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/; | ||
140 | 2213 | |||
141 | 2214 | return { | ||
142 | 2215 | name => $name, | ||
143 | 2216 | cols => \@cols, | ||
144 | 2217 | col_posn => { map { $cols[$_] => $_ } 0..$#cols }, | ||
145 | 2218 | is_col => { map { $_ => 1 } @cols }, | ||
146 | 2219 | null_cols => \@null, | ||
147 | 2220 | is_nullable => \%is_nullable, | ||
148 | 2221 | is_autoinc => \%is_autoinc, | ||
149 | 2222 | clustered_key => $clustered_key, | ||
150 | 2223 | keys => $keys, | ||
151 | 2224 | defs => \%def_for, | ||
152 | 2225 | numeric_cols => \@nums, | ||
153 | 2226 | is_numeric => \%is_numeric, | ||
154 | 2227 | engine => $engine, | ||
155 | 2228 | type_for => \%type_for, | ||
156 | 2229 | charset => $charset, | ||
157 | 2230 | }; | ||
158 | 2231 | } | ||
159 | 2232 | |||
160 | 2233 | sub sort_indexes { | ||
161 | 2234 | my ( $self, $tbl ) = @_; | ||
162 | 2235 | |||
163 | 2236 | my @indexes | ||
164 | 2237 | = sort { | ||
165 | 2238 | (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY')) | ||
166 | 2239 | || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} ) | ||
167 | 2240 | || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} ) | ||
168 | 2241 | || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) ) | ||
169 | 2242 | } | ||
170 | 2243 | grep { | ||
171 | 2244 | $tbl->{keys}->{$_}->{type} eq 'BTREE' | ||
172 | 2245 | } | ||
173 | 2246 | sort keys %{$tbl->{keys}}; | ||
174 | 2247 | |||
175 | 2248 | PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); | ||
176 | 2249 | return @indexes; | ||
177 | 2250 | } | ||
178 | 2251 | |||
179 | 2252 | sub find_best_index { | ||
180 | 2253 | my ( $self, $tbl, $index ) = @_; | ||
181 | 2254 | my $best; | ||
182 | 2255 | if ( $index ) { | ||
183 | 2256 | ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}}; | ||
184 | 2257 | } | ||
185 | 2258 | if ( !$best ) { | ||
186 | 2259 | if ( $index ) { | ||
187 | 2260 | die "Index '$index' does not exist in table"; | ||
188 | 2261 | } | ||
189 | 2262 | else { | ||
190 | 2263 | ($best) = $self->sort_indexes($tbl); | ||
191 | 2264 | } | ||
192 | 2265 | } | ||
193 | 2266 | PTDEBUG && _d('Best index found is', $best); | ||
194 | 2267 | return $best; | ||
195 | 2268 | } | ||
196 | 2269 | |||
197 | 2270 | sub find_possible_keys { | ||
198 | 2271 | my ( $self, $dbh, $database, $table, $quoter, $where ) = @_; | ||
199 | 2272 | return () unless $where; | ||
200 | 2273 | my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) | ||
201 | 2274 | . ' WHERE ' . $where; | ||
202 | 2275 | PTDEBUG && _d($sql); | ||
203 | 2276 | my $expl = $dbh->selectrow_hashref($sql); | ||
204 | 2277 | $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; | ||
205 | 2278 | if ( $expl->{possible_keys} ) { | ||
206 | 2279 | PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); | ||
207 | 2280 | my @candidates = split(',', $expl->{possible_keys}); | ||
208 | 2281 | my %possible = map { $_ => 1 } @candidates; | ||
209 | 2282 | if ( $expl->{key} ) { | ||
210 | 2283 | PTDEBUG && _d('MySQL chose', $expl->{key}); | ||
211 | 2284 | unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); | ||
212 | 2285 | PTDEBUG && _d('Before deduping:', join(', ', @candidates)); | ||
213 | 2286 | my %seen; | ||
214 | 2287 | @candidates = grep { !$seen{$_}++ } @candidates; | ||
215 | 2288 | } | ||
216 | 2289 | PTDEBUG && _d('Final list:', join(', ', @candidates)); | ||
217 | 2290 | return @candidates; | ||
218 | 2291 | } | ||
219 | 2292 | else { | ||
220 | 2293 | PTDEBUG && _d('No keys in possible_keys'); | ||
221 | 2294 | return (); | ||
222 | 2295 | } | ||
223 | 2296 | } | ||
224 | 2297 | |||
225 | 2298 | sub check_table { | ||
226 | 2299 | my ( $self, %args ) = @_; | ||
227 | 2300 | my @required_args = qw(dbh db tbl); | ||
228 | 2301 | foreach my $arg ( @required_args ) { | ||
229 | 2302 | die "I need a $arg argument" unless $args{$arg}; | ||
230 | 2303 | } | ||
231 | 2304 | my ($dbh, $db, $tbl) = @args{@required_args}; | ||
232 | 2305 | my $q = $self->{Quoter}; | ||
233 | 2306 | my $db_tbl = $q->quote($db, $tbl); | ||
234 | 2307 | PTDEBUG && _d('Checking', $db_tbl); | ||
235 | 2308 | |||
236 | 2309 | my $sql = "SHOW TABLES FROM " . $q->quote($db) | ||
237 | 2310 | . ' LIKE ' . $q->literal_like($tbl); | ||
238 | 2311 | PTDEBUG && _d($sql); | ||
239 | 2312 | my $row; | ||
240 | 2313 | eval { | ||
241 | 2314 | $row = $dbh->selectrow_arrayref($sql); | ||
242 | 2315 | }; | ||
243 | 2316 | if ( $EVAL_ERROR ) { | ||
244 | 2317 | PTDEBUG && _d($EVAL_ERROR); | ||
245 | 2318 | return 0; | ||
246 | 2319 | } | ||
247 | 2320 | if ( !$row->[0] || $row->[0] ne $tbl ) { | ||
248 | 2321 | PTDEBUG && _d('Table does not exist'); | ||
249 | 2322 | return 0; | ||
250 | 2323 | } | ||
251 | 2324 | |||
252 | 2325 | PTDEBUG && _d('Table exists; no privs to check'); | ||
253 | 2326 | return 1 unless $args{all_privs}; | ||
254 | 2327 | |||
255 | 2328 | $sql = "SHOW FULL COLUMNS FROM $db_tbl"; | ||
256 | 2329 | PTDEBUG && _d($sql); | ||
257 | 2330 | eval { | ||
258 | 2331 | $row = $dbh->selectrow_hashref($sql); | ||
259 | 2332 | }; | ||
260 | 2333 | if ( $EVAL_ERROR ) { | ||
261 | 2334 | PTDEBUG && _d($EVAL_ERROR); | ||
262 | 2335 | return 0; | ||
263 | 2336 | } | ||
264 | 2337 | if ( !scalar keys %$row ) { | ||
265 | 2338 | PTDEBUG && _d('Table has no columns:', Dumper($row)); | ||
266 | 2339 | return 0; | ||
267 | 2340 | } | ||
268 | 2341 | my $privs = $row->{privileges} || $row->{Privileges}; | ||
269 | 2342 | |||
270 | 2343 | $sql = "DELETE FROM $db_tbl LIMIT 0"; | ||
271 | 2344 | PTDEBUG && _d($sql); | ||
272 | 2345 | eval { | ||
273 | 2346 | $dbh->do($sql); | ||
274 | 2347 | }; | ||
275 | 2348 | my $can_delete = $EVAL_ERROR ? 0 : 1; | ||
276 | 2349 | |||
277 | 2350 | PTDEBUG && _d('User privs on', $db_tbl, ':', $privs, | ||
278 | 2351 | ($can_delete ? 'delete' : '')); | ||
279 | 2352 | |||
280 | 2353 | if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ | ||
281 | 2354 | && $can_delete) ) { | ||
282 | 2355 | PTDEBUG && _d('User does not have all privs'); | ||
283 | 2356 | return 0; | ||
284 | 2357 | } | ||
285 | 2358 | |||
286 | 2359 | PTDEBUG && _d('User has all privs'); | ||
287 | 2360 | return 1; | ||
288 | 2361 | } | ||
289 | 2362 | |||
290 | 2363 | sub get_engine { | ||
291 | 2364 | my ( $self, $ddl, $opts ) = @_; | ||
292 | 2365 | my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; | ||
293 | 2366 | PTDEBUG && _d('Storage engine:', $engine); | ||
294 | 2367 | return $engine || undef; | ||
295 | 2368 | } | ||
296 | 2369 | |||
297 | 2370 | sub get_keys { | ||
298 | 2371 | my ( $self, $ddl, $opts, $is_nullable ) = @_; | ||
299 | 2372 | my $engine = $self->get_engine($ddl); | ||
300 | 2373 | my $keys = {}; | ||
301 | 2374 | my $clustered_key = undef; | ||
302 | 2375 | |||
303 | 2376 | KEY: | ||
304 | 2377 | foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY .*)$/gm ) { | ||
305 | 2378 | |||
306 | 2379 | next KEY if $key =~ m/FOREIGN/; | ||
307 | 2380 | |||
308 | 2381 | my $key_ddl = $key; | ||
309 | 2382 | PTDEBUG && _d('Parsed key:', $key_ddl); | ||
310 | 2383 | |||
311 | 2384 | if ( $engine !~ m/MEMORY|HEAP/ ) { | ||
312 | 2385 | $key =~ s/USING HASH/USING BTREE/; | ||
313 | 2386 | } | ||
314 | 2387 | |||
315 | 2388 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; | ||
316 | 2389 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; | ||
317 | 2390 | $type = $type || $special || 'BTREE'; | ||
318 | 2391 | if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' | ||
319 | 2392 | && $engine =~ m/HEAP|MEMORY/i ) | ||
320 | 2393 | { | ||
321 | 2394 | $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP | ||
322 | 2395 | } | ||
323 | 2396 | |||
324 | 2397 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; | ||
325 | 2398 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; | ||
326 | 2399 | my @cols; | ||
327 | 2400 | my @col_prefixes; | ||
328 | 2401 | foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) { | ||
329 | 2402 | my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/; | ||
330 | 2403 | push @cols, $name; | ||
331 | 2404 | push @col_prefixes, $prefix; | ||
332 | 2405 | } | ||
333 | 2406 | $name =~ s/`//g; | ||
334 | 2407 | |||
335 | 2408 | PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); | ||
336 | 2409 | |||
337 | 2410 | $keys->{$name} = { | ||
338 | 2411 | name => $name, | ||
339 | 2412 | type => $type, | ||
340 | 2413 | colnames => $cols, | ||
341 | 2414 | cols => \@cols, | ||
342 | 2415 | col_prefixes => \@col_prefixes, | ||
343 | 2416 | is_unique => $unique, | ||
344 | 2417 | is_nullable => scalar(grep { $is_nullable->{$_} } @cols), | ||
345 | 2418 | is_col => { map { $_ => 1 } @cols }, | ||
346 | 2419 | ddl => $key_ddl, | ||
347 | 2420 | }; | ||
348 | 2421 | |||
349 | 2422 | if ( $engine =~ m/InnoDB/i && !$clustered_key ) { | ||
350 | 2423 | my $this_key = $keys->{$name}; | ||
351 | 2424 | if ( $this_key->{name} eq 'PRIMARY' ) { | ||
352 | 2425 | $clustered_key = 'PRIMARY'; | ||
353 | 2426 | } | ||
354 | 2427 | elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { | ||
355 | 2428 | $clustered_key = $this_key->{name}; | ||
356 | 2429 | } | ||
357 | 2430 | PTDEBUG && $clustered_key && _d('This key is the clustered key'); | ||
358 | 2431 | } | ||
359 | 2432 | } | ||
360 | 2433 | |||
361 | 2434 | return $keys, $clustered_key; | ||
362 | 2435 | } | ||
363 | 2436 | |||
364 | 2437 | sub get_fks { | ||
365 | 2438 | my ( $self, $ddl, $opts ) = @_; | ||
366 | 2439 | my $q = $self->{Quoter}; | ||
367 | 2440 | my $fks = {}; | ||
368 | 2441 | |||
369 | 2442 | foreach my $fk ( | ||
370 | 2443 | $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg ) | ||
371 | 2444 | { | ||
372 | 2445 | my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/; | ||
373 | 2446 | my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/; | ||
374 | 2447 | my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/; | ||
375 | 2448 | |||
376 | 2449 | my ($db, $tbl) = $q->split_unquote($parent, $opts->{database}); | ||
377 | 2450 | my %parent_tbl = (tbl => $tbl); | ||
378 | 2451 | $parent_tbl{db} = $db if $db; | ||
379 | 2452 | |||
380 | 2453 | if ( $parent !~ m/\./ && $opts->{database} ) { | ||
381 | 2454 | $parent = $q->quote($opts->{database}) . ".$parent"; | ||
382 | 2455 | } | ||
383 | 2456 | |||
384 | 2457 | $fks->{$name} = { | ||
385 | 2458 | name => $name, | ||
386 | 2459 | colnames => $cols, | ||
387 | 2460 | cols => [ map { s/[ `]+//g; $_; } split(',', $cols) ], | ||
388 | 2461 | parent_tbl => \%parent_tbl, | ||
389 | 2462 | parent_tblname => $parent, | ||
390 | 2463 | parent_cols => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ], | ||
391 | 2464 | parent_colnames=> $parent_cols, | ||
392 | 2465 | ddl => $fk, | ||
393 | 2466 | }; | ||
394 | 2467 | } | ||
395 | 2468 | |||
396 | 2469 | return $fks; | ||
397 | 2470 | } | ||
398 | 2471 | |||
399 | 2472 | sub remove_auto_increment { | ||
400 | 2473 | my ( $self, $ddl ) = @_; | ||
401 | 2474 | $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m; | ||
402 | 2475 | return $ddl; | ||
403 | 2476 | } | ||
404 | 2477 | |||
405 | 2478 | sub get_table_status { | ||
406 | 2479 | my ( $self, $dbh, $db, $like ) = @_; | ||
407 | 2480 | my $q = $self->{Quoter}; | ||
408 | 2481 | my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); | ||
409 | 2482 | my @params; | ||
410 | 2483 | if ( $like ) { | ||
411 | 2484 | $sql .= ' LIKE ?'; | ||
412 | 2485 | push @params, $like; | ||
413 | 2486 | } | ||
414 | 2487 | PTDEBUG && _d($sql, @params); | ||
415 | 2488 | my $sth = $dbh->prepare($sql); | ||
416 | 2489 | eval { $sth->execute(@params); }; | ||
417 | 2490 | if ($EVAL_ERROR) { | ||
418 | 2491 | PTDEBUG && _d($EVAL_ERROR); | ||
419 | 2492 | return; | ||
420 | 2493 | } | ||
421 | 2494 | my @tables = @{$sth->fetchall_arrayref({})}; | ||
422 | 2495 | @tables = map { | ||
423 | 2496 | my %tbl; # Make a copy with lowercased keys | ||
424 | 2497 | @tbl{ map { lc $_ } keys %$_ } = values %$_; | ||
425 | 2498 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; | ||
426 | 2499 | delete $tbl{type}; | ||
427 | 2500 | \%tbl; | ||
428 | 2501 | } @tables; | ||
429 | 2502 | return @tables; | ||
430 | 2503 | } | ||
431 | 2504 | |||
432 | 2505 | sub _d { | ||
433 | 2506 | my ($package, undef, $line) = caller 0; | ||
434 | 2507 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
435 | 2508 | map { defined $_ ? $_ : 'undef' } | ||
436 | 2509 | @_; | ||
437 | 2510 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
438 | 2511 | } | ||
439 | 2512 | |||
440 | 2513 | 1; | ||
441 | 2514 | } | ||
442 | 2515 | # ########################################################################### | ||
443 | 2516 | # End TableParser package | ||
444 | 2517 | # ########################################################################### | ||
445 | 2518 | |||
446 | 2519 | # ########################################################################### | ||
447 | 2090 | # Processlist package | 2520 | # Processlist package |
448 | 2091 | # This package is a copy without comments from the original. The original | 2521 | # This package is a copy without comments from the original. The original |
449 | 2092 | # with comments and its test file can be found in the Bazaar repository at, | 2522 | # with comments and its test file can be found in the Bazaar repository at, |
450 | @@ -2135,6 +2565,7 @@ | |||
451 | 2135 | last_poll => 0, | 2565 | last_poll => 0, |
452 | 2136 | active_cxn => {}, # keyed off ID | 2566 | active_cxn => {}, # keyed off ID |
453 | 2137 | event_cache => [], | 2567 | event_cache => [], |
454 | 2568 | _reasons_for_matching => {}, | ||
455 | 2138 | }; | 2569 | }; |
456 | 2139 | return bless $self, $class; | 2570 | return bless $self, $class; |
457 | 2140 | } | 2571 | } |
458 | @@ -2345,7 +2776,9 @@ | |||
459 | 2345 | PTDEBUG && _d("Query isn't running long enough"); | 2776 | PTDEBUG && _d("Query isn't running long enough"); |
460 | 2346 | next QUERY; | 2777 | next QUERY; |
461 | 2347 | } | 2778 | } |
463 | 2348 | PTDEBUG && _d('Exceeds busy time'); | 2779 | my $reason = 'Exceeds busy time'; |
464 | 2780 | PTDEBUG && _d($reason); | ||
465 | 2781 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
466 | 2349 | $matched++; | 2782 | $matched++; |
467 | 2350 | } | 2783 | } |
468 | 2351 | 2784 | ||
469 | @@ -2355,7 +2788,9 @@ | |||
470 | 2355 | PTDEBUG && _d("Query isn't idle long enough"); | 2788 | PTDEBUG && _d("Query isn't idle long enough"); |
471 | 2356 | next QUERY; | 2789 | next QUERY; |
472 | 2357 | } | 2790 | } |
474 | 2358 | PTDEBUG && _d('Exceeds idle time'); | 2791 | my $reason = 'Exceeds idle time'; |
475 | 2792 | PTDEBUG && _d($reason); | ||
476 | 2793 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
477 | 2359 | $matched++; | 2794 | $matched++; |
478 | 2360 | } | 2795 | } |
479 | 2361 | 2796 | ||
480 | @@ -2372,7 +2807,9 @@ | |||
481 | 2372 | PTDEBUG && _d('Query does not match', $property, 'spec'); | 2807 | PTDEBUG && _d('Query does not match', $property, 'spec'); |
482 | 2373 | next QUERY; | 2808 | next QUERY; |
483 | 2374 | } | 2809 | } |
485 | 2375 | PTDEBUG && _d('Query matches', $property, 'spec'); | 2810 | my $reason = 'Query matches ' . $property . ' spec'; |
486 | 2811 | PTDEBUG && _d($reason); | ||
487 | 2812 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
488 | 2376 | $matched++; | 2813 | $matched++; |
489 | 2377 | } | 2814 | } |
490 | 2378 | } | 2815 | } |
491 | @@ -3295,6 +3732,125 @@ | |||
492 | 3295 | # ########################################################################### | 3732 | # ########################################################################### |
493 | 3296 | 3733 | ||
494 | 3297 | # ########################################################################### | 3734 | # ########################################################################### |
495 | 3735 | # Quoter package | ||
496 | 3736 | # This package is a copy without comments from the original. The original | ||
497 | 3737 | # with comments and its test file can be found in the Bazaar repository at, | ||
498 | 3738 | # lib/Quoter.pm | ||
499 | 3739 | # t/lib/Quoter.t | ||
500 | 3740 | # See https://launchpad.net/percona-toolkit for more information. | ||
501 | 3741 | # ########################################################################### | ||
502 | 3742 | { | ||
503 | 3743 | package Quoter; | ||
504 | 3744 | |||
505 | 3745 | use strict; | ||
506 | 3746 | use warnings FATAL => 'all'; | ||
507 | 3747 | use English qw(-no_match_vars); | ||
508 | 3748 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
509 | 3749 | |||
510 | 3750 | sub new { | ||
511 | 3751 | my ( $class, %args ) = @_; | ||
512 | 3752 | return bless {}, $class; | ||
513 | 3753 | } | ||
514 | 3754 | |||
515 | 3755 | sub quote { | ||
516 | 3756 | my ( $self, @vals ) = @_; | ||
517 | 3757 | foreach my $val ( @vals ) { | ||
518 | 3758 | $val =~ s/`/``/g; | ||
519 | 3759 | } | ||
520 | 3760 | return join('.', map { '`' . $_ . '`' } @vals); | ||
521 | 3761 | } | ||
522 | 3762 | |||
523 | 3763 | sub quote_val { | ||
524 | 3764 | my ( $self, $val ) = @_; | ||
525 | 3765 | |||
526 | 3766 | return 'NULL' unless defined $val; # undef = NULL | ||
527 | 3767 | return "''" if $val eq ''; # blank string = '' | ||
528 | 3768 | return $val if $val =~ m/^0x[0-9a-fA-F]+$/; # hex data | ||
529 | 3769 | |||
530 | 3770 | $val =~ s/(['\\])/\\$1/g; | ||
531 | 3771 | return "'$val'"; | ||
532 | 3772 | } | ||
533 | 3773 | |||
534 | 3774 | sub split_unquote { | ||
535 | 3775 | my ( $self, $db_tbl, $default_db ) = @_; | ||
536 | 3776 | $db_tbl =~ s/`//g; | ||
537 | 3777 | my ( $db, $tbl ) = split(/[.]/, $db_tbl); | ||
538 | 3778 | if ( !$tbl ) { | ||
539 | 3779 | $tbl = $db; | ||
540 | 3780 | $db = $default_db; | ||
541 | 3781 | } | ||
542 | 3782 | return ($db, $tbl); | ||
543 | 3783 | } | ||
544 | 3784 | |||
545 | 3785 | sub literal_like { | ||
546 | 3786 | my ( $self, $like ) = @_; | ||
547 | 3787 | return unless $like; | ||
548 | 3788 | $like =~ s/([%_])/\\$1/g; | ||
549 | 3789 | return "'$like'"; | ||
550 | 3790 | } | ||
551 | 3791 | |||
552 | 3792 | sub join_quote { | ||
553 | 3793 | my ( $self, $default_db, $db_tbl ) = @_; | ||
554 | 3794 | return unless $db_tbl; | ||
555 | 3795 | my ($db, $tbl) = split(/[.]/, $db_tbl); | ||
556 | 3796 | if ( !$tbl ) { | ||
557 | 3797 | $tbl = $db; | ||
558 | 3798 | $db = $default_db; | ||
559 | 3799 | } | ||
560 | 3800 | $db = "`$db`" if $db && $db !~ m/^`/; | ||
561 | 3801 | $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; | ||
562 | 3802 | return $db ? "$db.$tbl" : $tbl; | ||
563 | 3803 | } | ||
564 | 3804 | |||
565 | 3805 | sub serialize_list { | ||
566 | 3806 | my ( $self, @args ) = @_; | ||
567 | 3807 | return unless @args; | ||
568 | 3808 | |||
569 | 3809 | return $args[0] if @args == 1 && !defined $args[0]; | ||
570 | 3810 | |||
571 | 3811 | die "Cannot serialize multiple values with undef/NULL" | ||
572 | 3812 | if grep { !defined $_ } @args; | ||
573 | 3813 | |||
574 | 3814 | return join ',', map { quotemeta } @args; | ||
575 | 3815 | } | ||
576 | 3816 | |||
577 | 3817 | sub deserialize_list { | ||
578 | 3818 | my ( $self, $string ) = @_; | ||
579 | 3819 | return $string unless defined $string; | ||
580 | 3820 | my @escaped_parts = $string =~ / | ||
581 | 3821 | \G # Start of string, or end of previous match. | ||
582 | 3822 | ( # Each of these is an element in the original list. | ||
583 | 3823 | [^\\,]* # Anything not a backslash or a comma | ||
584 | 3824 | (?: # When we get here, we found one of the above. | ||
585 | 3825 | \\. # A backslash followed by something so we can continue | ||
586 | 3826 | [^\\,]* # Same as above. | ||
587 | 3827 | )* # Repeat zero of more times. | ||
588 | 3828 | ) | ||
589 | 3829 | , # Comma dividing elements | ||
590 | 3830 | /sxgc; | ||
591 | 3831 | |||
592 | 3832 | push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string; | ||
593 | 3833 | |||
594 | 3834 | my @unescaped_parts = map { | ||
595 | 3835 | my $part = $_; | ||
596 | 3836 | |||
597 | 3837 | my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string, | ||
598 | 3838 | ? qr/(?=\p{ASCII})\W/ # We only care about non-word | ||
599 | 3839 | : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise, | ||
600 | 3840 | $part =~ s/\\($char_class)/$1/g; | ||
601 | 3841 | $part; | ||
602 | 3842 | } @escaped_parts; | ||
603 | 3843 | |||
604 | 3844 | return @unescaped_parts; | ||
605 | 3845 | } | ||
606 | 3846 | |||
607 | 3847 | 1; | ||
608 | 3848 | } | ||
609 | 3849 | # ########################################################################### | ||
610 | 3850 | # End Quoter package | ||
611 | 3851 | # ########################################################################### | ||
612 | 3852 | |||
613 | 3853 | # ########################################################################### | ||
614 | 3298 | # QueryRewriter package | 3854 | # QueryRewriter package |
615 | 3299 | # This package is a copy without comments from the original. The original | 3855 | # This package is a copy without comments from the original. The original |
616 | 3300 | # with comments and its test file can be found in the Bazaar repository at, | 3856 | # with comments and its test file can be found in the Bazaar repository at, |
617 | @@ -4027,7 +4583,10 @@ | |||
618 | 4027 | my $cxn; | 4583 | my $cxn; |
619 | 4028 | my $dbh; # $cxn->dbh | 4584 | my $dbh; # $cxn->dbh |
620 | 4029 | my $get_proclist; # callback to SHOW PROCESSLIST | 4585 | my $get_proclist; # callback to SHOW PROCESSLIST |
621 | 4586 | my $proc_sth; | ||
622 | 4030 | my $kill; # callback to KILL | 4587 | my $kill; # callback to KILL |
623 | 4588 | my $kill_sth; | ||
624 | 4589 | my $kill_sql = $o->get('kill-query') ? 'KILL QUERY ?' : 'KILL ?'; | ||
625 | 4031 | my $files; | 4590 | my $files; |
626 | 4032 | if ( $files = $o->get('test-matching') ) { | 4591 | if ( $files = $o->get('test-matching') ) { |
627 | 4033 | PTDEBUG && _d('Getting processlist from files:', @$files); | 4592 | PTDEBUG && _d('Getting processlist from files:', @$files); |
628 | @@ -4079,7 +4638,7 @@ | |||
629 | 4079 | # will need to be re-initialized. | 4638 | # will need to be re-initialized. |
630 | 4080 | my $retry = Retry->new(); | 4639 | my $retry = Retry->new(); |
631 | 4081 | 4640 | ||
633 | 4082 | my $proc_sth = $dbh->prepare('SHOW FULL PROCESSLIST'); | 4641 | $proc_sth = $dbh->prepare('SHOW FULL PROCESSLIST'); |
634 | 4083 | $get_proclist = sub { | 4642 | $get_proclist = sub { |
635 | 4084 | return $retry->retry( | 4643 | return $retry->retry( |
636 | 4085 | # Retry for an hour: 1,200 tries x 3 seconds = 3600s/1hr | 4644 | # Retry for an hour: 1,200 tries x 3 seconds = 3600s/1hr |
637 | @@ -4112,8 +4671,8 @@ | |||
638 | 4112 | ); | 4671 | ); |
639 | 4113 | }; | 4672 | }; |
640 | 4114 | 4673 | ||
643 | 4115 | my $kill_sql = $o->get('kill-query') ? 'KILL QUERY ?' : 'KILL ?'; | 4674 | |
644 | 4116 | my $kill_sth = $dbh->prepare($kill_sql); | 4675 | $kill_sth = $dbh->prepare($kill_sql); |
645 | 4117 | $kill = sub { | 4676 | $kill = sub { |
646 | 4118 | my ($id) = @_; | 4677 | my ($id) = @_; |
647 | 4119 | PTDEBUG && _d('Killing process', $id); | 4678 | PTDEBUG && _d('Killing process', $id); |
648 | @@ -4146,6 +4705,93 @@ | |||
649 | 4146 | }; | 4705 | }; |
650 | 4147 | } | 4706 | } |
651 | 4148 | 4707 | ||
652 | 4708 | # Set up --log-dsn if specified. | ||
653 | 4709 | my ($log, $log_sth); | ||
654 | 4710 | my @processlist_columns = qw( | ||
655 | 4711 | Id User Host db Command | ||
656 | 4712 | Time State Info Time_ms | ||
657 | 4713 | ); | ||
658 | 4714 | if ( my $log_dsn = $o->get('log-dsn') ) { | ||
659 | 4715 | my $db = $log_dsn->{D}; | ||
660 | 4716 | my $table = $log_dsn->{t}; | ||
661 | 4717 | die "--log-dsn does not specify a database (D) " | ||
662 | 4718 | . "or a database-qualified table (t)" | ||
663 | 4719 | unless defined $table && defined $db; | ||
664 | 4720 | my $log_cxn = Cxn->new( | ||
665 | 4721 | dsn_string => ($dp->get_cxn_params($log_dsn))[0], | ||
666 | 4722 | NAME_lc => 0, | ||
667 | 4723 | DSNParser => $dp, | ||
668 | 4724 | OptionParser => $o, | ||
669 | 4725 | ); | ||
670 | 4726 | my $log_dbh = $log_cxn->connect(); | ||
671 | 4727 | my $log_table = Quoter->quote($db, $table); | ||
672 | 4728 | |||
673 | 4729 | # Create the log-table table if it doesn't exist and --create-log-table | ||
674 | 4730 | # was passed in | ||
675 | 4731 | my $tp = TableParser->new( Quoter => "Quoter" ); | ||
676 | 4732 | if ( !$tp->check_table( dbh => $log_dbh, db => $db, tbl => $table ) ) { | ||
677 | 4733 | if ($o->get('create-log-table') ) { | ||
678 | 4734 | my $sql = $o->read_para_after( | ||
679 | 4735 | __FILE__, qr/MAGIC_create_log_table/); | ||
680 | 4736 | $sql =~ s/kill_log/IF NOT EXISTS $log_table/; | ||
681 | 4737 | PTDEBUG && _d($sql); | ||
682 | 4738 | $log_dbh->do($sql); | ||
683 | 4739 | } | ||
684 | 4740 | else { | ||
685 | 4741 | die "--log-dsn table does not exist. Please create it or specify " | ||
686 | 4742 | . "--create-log-table."; | ||
687 | 4743 | } | ||
688 | 4744 | } | ||
689 | 4745 | |||
690 | 4746 | # All the columns of the table that we care about | ||
691 | 4747 | my @all_log_columns = ( qw( server_id timestamp reason kill_error ), | ||
692 | 4748 | @processlist_columns ); | ||
693 | 4749 | |||
694 | 4750 | my $sql = 'SELECT @@SERVER_ID'; | ||
695 | 4751 | PTDEBUG && _d($sql); | ||
696 | 4752 | my ($server_id) = $dbh->selectrow_array($sql); | ||
697 | 4753 | |||
698 | 4754 | $sql = "INSERT INTO $log_table (" | ||
699 | 4755 | . join(", ", @all_log_columns) | ||
700 | 4756 | . ") VALUES(" | ||
701 | 4757 | . join(", ", $server_id, ("?") x (@all_log_columns-1)) | ||
702 | 4758 | . ")"; | ||
703 | 4759 | PTDEBUG && _d($sql); | ||
704 | 4760 | $log_sth = $log_dbh->prepare($sql); | ||
705 | 4761 | |||
706 | 4762 | my $retry = Retry->new(); | ||
707 | 4763 | |||
708 | 4764 | $log = sub { | ||
709 | 4765 | my (@params) = @_; | ||
710 | 4766 | PTDEBUG && _d('Logging values:', @params); | ||
711 | 4767 | return $retry->retry( | ||
712 | 4768 | tries => 20, | ||
713 | 4769 | wait => sub { sleep 3; }, | ||
714 | 4770 | try => sub { return $log_sth->execute(@params); }, | ||
715 | 4771 | fail => sub { | ||
716 | 4772 | my (%args) = @_; | ||
717 | 4773 | my $error = $args{error}; | ||
718 | 4774 | # The 1st pattern means that MySQL itself died or was stopped. | ||
719 | 4775 | # The 2nd pattern means that our cxn was killed (KILL <id>). | ||
720 | 4776 | if ( $error =~ m/MySQL server has gone away/ | ||
721 | 4777 | || $error =~ m/Lost connection to MySQL server/ ) { | ||
722 | 4778 | eval { | ||
723 | 4779 | $log_dbh = $log_cxn->connect(); | ||
724 | 4780 | $log_sth = $log_dbh->prepare( $sql ); | ||
725 | 4781 | msg('Reconnected to ' . $cxn->name()); | ||
726 | 4782 | }; | ||
727 | 4783 | return 1 unless $EVAL_ERROR; # try again | ||
728 | 4784 | } | ||
729 | 4785 | return 0; # call final_fail | ||
730 | 4786 | }, | ||
731 | 4787 | final_fail => sub { | ||
732 | 4788 | my (%args) = @_; | ||
733 | 4789 | die $args{error}; | ||
734 | 4790 | }, | ||
735 | 4791 | ); | ||
736 | 4792 | }; | ||
737 | 4793 | } | ||
738 | 4794 | |||
739 | 4149 | # ######################################################################## | 4795 | # ######################################################################## |
740 | 4150 | # Daemonize only after (potentially) asking for passwords for --ask-pass. | 4796 | # Daemonize only after (potentially) asking for passwords for --ask-pass. |
741 | 4151 | # ######################################################################## | 4797 | # ######################################################################## |
742 | @@ -4349,7 +4995,17 @@ | |||
743 | 4349 | . " seconds before kill"); | 4995 | . " seconds before kill"); |
744 | 4350 | sleep $o->get('wait-before-kill'); | 4996 | sleep $o->get('wait-before-kill'); |
745 | 4351 | } | 4997 | } |
746 | 4998 | local $@; | ||
747 | 4352 | eval { $kill->($query->{Id}) }; | 4999 | eval { $kill->($query->{Id}) }; |
748 | 5000 | if ( $log ) { | ||
749 | 5001 | log_to_table( | ||
750 | 5002 | log => $log, | ||
751 | 5003 | query => $query, | ||
752 | 5004 | proclist => $pl, | ||
753 | 5005 | columns => \@processlist_columns, | ||
754 | 5006 | eval_error => $EVAL_ERROR, | ||
755 | 5007 | ); | ||
756 | 5008 | } | ||
757 | 4353 | if ( $EVAL_ERROR ) { | 5009 | if ( $EVAL_ERROR ) { |
758 | 4354 | msg("Error killing $query->{Id}: $EVAL_ERROR"); | 5010 | msg("Error killing $query->{Id}: $EVAL_ERROR"); |
759 | 4355 | } | 5011 | } |
760 | @@ -4417,6 +5073,21 @@ | |||
761 | 4417 | return; | 5073 | return; |
762 | 4418 | } | 5074 | } |
763 | 4419 | 5075 | ||
764 | 5076 | sub log_to_table { | ||
765 | 5077 | my (%args) = @_; | ||
766 | 5078 | my ($log, $query, $pl, $processlist_columns) | ||
767 | 5079 | = @args{qw( log query proclist columns )}; | ||
768 | 5080 | |||
769 | 5081 | my $ts = Transformers::ts(localtime); | ||
770 | 5082 | my $reasons = join "\n", map { | ||
771 | 5083 | defined($_) ? $_ : "Unkown reason" | ||
772 | 5084 | } @{ $pl->{_reasons_for_matching}->{$query} }; | ||
773 | 5085 | $log->( | ||
774 | 5086 | $ts, $reasons, $args{eval_error}, | ||
775 | 5087 | @{$query}{@$processlist_columns} | ||
776 | 5088 | ); | ||
777 | 5089 | } | ||
778 | 5090 | |||
779 | 4420 | sub group_queries { | 5091 | sub group_queries { |
780 | 4421 | my ( %args ) = @_; | 5092 | my ( %args ) = @_; |
781 | 4422 | my ($proclist, $group_by, $qr) = @args{qw(proclist group_by QueryRewriter)}; | 5093 | my ($proclist, $group_by, $qr) = @args{qw(proclist group_by QueryRewriter)}; |
782 | @@ -4642,6 +5313,13 @@ | |||
783 | 4642 | 5313 | ||
784 | 4643 | The database to use for the connection. | 5314 | The database to use for the connection. |
785 | 4644 | 5315 | ||
786 | 5316 | =item --create-log-table | ||
787 | 5317 | |||
788 | 5318 | Create the L<"--log-dsn"> table if it does not exist. | ||
789 | 5319 | |||
790 | 5320 | This option causes the table specified by L<"--log-dsn"> to be created with the | ||
791 | 5321 | default structure shown in the documentation for that option. | ||
792 | 5322 | |||
793 | 4645 | =item --daemonize | 5323 | =item --daemonize |
794 | 4646 | 5324 | ||
795 | 4647 | Fork to the background and detach from the shell. POSIX operating systems | 5325 | Fork to the background and detach from the shell. POSIX operating systems |
796 | @@ -4746,6 +5424,37 @@ | |||
797 | 4746 | 5424 | ||
798 | 4747 | Print all output to this file when daemonized. | 5425 | Print all output to this file when daemonized. |
799 | 4748 | 5426 | ||
800 | 5427 | =item --log-dsn | ||
801 | 5428 | |||
802 | 5429 | type: DSN | ||
803 | 5430 | |||
804 | 5431 | Store each query killed in this DSN. | ||
805 | 5432 | |||
806 | 5433 | The argument specifies a table to store all killed queries. The DSN | ||
807 | 5434 | passed in must have the databse (D) and table (t) options. The | ||
808 | 5435 | table must have at least the following columns. You can add more columns for | ||
809 | 5436 | your own special purposes, but they won't be used by pt-kill. The | ||
810 | 5437 | following CREATE TABLE definition is also used for L<"--create-log-table">. | ||
811 | 5438 | MAGIC_create_log_table: | ||
812 | 5439 | |||
813 | 5440 | CREATE TABLE kill_log ( | ||
814 | 5441 | kill_id int(10) unsigned NOT NULL AUTO_INCREMENT, | ||
815 | 5442 | server_id bigint(4) NOT NULL DEFAULT '0', | ||
816 | 5443 | timestamp DATETIME, | ||
817 | 5444 | reason TEXT, | ||
818 | 5445 | kill_error TEXT, | ||
819 | 5446 | Id bigint(4) NOT NULL DEFAULT '0', | ||
820 | 5447 | User varchar(16) NOT NULL DEFAULT '', | ||
821 | 5448 | Host varchar(64) NOT NULL DEFAULT '', | ||
822 | 5449 | db varchar(64) DEFAULT NULL, | ||
823 | 5450 | Command varchar(16) NOT NULL DEFAULT '', | ||
824 | 5451 | Time int(7) NOT NULL DEFAULT '0', | ||
825 | 5452 | State varchar(64) DEFAULT NULL, | ||
826 | 5453 | Info longtext, | ||
827 | 5454 | Time_ms bigint(21) DEFAULT '0', # NOTE, TODO: currently not used | ||
828 | 5455 | PRIMARY KEY (kill_id) | ||
829 | 5456 | ) DEFAULT CHARSET=utf8 | ||
830 | 5457 | |||
831 | 4749 | =item --password | 5458 | =item --password |
832 | 4750 | 5459 | ||
833 | 4751 | short form: -p; type: string | 5460 | short form: -p; type: string |
834 | @@ -5251,6 +5960,10 @@ | |||
835 | 5251 | 5960 | ||
836 | 5252 | User for login if not current user. | 5961 | User for login if not current user. |
837 | 5253 | 5962 | ||
838 | 5963 | =item * t | ||
839 | 5964 | |||
840 | 5965 | Table to log actions in, if passed through --log-dsn. | ||
841 | 5966 | |||
842 | 5254 | =back | 5967 | =back |
843 | 5255 | 5968 | ||
844 | 5256 | =head1 ENVIRONMENT | 5969 | =head1 ENVIRONMENT |
845 | 5257 | 5970 | ||
846 | === modified file 'lib/Processlist.pm' | |||
847 | --- lib/Processlist.pm 2012-05-28 02:28:35 +0000 | |||
848 | +++ lib/Processlist.pm 2012-07-19 16:42:35 +0000 | |||
849 | @@ -75,6 +75,7 @@ | |||
850 | 75 | last_poll => 0, | 75 | last_poll => 0, |
851 | 76 | active_cxn => {}, # keyed off ID | 76 | active_cxn => {}, # keyed off ID |
852 | 77 | event_cache => [], | 77 | event_cache => [], |
853 | 78 | _reasons_for_matching => {}, | ||
854 | 78 | }; | 79 | }; |
855 | 79 | return bless $self, $class; | 80 | return bless $self, $class; |
856 | 80 | } | 81 | } |
857 | @@ -475,7 +476,15 @@ | |||
858 | 475 | PTDEBUG && _d("Query isn't running long enough"); | 476 | PTDEBUG && _d("Query isn't running long enough"); |
859 | 476 | next QUERY; | 477 | next QUERY; |
860 | 477 | } | 478 | } |
862 | 478 | PTDEBUG && _d('Exceeds busy time'); | 479 | my $reason = 'Exceeds busy time'; |
863 | 480 | PTDEBUG && _d($reason); | ||
864 | 481 | # Saving the reasons for each query in the objct is a bit nasty, | ||
865 | 482 | # but the alternatives are worse: | ||
866 | 483 | # - Saving internal data in the query | ||
867 | 484 | # - Instead of using the stringified hashref as a key, using | ||
868 | 485 | # a checksum of the hashes' contents. Which could occasionally | ||
869 | 486 | # fail miserably due to timing-related issues. | ||
870 | 487 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
871 | 479 | $matched++; | 488 | $matched++; |
872 | 480 | } | 489 | } |
873 | 481 | 490 | ||
874 | @@ -486,7 +495,9 @@ | |||
875 | 486 | PTDEBUG && _d("Query isn't idle long enough"); | 495 | PTDEBUG && _d("Query isn't idle long enough"); |
876 | 487 | next QUERY; | 496 | next QUERY; |
877 | 488 | } | 497 | } |
879 | 489 | PTDEBUG && _d('Exceeds idle time'); | 498 | my $reason = 'Exceeds idle time'; |
880 | 499 | PTDEBUG && _d($reason); | ||
881 | 500 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
882 | 490 | $matched++; | 501 | $matched++; |
883 | 491 | } | 502 | } |
884 | 492 | 503 | ||
885 | @@ -507,7 +518,9 @@ | |||
886 | 507 | PTDEBUG && _d('Query does not match', $property, 'spec'); | 518 | PTDEBUG && _d('Query does not match', $property, 'spec'); |
887 | 508 | next QUERY; | 519 | next QUERY; |
888 | 509 | } | 520 | } |
890 | 510 | PTDEBUG && _d('Query matches', $property, 'spec'); | 521 | my $reason = 'Query matches ' . $property . ' spec'; |
891 | 522 | PTDEBUG && _d($reason); | ||
892 | 523 | push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason; | ||
893 | 511 | $matched++; | 524 | $matched++; |
894 | 512 | } | 525 | } |
895 | 513 | } | 526 | } |
896 | 514 | 527 | ||
897 | === modified file 't/lib/Processlist.t' | |||
898 | --- t/lib/Processlist.t 2012-05-30 14:36:44 +0000 | |||
899 | +++ t/lib/Processlist.t 2012-07-19 16:42:35 +0000 | |||
900 | @@ -9,7 +9,7 @@ | |||
901 | 9 | use strict; | 9 | use strict; |
902 | 10 | use warnings FATAL => 'all'; | 10 | use warnings FATAL => 'all'; |
903 | 11 | use English qw(-no_match_vars); | 11 | use English qw(-no_match_vars); |
905 | 12 | use Test::More tests => 34; | 12 | use Test::More tests => 35; |
906 | 13 | 13 | ||
907 | 14 | use Processlist; | 14 | use Processlist; |
908 | 15 | use PerconaTest; | 15 | use PerconaTest; |
909 | @@ -600,6 +600,17 @@ | |||
910 | 600 | }, | 600 | }, |
911 | 601 | ); | 601 | ); |
912 | 602 | 602 | ||
913 | 603 | my $matching_query = | ||
914 | 604 | { 'Time' => '91', | ||
915 | 605 | 'Command' => 'Query', | ||
916 | 606 | 'db' => undef, | ||
917 | 607 | 'Id' => '43', | ||
918 | 608 | 'Info' => 'select * from foo', | ||
919 | 609 | 'User' => 'msandbox', | ||
920 | 610 | 'State' => 'executing', | ||
921 | 611 | 'Host' => 'localhost' | ||
922 | 612 | }; | ||
923 | 613 | |||
924 | 603 | my @queries = $pl->find( | 614 | my @queries = $pl->find( |
925 | 604 | [ { 'Time' => '488', | 615 | [ { 'Time' => '488', |
926 | 605 | 'Command' => 'Connect', | 616 | 'Command' => 'Connect', |
927 | @@ -675,33 +686,24 @@ | |||
928 | 675 | 'State' => 'Locked', | 686 | 'State' => 'Locked', |
929 | 676 | 'Host' => 'localhost' | 687 | 'Host' => 'localhost' |
930 | 677 | }, | 688 | }, |
940 | 678 | { 'Time' => '91', | 689 | $matching_query, |
932 | 679 | 'Command' => 'Query', | ||
933 | 680 | 'db' => undef, | ||
934 | 681 | 'Id' => '43', | ||
935 | 682 | 'Info' => 'select * from foo', | ||
936 | 683 | 'User' => 'msandbox', | ||
937 | 684 | 'State' => 'executing', | ||
938 | 685 | 'Host' => 'localhost' | ||
939 | 686 | }, | ||
941 | 687 | ], | 690 | ], |
942 | 688 | %find_spec, | 691 | %find_spec, |
943 | 689 | ); | 692 | ); |
944 | 690 | 693 | ||
956 | 691 | my $expected = [ | 694 | my $expected = [ $matching_query ]; |
946 | 692 | { 'Time' => '91', | ||
947 | 693 | 'Command' => 'Query', | ||
948 | 694 | 'db' => undef, | ||
949 | 695 | 'Id' => '43', | ||
950 | 696 | 'Info' => 'select * from foo', | ||
951 | 697 | 'User' => 'msandbox', | ||
952 | 698 | 'State' => 'executing', | ||
953 | 699 | 'Host' => 'localhost' | ||
954 | 700 | }, | ||
955 | 701 | ]; | ||
957 | 702 | 695 | ||
958 | 703 | is_deeply(\@queries, $expected, 'Basic find()'); | 696 | is_deeply(\@queries, $expected, 'Basic find()'); |
959 | 704 | 697 | ||
960 | 698 | { | ||
961 | 699 | # Internal, fragile test! | ||
962 | 700 | is_deeply( | ||
963 | 701 | $pl->{_reasons_for_matching}->{$matching_query}, | ||
964 | 702 | [ 'Exceeds busy time', 'Query matches Command spec', 'Query matches Info spec', ], | ||
965 | 703 | "_reasons_for_matching works" | ||
966 | 704 | ); | ||
967 | 705 | } | ||
968 | 706 | |||
969 | 705 | %find_spec = ( | 707 | %find_spec = ( |
970 | 706 | busy_time => 1, | 708 | busy_time => 1, |
971 | 707 | ignore => { | 709 | ignore => { |
972 | 708 | 710 | ||
973 | === modified file 't/pt-kill/kill.t' | |||
974 | --- t/pt-kill/kill.t 2012-07-12 22:49:15 +0000 | |||
975 | +++ t/pt-kill/kill.t 2012-07-19 16:42:35 +0000 | |||
976 | @@ -29,7 +29,7 @@ | |||
977 | 29 | plan skip_all => 'Cannot connect to sandbox master'; | 29 | plan skip_all => 'Cannot connect to sandbox master'; |
978 | 30 | } | 30 | } |
979 | 31 | else { | 31 | else { |
981 | 32 | plan tests => 8; | 32 | plan tests => 21; |
982 | 33 | } | 33 | } |
983 | 34 | 34 | ||
984 | 35 | my $output; | 35 | my $output; |
985 | @@ -56,8 +56,11 @@ | |||
986 | 56 | 56 | ||
987 | 57 | $output = output( | 57 | $output = output( |
988 | 58 | sub { pt_kill::main('-F', $cnf, qw(--kill --print --run-time 1 --interval 1), | 58 | sub { pt_kill::main('-F', $cnf, qw(--kill --print --run-time 1 --interval 1), |
990 | 59 | '--match-info', 'select sleep\(4\)') }, | 59 | "--match-info", 'select sleep\(4\)', |
991 | 60 | ) | ||
992 | 61 | }, | ||
993 | 60 | ); | 62 | ); |
994 | 63 | |||
995 | 61 | like( | 64 | like( |
996 | 62 | $output, | 65 | $output, |
997 | 63 | qr/KILL $pid /, | 66 | qr/KILL $pid /, |
998 | @@ -117,6 +120,157 @@ | |||
999 | 117 | ); | 120 | ); |
1000 | 118 | 121 | ||
1001 | 119 | # ############################################################################# | 122 | # ############################################################################# |
1002 | 123 | # Test that --log-dsn | ||
1003 | 124 | # ############################################################################# | ||
1004 | 125 | |||
1005 | 126 | $dbh->do("DROP DATABASE IF EXISTS `kill_test`"); | ||
1006 | 127 | $dbh->do("CREATE DATABASE `kill_test`"); | ||
1007 | 128 | |||
1008 | 129 | my $sql = OptionParser->read_para_after( | ||
1009 | 130 | "$trunk/bin/pt-kill", qr/MAGIC_create_log_table/); | ||
1010 | 131 | $sql =~ s/kill_log/`kill_test`.`log_table`/; | ||
1011 | 132 | |||
1012 | 133 | $dbh->do($sql); | ||
1013 | 134 | |||
1014 | 135 | { | ||
1015 | 136 | system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&"); | ||
1016 | 137 | sleep 0.5; | ||
1017 | 138 | local $EVAL_ERROR; | ||
1018 | 139 | eval { | ||
1019 | 140 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1), | ||
1020 | 141 | "--match-info", 'select sleep\(4\)', | ||
1021 | 142 | "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!, | ||
1022 | 143 | ) | ||
1023 | 144 | }; | ||
1024 | 145 | is( | ||
1025 | 146 | $EVAL_ERROR, | ||
1026 | 147 | '', | ||
1027 | 148 | "--log-dsn works if the table exists and --create-log-table wasn't passed in." | ||
1028 | 149 | ) or diag $EVAL_ERROR; | ||
1029 | 150 | |||
1030 | 151 | local $EVAL_ERROR; | ||
1031 | 152 | my $results = eval { $dbh->selectall_arrayref("SELECT * FROM `kill_test`.`log_table`", { Slice => {} } ) }; | ||
1032 | 153 | is( | ||
1033 | 154 | $EVAL_ERROR, | ||
1034 | 155 | '', | ||
1035 | 156 | "...and we can query the table" | ||
1036 | 157 | ) or diag $EVAL_ERROR; | ||
1037 | 158 | |||
1038 | 159 | is @{$results}, 1, "...which contains one entry"; | ||
1039 | 160 | use Data::Dumper; | ||
1040 | 161 | my $reason = $dbh->selectrow_array("SELECT reason FROM `kill_test`.`log_table` WHERE kill_id=1"); | ||
1041 | 162 | is $reason, | ||
1042 | 163 | 'Query matches Info spec', | ||
1043 | 164 | 'reason gets set to something sensible'; | ||
1044 | 165 | |||
1045 | 166 | TODO: { | ||
1046 | 167 | local $::TODO = "Time_ms currently isn't reported"; | ||
1047 | 168 | my $time_ms = $dbh->selectrow_array("SELECT Time_ms FROM `kill_test`.`log_table` WHERE kill_id=1"); | ||
1048 | 169 | ok $time_ms; | ||
1049 | 170 | } | ||
1050 | 171 | |||
1051 | 172 | my $result = shift @$results; | ||
1052 | 173 | my $against = { | ||
1053 | 174 | user => 'msandbox', | ||
1054 | 175 | host => 'localhost', | ||
1055 | 176 | db => undef, | ||
1056 | 177 | command => 'Query', | ||
1057 | 178 | state => ($sandbox_version lt '5.1' ? "executing" : "User sleep"), | ||
1058 | 179 | info => 'select sleep(4)', | ||
1059 | 180 | }; | ||
1060 | 181 | my %trimmed_result; | ||
1061 | 182 | @trimmed_result{ keys %$against } = @{$result}{ keys %$against }; | ||
1062 | 183 | $trimmed_result{host} =~ s/localhost:[0-9]+/localhost/; | ||
1063 | 184 | is_deeply( | ||
1064 | 185 | \%trimmed_result, | ||
1065 | 186 | $against, | ||
1066 | 187 | "...and was populated as expected", | ||
1067 | 188 | ) or diag(Dumper($result)); | ||
1068 | 189 | |||
1069 | 190 | system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&"); | ||
1070 | 191 | sleep 0.5; | ||
1071 | 192 | local $EVAL_ERROR; | ||
1072 | 193 | eval { | ||
1073 | 194 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table), | ||
1074 | 195 | "--match-info", 'select sleep\(4\)', | ||
1075 | 196 | "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!, | ||
1076 | 197 | ) | ||
1077 | 198 | }; | ||
1078 | 199 | is( | ||
1079 | 200 | $EVAL_ERROR, | ||
1080 | 201 | '', | ||
1081 | 202 | "--log-dsn works if the table exists and --create-log-table was passed in." | ||
1082 | 203 | ); | ||
1083 | 204 | } | ||
1084 | 205 | |||
1085 | 206 | { | ||
1086 | 207 | $dbh->do("DROP TABLE `kill_test`.`log_table`"); | ||
1087 | 208 | |||
1088 | 209 | system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&"); | ||
1089 | 210 | sleep 0.5; | ||
1090 | 211 | local $EVAL_ERROR; | ||
1091 | 212 | eval { | ||
1092 | 213 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table), | ||
1093 | 214 | "--match-info", 'select sleep\(4\)', | ||
1094 | 215 | "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!, | ||
1095 | 216 | ) | ||
1096 | 217 | }; | ||
1097 | 218 | is( | ||
1098 | 219 | $EVAL_ERROR, | ||
1099 | 220 | '', | ||
1100 | 221 | "--log-dsn works if the table doesn't exists and --create-log-table was passed in." | ||
1101 | 222 | ); | ||
1102 | 223 | } | ||
1103 | 224 | |||
1104 | 225 | { | ||
1105 | 226 | $dbh->do("DROP TABLE `kill_test`.`log_table`"); | ||
1106 | 227 | |||
1107 | 228 | local $EVAL_ERROR; | ||
1108 | 229 | eval { | ||
1109 | 230 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1), | ||
1110 | 231 | "--match-info", 'select sleep\(4\)', | ||
1111 | 232 | "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!, | ||
1112 | 233 | ) | ||
1113 | 234 | }; | ||
1114 | 235 | like $EVAL_ERROR, | ||
1115 | 236 | qr/\Q--log-dsn table does not exist. Please create it or specify\E/, | ||
1116 | 237 | "By default, --log-dsn doesn't autogenerate a table"; | ||
1117 | 238 | } | ||
1118 | 239 | |||
1119 | 240 | for my $dsn ( | ||
1120 | 241 | q!h=127.1,P=12345,u=msandbox,p=msandbox,t=log_table!, | ||
1121 | 242 | q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test!, | ||
1122 | 243 | q!h=127.1,P=12345,u=msandbox,p=msandbox!, | ||
1123 | 244 | ) { | ||
1124 | 245 | local $EVAL_ERROR; | ||
1125 | 246 | eval { | ||
1126 | 247 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1), | ||
1127 | 248 | "--match-info", 'select sleep\(4\)', | ||
1128 | 249 | "--log-dsn", $dsn, | ||
1129 | 250 | ) | ||
1130 | 251 | }; | ||
1131 | 252 | like $EVAL_ERROR, | ||
1132 | 253 | qr/\Q--log-dsn does not specify a database (D) or a database-qualified table (t)\E/, | ||
1133 | 254 | "--log-dsn croaks if t= or D= are absent"; | ||
1134 | 255 | } | ||
1135 | 256 | |||
1136 | 257 | # Run it twice | ||
1137 | 258 | for (1,2) { | ||
1138 | 259 | system("/tmp/12345/use -h127.1 -P12345 -umsandbox -pmsandbox -e 'select sleep(4)' >/dev/null&"); | ||
1139 | 260 | sleep 0.5; | ||
1140 | 261 | pt_kill::main('-F', $cnf, qw(--kill --run-time 1 --interval 1 --create-log-table), | ||
1141 | 262 | "--match-info", 'select sleep\(4\)', | ||
1142 | 263 | "--log-dsn", q!h=127.1,P=12345,u=msandbox,p=msandbox,D=kill_test,t=log_table!, | ||
1143 | 264 | ); | ||
1144 | 265 | } | ||
1145 | 266 | |||
1146 | 267 | my $results = $dbh->selectall_arrayref("SELECT * FROM `kill_test`.`log_table`"); | ||
1147 | 268 | |||
1148 | 269 | is @{$results}, 2, "Different --log-dsn runs reuse the same table."; | ||
1149 | 270 | |||
1150 | 271 | $dbh->do("DROP DATABASE kill_test"); | ||
1151 | 272 | |||
1152 | 273 | # ############################################################################# | ||
1153 | 120 | # Done. | 274 | # Done. |
1154 | 121 | # ############################################################################# | 275 | # ############################################################################# |
1155 | 122 | $sb->wipe_clean($dbh); | 276 | $sb->wipe_clean($dbh); |
Changes for
bug 941469
branch https:/ /code.launchpad .net/~percona- toolkit- dev/percona- toolkit/ pt-kill- reconnect- bug-941469
merge https:/ /code.launchpad .net/~percona- toolkit- dev/percona- toolkit/ pt-kill- reconnect- bug-941469/ +merge/ 114748
conflict with the --log-dsn code. The code needs to be updated like those ^ changes, i.e. use Retry to try doing the INSERT, if that fails, reconnect and try again. I would say: tries=20, wait 3s (i.e. 1 minute). MySQL shouldn't stay away for long if the code just observed it, and if an INSERT fails that many times, it's no big deal, but it's worth making a good effort.
Also, please standardize the tests:
* Use English and indention,
is(
$EVAL_ERROR,
"",
"foo"
);
* Be more explicit, e.g.:
my $result = shift @$results; [0-9]+/ localhost/ ;
$result->[7] =~ s/localhost:
is_deeply(
[ @{$result}[6..9, 11, 12] ],
That's cryptic. Rather:
my $row = $dbh->selectrow _hashref( $sql);
is_deeply(
$row,
{
Id => 123,
user => 'foo',
...
},
"..."
) or diag(Dumper($row));