← Back to branch summary

~percona-toolkit-dev/percona-toolkit/mysql-5.6-test-fixes

« back to all changes in this revision

Viewing changes to lib/CompareWarnings.pm

  • Committer: Daniel Nichter
  • Date: 2011-06-24 17:22:06 UTC
  • Revision ID: daniel@percona.com-20110624172206-c7q4s4ad6r260zz6
Add lib/, t/lib/, and sandbox/.  All modules are updated and passing on MySQL 5.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/CompareWarnings.pm
 
1
# This program is copyright 2009-2011 Percona Inc.
 
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
# CompareWarnings package $Revision: 7096 $
 
19
# ###########################################################################
 
20
 
 
21
# Package: CompareWarnings
 
22
# CompareWarnings compares query warnings.
 
23
{
 
24
package CompareWarnings;
 
25
 
 
26
use strict;
 
27
use warnings FATAL => 'all';
 
28
use English qw(-no_match_vars);
 
29
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
30
 
 
31
use Data::Dumper;
 
32
$Data::Dumper::Indent    = 1;
 
33
$Data::Dumper::Sortkeys  = 1;
 
34
$Data::Dumper::Quotekeys = 0;
 
35
 
 
36
# Required args:
 
37
#   * get_id  coderef: used by report() to trf query to its ID
 
38
#   * common modules
 
39
# Optional args:
 
40
#   * clear-warnings        bool: clear warnings before each run
 
41
#   * clear-warnings-table  scalar: table to select from to clear warnings
 
42
sub new {
 
43
   my ( $class, %args ) = @_;
 
44
   my @required_args = qw(get_id Quoter QueryParser);
 
45
   foreach my $arg ( @required_args ) {
 
46
      die "I need a $arg argument" unless $args{$arg};
 
47
   }
 
48
   my $self = {
 
49
      %args,
 
50
      diffs   => {},
 
51
      samples => {},
 
52
   };
 
53
   return bless $self, $class;
 
54
}
 
55
 
 
56
# Required args:
 
57
#   * event  hashref: an event
 
58
#   * dbh    scalar: active dbh
 
59
# Optional args:
 
60
#   * db             scalar: database name to create temp table in unless...
 
61
#   * temp-database  scalar: ...temp db name is given
 
62
# Returns: hashref
 
63
# Can die: yes
 
64
# before_execute() selects from its special temp table to clear the warnings
 
65
# if the module was created with the clear arg specified.  The temp table is
 
66
# created if there's a db or temp db and the table doesn't exist yet.
 
67
sub before_execute {
 
68
   my ( $self, %args ) = @_;
 
69
   my @required_args = qw(event dbh);
 
70
   foreach my $arg ( @required_args ) {
 
71
      die "I need a $arg argument" unless $args{$arg};
 
72
   }
 
73
   my ($event, $dbh) = @args{@required_args};
 
74
   my $sql;
 
75
 
 
76
   return $event unless $self->{'clear-warnings'};
 
77
 
 
78
   if ( my $tbl = $self->{'clear-warnings-table'} ) {
 
79
      $sql = "SELECT * FROM $tbl LIMIT 1";
 
80
      MKDEBUG && _d($sql);
 
81
      eval {
 
82
         $dbh->do($sql);
 
83
      };
 
84
      die "Failed to SELECT from clear warnings table: $EVAL_ERROR"
 
85
         if $EVAL_ERROR;
 
86
   }
 
87
   else {
 
88
      my $q    = $self->{Quoter};
 
89
      my $qp   = $self->{QueryParser};
 
90
      my @tbls = $qp->get_tables($event->{arg});
 
91
      my $ok   = 0;
 
92
      TABLE:
 
93
      foreach my $tbl ( @tbls ) {
 
94
         $sql = "SELECT * FROM $tbl LIMIT 1";
 
95
         MKDEBUG && _d($sql);
 
96
         eval {
 
97
            $dbh->do($sql);
 
98
         };
 
99
         if ( $EVAL_ERROR ) {
 
100
            MKDEBUG && _d('Failed to clear warnings');
 
101
         }
 
102
         else {
 
103
            MKDEBUG && _d('Cleared warnings');
 
104
            $ok = 1;
 
105
            last TABLE;
 
106
         }
 
107
      }
 
108
      die "Failed to clear warnings"
 
109
         unless $ok;
 
110
   }
 
111
 
 
112
   return $event;
 
113
}
 
114
 
 
115
# Required args:
 
116
#   * event  hashref: an event
 
117
#   * dbh    scalar: active dbh
 
118
# Returns: hashref
 
119
# Can die: yes
 
120
# execute() executes the event's query if is hasn't already been executed. 
 
121
# Any prep work should have been done in before_execute().  Adds Query_time
 
122
# attrib to the event.
 
123
sub execute {
 
124
   my ( $self, %args ) = @_;
 
125
   my @required_args = qw(event dbh);
 
126
   foreach my $arg ( @required_args ) {
 
127
      die "I need a $arg argument" unless $args{$arg};
 
128
   }
 
129
   my ($event, $dbh) = @args{@required_args};
 
130
 
 
131
   if ( exists $event->{Query_time} ) {
 
132
      MKDEBUG && _d('Query already executed');
 
133
      return $event;
 
134
   }
 
135
 
 
136
   MKDEBUG && _d('Executing query');
 
137
   my $query = $event->{arg};
 
138
   my ( $start, $end, $query_time );
 
139
 
 
140
   $event->{Query_time} = 0;
 
141
   eval {
 
142
      $start = time();
 
143
      $dbh->do($query);
 
144
      $end   = time();
 
145
      $query_time = sprintf '%.6f', $end - $start;
 
146
   };
 
147
   die "Failed to execute query: $EVAL_ERROR" if $EVAL_ERROR;
 
148
 
 
149
   $event->{Query_time} = $query_time;
 
150
 
 
151
   return $event;
 
152
}
 
153
 
 
154
# Required args:
 
155
#   * event  hashref: an event
 
156
#   * dbh    scalar: active dbh
 
157
# Returns: hashref
 
158
# Can die: yes
 
159
# after_execute() gets any warnings from SHOW WARNINGS.
 
160
sub after_execute {
 
161
   my ( $self, %args ) = @_;
 
162
   my @required_args = qw(event dbh);
 
163
   foreach my $arg ( @required_args ) {
 
164
      die "I need a $arg argument" unless $args{$arg};
 
165
   }
 
166
   my ($event, $dbh) = @args{@required_args};
 
167
 
 
168
   my $warnings;
 
169
   my $warning_count;
 
170
   eval {
 
171
      $warnings      = $dbh->selectall_hashref('SHOW WARNINGS', 'Code');
 
172
      $warning_count = $dbh->selectcol_arrayref('SELECT @@warning_count')->[0];
 
173
   };
 
174
   die "Failed to SHOW WARNINGS: $EVAL_ERROR"
 
175
      if $EVAL_ERROR;
 
176
 
 
177
   # We munge the warnings to be the same thing so testing is easier, otherwise
 
178
   # a ton of code has to be involved.  This seems to be the minimal necessary
 
179
   # code to handle changes in warning messages.
 
180
   map {
 
181
      $_->{Message} =~ s/Out of range value adjusted/Out of range value/;
 
182
   } values %$warnings;
 
183
   $event->{warning_count} = $warning_count || 0;
 
184
   $event->{warnings}      = $warnings;
 
185
 
 
186
   return $event;
 
187
}
 
188
 
 
189
# Required args:
 
190
#   * events  arrayref: events
 
191
# Returns: array
 
192
# Can die: yes
 
193
# compare() compares events that have been run through before_execute(),
 
194
# execute() and after_execute().  Only a "summary" of differences is
 
195
# returned.  Specific differences are saved internally and are reported
 
196
# by calling report() later.
 
197
sub compare {
 
198
   my ( $self, %args ) = @_;
 
199
   my @required_args = qw(events);
 
200
   foreach my $arg ( @required_args ) {
 
201
      die "I need a $arg argument" unless $args{$arg};
 
202
   }
 
203
   my ($events) = @args{@required_args};
 
204
 
 
205
   my $different_warning_counts = 0;
 
206
   my $different_warnings       = 0;
 
207
   my $different_warning_levels = 0;
 
208
 
 
209
   my $event0   = $events->[0];
 
210
   my $item     = $event0->{fingerprint} || $event0->{arg};
 
211
   my $sampleno = $event0->{sampleno} || 0;
 
212
   my $w0       = $event0->{warnings};
 
213
 
 
214
   my $n_events = scalar @$events;
 
215
   foreach my $i ( 1..($n_events-1) ) {
 
216
      my $event = $events->[$i];
 
217
 
 
218
      if ( ($event0->{warning_count} || 0) != ($event->{warning_count} || 0) ) {
 
219
         MKDEBUG && _d('Warning counts differ:',
 
220
            $event0->{warning_count}, $event->{warning_count});
 
221
         $different_warning_counts++;
 
222
         $self->{diffs}->{warning_counts}->{$item}->{$sampleno}
 
223
            = [ $event0->{warning_count} || 0, $event->{warning_count} || 0 ];
 
224
         $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
225
      }
 
226
 
 
227
      # Check the warnings on event0 against this event.
 
228
      my $w = $event->{warnings};
 
229
 
 
230
      # Neither event had warnings.
 
231
      next if !$w0 && !$w;
 
232
 
 
233
      my %new_warnings;
 
234
      foreach my $code ( keys %$w0 ) {
 
235
         if ( exists $w->{$code} ) {
 
236
            if ( $w->{$code}->{Level} ne $w0->{$code}->{Level} ) {
 
237
               MKDEBUG && _d('Warning levels differ:',
 
238
                  $w0->{$code}->{Level}, $w->{$code}->{Level});
 
239
               # Save differences.
 
240
               $different_warning_levels++;
 
241
               $self->{diffs}->{levels}->{$item}->{$sampleno}
 
242
                  = [ $code, $w0->{$code}->{Level}, $w->{$code}->{Level},
 
243
                      $w->{$code}->{Message} ];
 
244
               $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
245
            }
 
246
            delete $w->{$code};
 
247
         }
 
248
         else {
 
249
            # This warning code is on event0 but not on this event.
 
250
            MKDEBUG && _d('Warning gone:', $w0->{$code}->{Message});
 
251
            # Save differences.
 
252
            $different_warnings++;
 
253
            $self->{diffs}->{warnings}->{$item}->{$sampleno}
 
254
               = [ 0, $code, $w0->{$code}->{Message} ];
 
255
            $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
256
         }
 
257
      }
 
258
 
 
259
      # Any warning codes on this event not deleted above are new;
 
260
      # i.e. they weren't on event0.
 
261
      foreach my $code ( keys %$w ) {
 
262
         MKDEBUG && _d('Warning new:', $w->{$code}->{Message});
 
263
         # Save differences.
 
264
         $different_warnings++;
 
265
         $self->{diffs}->{warnings}->{$item}->{$sampleno}
 
266
            = [ $i, $code, $w->{$code}->{Message} ];
 
267
         $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
268
      }
 
269
 
 
270
      # EventAggregator won't know what do with this hashref so delete it.
 
271
      delete $event->{warnings};
 
272
   }
 
273
   delete $event0->{warnings};
 
274
 
 
275
   return (
 
276
      different_warning_counts => $different_warning_counts,
 
277
      different_warnings       => $different_warnings,
 
278
      different_warning_levels => $different_warning_levels,
 
279
   );
 
280
}
 
281
 
 
282
sub report {
 
283
   my ( $self, %args ) = @_;
 
284
   my @required_args = qw(hosts);
 
285
   foreach my $arg ( @required_args ) {
 
286
      die "I need a $arg argument" unless $args{$arg};
 
287
   }
 
288
   my ($hosts) = @args{@required_args};
 
289
 
 
290
   return unless keys %{$self->{diffs}};
 
291
 
 
292
   # These columns are common to all the reports; make them just once.
 
293
   my $query_id_col = {
 
294
      name        => 'Query ID',
 
295
   };
 
296
   my @host_cols = map {
 
297
      my $col = { name => $_->{name} };
 
298
      $col;
 
299
   } @$hosts;
 
300
 
 
301
   my @reports;
 
302
   foreach my $diff ( qw(warnings levels warning_counts) ) {
 
303
      my $report = "_report_diff_$diff";
 
304
      push @reports, $self->$report(
 
305
         query_id_col => $query_id_col,
 
306
         host_cols    => \@host_cols,
 
307
         %args
 
308
      );
 
309
   }
 
310
 
 
311
   return join("\n", @reports);
 
312
}
 
313
 
 
314
sub _report_diff_warnings {
 
315
   my ( $self, %args ) = @_;
 
316
   my @required_args = qw(query_id_col hosts);
 
317
   foreach my $arg ( @required_args ) {
 
318
      die "I need a $arg argument" unless $args{$arg};
 
319
   }
 
320
 
 
321
   my $get_id = $self->{get_id};
 
322
 
 
323
   return unless keys %{$self->{diffs}->{warnings}};
 
324
 
 
325
   my $report = new ReportFormatter(extend_right => 1);
 
326
   $report->set_title('New warnings');
 
327
   $report->set_columns(
 
328
      $args{query_id_col},
 
329
      { name => 'Host', },
 
330
      { name => 'Code', right_justify => 1 },
 
331
      { name => 'Message' },
 
332
   );
 
333
 
 
334
   my $diff_warnings = $self->{diffs}->{warnings};
 
335
   foreach my $item ( sort keys %$diff_warnings ) {
 
336
      map {
 
337
         my ($hostno, $code, $message) = @{$diff_warnings->{$item}->{$_}};
 
338
         $report->add_line(
 
339
            $get_id->($item) . '-' . $_,
 
340
            $args{hosts}->[$hostno]->{name}, $code, $message,
 
341
         );
 
342
      } sort { $a <=> $b } keys %{$diff_warnings->{$item}};
 
343
   }
 
344
 
 
345
   return $report->get_report();
 
346
}
 
347
 
 
348
sub _report_diff_levels {
 
349
   my ( $self, %args ) = @_;
 
350
   my @required_args = qw(query_id_col hosts);
 
351
   foreach my $arg ( @required_args ) {
 
352
      die "I need a $arg argument" unless $args{$arg};
 
353
   }
 
354
 
 
355
   my $get_id = $self->{get_id};
 
356
 
 
357
   return unless keys %{$self->{diffs}->{levels}};
 
358
 
 
359
   my $report = new ReportFormatter(extend_right => 1);
 
360
   $report->set_title('Warning level differences');
 
361
   $report->set_columns(
 
362
      $args{query_id_col},
 
363
      { name => 'Code', right_justify => 1 },
 
364
      map {
 
365
         my $col = { name => $_->{name}, right_justify => 1  };
 
366
         $col;
 
367
      } @{$args{hosts}},
 
368
      { name => 'Message' },
 
369
   );
 
370
 
 
371
   my $diff_levels = $self->{diffs}->{levels};
 
372
   foreach my $item ( sort keys %$diff_levels ) {
 
373
      map {
 
374
         $report->add_line(
 
375
            $get_id->($item) . '-' . $_,
 
376
            @{$diff_levels->{$item}->{$_}},
 
377
         );
 
378
      } sort { $a <=> $b } keys %{$diff_levels->{$item}};
 
379
   }
 
380
 
 
381
   return $report->get_report();
 
382
}
 
383
 
 
384
sub _report_diff_warning_counts {
 
385
   my ( $self, %args ) = @_;
 
386
   my @required_args = qw(query_id_col hosts);
 
387
   foreach my $arg ( @required_args ) {
 
388
      die "I need a $arg argument" unless $args{$arg};
 
389
   }
 
390
 
 
391
   my $get_id = $self->{get_id};
 
392
 
 
393
   return unless keys %{$self->{diffs}->{warning_counts}};
 
394
 
 
395
   my $report = new ReportFormatter();
 
396
   $report->set_title('Warning count differences');
 
397
   $report->set_columns(
 
398
      $args{query_id_col},
 
399
      map {
 
400
         my $col = { name => $_->{name}, right_justify => 1  };
 
401
         $col;
 
402
      } @{$args{hosts}},
 
403
   );
 
404
 
 
405
   my $diff_warning_counts = $self->{diffs}->{warning_counts};
 
406
   foreach my $item ( sort keys %$diff_warning_counts ) {
 
407
      map {
 
408
         $report->add_line(
 
409
            $get_id->($item) . '-' . $_,
 
410
            @{$diff_warning_counts->{$item}->{$_}},
 
411
         );
 
412
      } sort { $a <=> $b } keys %{$diff_warning_counts->{$item}};
 
413
   }
 
414
 
 
415
   return $report->get_report();
 
416
}
 
417
 
 
418
sub samples {
 
419
   my ( $self, $item ) = @_;
 
420
   return unless $item;
 
421
   my @samples;
 
422
   foreach my $sampleno ( keys %{$self->{samples}->{$item}} ) {
 
423
      push @samples, $sampleno, $self->{samples}->{$item}->{$sampleno};
 
424
   }
 
425
   return @samples;
 
426
}
 
427
 
 
428
sub reset {
 
429
   my ( $self ) = @_;
 
430
   $self->{diffs}   = {};
 
431
   $self->{samples} = {};
 
432
   return;
 
433
}
 
434
 
 
435
sub _d {
 
436
   my ($package, undef, $line) = caller 0;
 
437
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
438
        map { defined $_ ? $_ : 'undef' }
 
439
        @_;
 
440
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
441
}
 
442
 
 
443
1;
 
444
}
 
445
# ###########################################################################
 
446
# End CompareWarnings package
 
447
# ###########################################################################