← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-change-master-bug-932614

« back to all changes in this revision

Viewing changes to lib/CompareQueryTimes.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/CompareQueryTimes.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
# CompareQueryTimes package $Revision: 6785 $
 
19
# ###########################################################################
 
20
 
 
21
# Package: CompareQueryTimes
 
22
# CompareQueryTimes compares query execution times.
 
23
{
 
24
package CompareQueryTimes;
 
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
Transformers->import(qw(micro_t));
 
32
use POSIX qw(floor);
 
33
use Data::Dumper;
 
34
$Data::Dumper::Indent    = 1;
 
35
$Data::Dumper::Sortkeys  = 1;
 
36
$Data::Dumper::Quotekeys = 0;
 
37
 
 
38
# Significant percentage increase for each bucket.  For example,
 
39
# 1us to 4us is a 300% increase, but in reality that is not significant.
 
40
# But a 500% increase to 6us may be significant.  In the 1s+ range (last
 
41
# bucket), since the time is already so bad, even a 20% increase (e.g. 1s
 
42
# to 1.2s) is significant.
 
43
my @bucket_threshold = qw(500 100  100   500 50   50    20 1   );
 
44
# my @bucket_labels  = qw(1us 10us 100us 1ms 10ms 100ms 1s 10s+);
 
45
 
 
46
# Sub: new
 
47
#
 
48
# Parameters:
 
49
#   %args - Arguments
 
50
#
 
51
# Required Arguments:
 
52
#   get_id - Callback used by report() to transform query to its ID
 
53
#
 
54
# Returns:
 
55
#   CompareQueryTimes object
 
56
sub new {
 
57
   my ( $class, %args ) = @_;
 
58
   my @required_args = qw(get_id);
 
59
   foreach my $arg ( @required_args ) {
 
60
      die "I need a $arg argument" unless $args{$arg};
 
61
   }
 
62
   my $self = {
 
63
      %args,
 
64
      diffs   => {},
 
65
      samples => {},
 
66
   };
 
67
   return bless $self, $class;
 
68
}
 
69
 
 
70
sub before_execute {
 
71
   my ( $self, %args ) = @_;
 
72
   my @required_args = qw(event);
 
73
   foreach my $arg ( @required_args ) {
 
74
      die "I need a $arg argument" unless $args{$arg};
 
75
   }
 
76
   return $args{event};
 
77
}
 
78
 
 
79
# Sub: execute
 
80
#   Execute query if not already executed.
 
81
#
 
82
# Parameters:
 
83
#   %args - Arguments
 
84
#
 
85
# Required Arguments:
 
86
#   event - Hashref with event attributes and values
 
87
#   dbh   - dbh on which to execute the event
 
88
#
 
89
# Returns:
 
90
#   Hashref of event with Query_time attribute added
 
91
sub execute {
 
92
   my ( $self, %args ) = @_;
 
93
   my @required_args = qw(event dbh);
 
94
   foreach my $arg ( @required_args ) {
 
95
      die "I need a $arg argument" unless $args{$arg};
 
96
   }
 
97
   my ($event, $dbh) = @args{@required_args};
 
98
 
 
99
   if ( exists $event->{Query_time} ) {
 
100
      MKDEBUG && _d('Query already executed');
 
101
      return $event;
 
102
   }
 
103
 
 
104
   MKDEBUG && _d('Executing query');
 
105
   my $query = $event->{arg};
 
106
   my ( $start, $end, $query_time );
 
107
 
 
108
   $event->{Query_time} = 0;
 
109
   eval {
 
110
      $start = time();
 
111
      $dbh->do($query);
 
112
      $end   = time();
 
113
      $query_time = sprintf '%.6f', $end - $start;
 
114
   };
 
115
   die "Failed to execute query: $EVAL_ERROR" if $EVAL_ERROR;
 
116
 
 
117
   $event->{Query_time} = $query_time;
 
118
 
 
119
   return $event;
 
120
}
 
121
 
 
122
sub after_execute {
 
123
   my ( $self, %args ) = @_;
 
124
   my @required_args = qw(event);
 
125
   foreach my $arg ( @required_args ) {
 
126
      die "I need a $arg argument" unless $args{$arg};
 
127
   }
 
128
   return $args{event};
 
129
}
 
130
 
 
131
# Sub: compare
 
132
#   Compare executed events.
 
133
#
 
134
# Parameters:
 
135
#   %args - Arguments
 
136
#
 
137
# Required Arguments:
 
138
#   events - Arrayref of event hashrefs
 
139
#
 
140
# Returns:
 
141
#   Hash of differences
 
142
sub compare {
 
143
   my ( $self, %args ) = @_;
 
144
   my @required_args = qw(events);
 
145
   foreach my $arg ( @required_args ) {
 
146
      die "I need a $arg argument" unless $args{$arg};
 
147
   }
 
148
   my ($events) = @args{@required_args};
 
149
 
 
150
   my $different_query_times = 0;
 
151
 
 
152
   my $event0   = $events->[0];
 
153
   my $item     = $event0->{fingerprint} || $event0->{arg};
 
154
   my $sampleno = $event0->{sampleno}    || 0;
 
155
   my $t0       = $event0->{Query_time}  || 0;
 
156
   my $b0       = bucket_for($t0);
 
157
 
 
158
   my $n_events = scalar @$events;
 
159
   foreach my $i ( 1..($n_events-1) ) {
 
160
      my $event = $events->[$i];
 
161
      my $t     = $event->{Query_time};
 
162
      my $b     = bucket_for($t);
 
163
 
 
164
      if ( $b0 != $b ) {
 
165
         # Save differences.
 
166
         my $diff = abs($t0 - $t);
 
167
         $different_query_times++;
 
168
         $self->{diffs}->{big}->{$item}->{$sampleno}
 
169
            = [ micro_t($t0), micro_t($t), micro_t($diff) ];
 
170
         $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
171
      }
 
172
      else {
 
173
         my $inc = percentage_increase($t0, $t);
 
174
         if ( $inc >= $bucket_threshold[$b0] ) {
 
175
            # Save differences.
 
176
            $different_query_times++;
 
177
            $self->{diffs}->{in_bucket}->{$item}->{$sampleno}
 
178
               = [ micro_t($t0), micro_t($t), $inc, $bucket_threshold[$b0] ];
 
179
            $self->{samples}->{$item}->{$sampleno} = $event0->{arg};
 
180
         }
 
181
      }
 
182
   }
 
183
 
 
184
   return (
 
185
      different_query_times => $different_query_times,
 
186
   );
 
187
}
 
188
 
 
189
# Sub: buck_for
 
190
#   Calculate bucket for value.
 
191
#
 
192
# Parameters:
 
193
#   $val - Value
 
194
#
 
195
# Returns:
 
196
#   Bucket number for value
 
197
sub bucket_for {
 
198
   my ( $val ) = @_;
 
199
   die "I need a val" unless defined $val;
 
200
   return 0 if $val == 0;
 
201
   my $bucket = floor(log($val) / log(10)) + 6;
 
202
   $bucket = $bucket > 7 ? 7 : $bucket < 0 ? 0 : $bucket;
 
203
   return $bucket;
 
204
}
 
205
 
 
206
# Sub: percentage_increase
 
207
#   Calculate percentage increase between two values.
 
208
#
 
209
# Parameters:
 
210
#   $x - First value
 
211
#   $y - Second value
 
212
#
 
213
# Returns:
 
214
#   Percentage increase from first to second value
 
215
sub percentage_increase {
 
216
   my ( $x, $y ) = @_;
 
217
   return 0 if $x == $y;
 
218
 
 
219
   if ( $x > $y ) {
 
220
      my $z = $y;
 
221
         $y = $x;
 
222
         $x = $z;
 
223
   }
 
224
 
 
225
   if ( $x == 0 ) {
 
226
      return 1000;  # This should trigger all buckets' thresholds.
 
227
   }
 
228
 
 
229
   return sprintf '%.2f', (($y - $x) / $x) * 100;
 
230
}
 
231
 
 
232
 
 
233
# Sub: report
 
234
#   Report differences found.
 
235
#
 
236
# Parameters:
 
237
#   %args - Arguments
 
238
#
 
239
# Required Arguments:
 
240
#   hosts - Arrayref of hosts
 
241
#
 
242
# Returns:
 
243
#   Report text of differences
 
244
sub report {
 
245
   my ( $self, %args ) = @_;
 
246
   my @required_args = qw(hosts);
 
247
   foreach my $arg ( @required_args ) {
 
248
      die "I need a $arg argument" unless $args{$arg};
 
249
   }
 
250
   my ($hosts) = @args{@required_args};
 
251
 
 
252
   return unless keys %{$self->{diffs}};
 
253
 
 
254
   # These columns are common to all the reports; make them just once.
 
255
   my $query_id_col = {
 
256
      name        => 'Query ID',
 
257
   };
 
258
   my @host_cols = map {
 
259
      my $col = { name => $_->{name} };
 
260
      $col;
 
261
   } @$hosts;
 
262
 
 
263
   my @reports;
 
264
   foreach my $diff ( qw(big in_bucket) ) {
 
265
      my $report = "_report_diff_$diff";
 
266
      push @reports, $self->$report(
 
267
         query_id_col => $query_id_col,
 
268
         host_cols    => \@host_cols,
 
269
         %args
 
270
      );
 
271
   }
 
272
 
 
273
   return join("\n", @reports);
 
274
}
 
275
 
 
276
# Sub: _report_diff_big
 
277
#   Report big differences in query times.
 
278
#
 
279
# Parameters:
 
280
#   %args - Arguments
 
281
#
 
282
# Required Arguments:
 
283
#   query_id_col - Hashref <ReportFormat> column descriptor
 
284
#   hosts        - Arrayref of hosts
 
285
#
 
286
# Returns:
 
287
#   Big query time diff report
 
288
sub _report_diff_big {
 
289
   my ( $self, %args ) = @_;
 
290
   my @required_args = qw(query_id_col hosts);
 
291
   foreach my $arg ( @required_args ) {
 
292
      die "I need a $arg argument" unless $args{$arg};
 
293
   }
 
294
 
 
295
   my $get_id = $self->{get_id};
 
296
 
 
297
   return unless keys %{$self->{diffs}->{big}};
 
298
 
 
299
   my $report = new ReportFormatter();
 
300
   $report->set_title('Big query time differences');
 
301
   $report->set_columns(
 
302
      $args{query_id_col},
 
303
      map {
 
304
         my $col = { name => $_->{name}, right_justify => 1  };
 
305
         $col;
 
306
      } @{$args{hosts}},
 
307
      { name => 'Difference', right_justify => 1 },
 
308
   );
 
309
 
 
310
   my $diff_big = $self->{diffs}->{big};
 
311
   foreach my $item ( sort keys %$diff_big ) {
 
312
      map {
 
313
         $report->add_line(
 
314
            $get_id->($item) . '-' . $_,
 
315
            @{$diff_big->{$item}->{$_}},
 
316
         );
 
317
      } sort { $a <=> $b } keys %{$diff_big->{$item}};
 
318
   }
 
319
 
 
320
   return $report->get_report();
 
321
}
 
322
 
 
323
# Sub: _report_diff_big
 
324
#   Report smaller, "in bucket" query time differences.
 
325
#
 
326
# Parameters:
 
327
#   %args - Arguments
 
328
#
 
329
# Required Arguments:
 
330
#   query_id_col - Hashref <ReportFormat> column descriptor
 
331
#   hosts        - Arrayref of hosts
 
332
#
 
333
# Returns:
 
334
#   In bucket query time diff report
 
335
sub _report_diff_in_bucket {
 
336
   my ( $self, %args ) = @_;
 
337
   my @required_args = qw(query_id_col hosts);
 
338
   foreach my $arg ( @required_args ) {
 
339
      die "I need a $arg argument" unless $args{$arg};
 
340
   }
 
341
 
 
342
   my $get_id = $self->{get_id};
 
343
 
 
344
   return unless keys %{$self->{diffs}->{in_bucket}};
 
345
 
 
346
   my $report = new ReportFormatter();
 
347
   $report->set_title('Significant query time differences');
 
348
   $report->set_columns(
 
349
      $args{query_id_col},
 
350
      map {
 
351
         my $col = { name => $_->{name}, right_justify => 1  };
 
352
         $col;
 
353
      } @{$args{hosts}},
 
354
      { name => '%Increase',  right_justify => 1 },
 
355
      { name => '%Threshold', right_justify => 1 },
 
356
   );
 
357
 
 
358
   my $diff_in_bucket = $self->{diffs}->{in_bucket};
 
359
   foreach my $item ( sort keys %$diff_in_bucket ) {
 
360
      map {
 
361
         $report->add_line(
 
362
            $get_id->($item) . '-' . $_,
 
363
            @{$diff_in_bucket->{$item}->{$_}},
 
364
         );
 
365
      } sort { $a <=> $b } keys %{$diff_in_bucket->{$item}};
 
366
   }
 
367
 
 
368
   return $report->get_report();
 
369
}
 
370
 
 
371
# Sub: samples
 
372
#   Return samples of queries with differences.
 
373
#
 
374
# Parameters:
 
375
#   $item - Query fingerprint
 
376
#
 
377
# Returns:
 
378
#   Array of queries
 
379
sub samples {
 
380
   my ( $self, $item ) = @_;
 
381
   return unless $item;
 
382
   my @samples;
 
383
   foreach my $sampleno ( keys %{$self->{samples}->{$item}} ) {
 
384
      push @samples, $sampleno, $self->{samples}->{$item}->{$sampleno};
 
385
   }
 
386
   return @samples;
 
387
}
 
388
 
 
389
 
 
390
# Sub: reset
 
391
#   Reset internal state for another run.
 
392
sub reset {
 
393
   my ( $self ) = @_;
 
394
   $self->{diffs}   = {};
 
395
   $self->{samples} = {};
 
396
   return;
 
397
}
 
398
 
 
399
sub _d {
 
400
   my ($package, undef, $line) = caller 0;
 
401
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
 
402
        map { defined $_ ? $_ : 'undef' }
 
403
        @_;
 
404
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
 
405
}
 
406
 
 
407
1;
 
408
}
 
409
# ###########################################################################
 
410
# End CompareQueryTimes package
 
411
# ###########################################################################