← Back to branch summary

~percona-toolkit-dev/percona-toolkit/release-2.2.3

« back to all changes in this revision

Viewing changes to lib/UpgradeReportFormatter.pm

  • Committer: Daniel Nichter
  • Date: 2013-03-12 15:21:13 UTC
  • mfrom: (507.1.37 pt-upgrade-2.2)
  • Revision ID: daniel@percona.com-20130312152113-jfkrxi3p8ca84oin
Merge pt-upgrade-2.2.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/UpgradeReportFormatter.pm
1
 
# This program is copyright 2009-2012 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
 
# UpgradeReportFormatter package
19
 
# ###########################################################################
20
 
{
21
 
# Package: UpgradeReportFormatter
22
 
# UpgradeReportFormatter formats the output of pt-upgrade.
23
 
package UpgradeReportFormatter;
24
 
 
25
 
use strict;
26
 
use warnings FATAL => 'all';
27
 
use English qw(-no_match_vars);
28
 
 
29
 
use constant PTDEBUG           => $ENV{PTDEBUG};
30
 
use constant LINE_LENGTH       => 74;
31
 
use constant MAX_STRING_LENGTH => 10;
32
 
 
33
 
Transformers->import(qw(make_checksum percentage_of shorten micro_t));
34
 
 
35
 
# Special formatting functions
36
 
my %formatting_function = (
37
 
   ts => sub {
38
 
      my ( $stats ) = @_;
39
 
      my $min = parse_timestamp($stats->{min} || '');
40
 
      my $max = parse_timestamp($stats->{max} || '');
41
 
      return $min && $max ? "$min to $max" : '';
42
 
   },
43
 
);
44
 
 
45
 
my $bool_format = '# %3s%% %-6s %s';
46
 
 
47
 
sub new {
48
 
   my ( $class, %args ) = @_;
49
 
   return bless { }, $class;
50
 
}
51
 
 
52
 
sub event_report {
53
 
   my ( $self, %args ) = @_;
54
 
   my @required_args = qw(where rank worst meta_ea hosts);
55
 
   foreach my $arg ( @required_args ) {
56
 
      die "I need a $arg argument" unless $args{$arg};
57
 
   }
58
 
   my ($where, $rank, $worst, $meta_ea, $hosts) = @args{@required_args};
59
 
   my $meta_stats = $meta_ea->results;
60
 
   my @result;
61
 
 
62
 
 
63
 
   # First line
64
 
   my $line = sprintf(
65
 
      '# Query %d: ID 0x%s at byte %d ',
66
 
      $rank || 0,
67
 
      make_checksum($where) || '0x0',
68
 
      0, # $sample->{pos_in_log} || 0
69
 
   );
70
 
   $line .= ('_' x (LINE_LENGTH - length($line)));
71
 
   push @result, $line;
72
 
 
73
 
   # Second line: full host names
74
 
   # https://bugs.launchpad.net/percona-toolkit/+bug/980318
75
 
   my $hostno = 0;
76
 
   foreach my $host ( @$hosts ) {
77
 
      $hostno++;
78
 
      push @result, "# host$hostno: " . ($host->{name} || '?')
79
 
   }
80
 
 
81
 
   # Differences report.  This relies on a sampleno attrib in each class
82
 
   # since all other attributes (except maybe Query_time) are optional.
83
 
   my $class = $meta_stats->{classes}->{$where};
84
 
   push @result,
85
 
      '# Found ' . ($class->{differences}->{sum} || 0)
86
 
      . ' differences in ' . $class->{sampleno}->{cnt} . " samples:\n";
87
 
 
88
 
   my $fmt = "# %-17s %d\n";
89
 
   my @diffs = grep { $_ =~ m/^different_/ } keys %$class;
90
 
   foreach my $diff ( sort @diffs ) {
91
 
      push @result,
92
 
         sprintf $fmt, '  ' . (make_label($diff) || ''), ($class->{$diff}->{sum} || 0);
93
 
   }
94
 
 
95
 
   # Side-by-side hosts report.
96
 
   my $report = new ReportFormatter(
97
 
      underline_header => 0,
98
 
      strip_whitespace => 0,
99
 
   );
100
 
   $hostno = 0;
101
 
   $report->set_columns(
102
 
      { name => '' },
103
 
      map { $hostno++; { name => "host$hostno", right_justify => 1 } } @$hosts,
104
 
   );
105
 
   # Bool values.
106
 
   foreach my $thing ( qw(Errors Warnings) ) {
107
 
      my @vals = $thing;
108
 
      foreach my $host ( @$hosts ) {
109
 
         my $ea    = $host->{ea};
110
 
         my $stats = $ea->results->{classes}->{$where};
111
 
         if ( $stats && $stats->{$thing} ) {
112
 
            push @vals, shorten($stats->{$thing}->{sum}, d=>1_000, p=>0)
113
 
         }
114
 
         else {
115
 
            push @vals, 0;
116
 
         }
117
 
      }
118
 
      $report->add_line(@vals);
119
 
   }
120
 
   # Fully aggregated numeric values.
121
 
   foreach my $thing ( qw(Query_time row_count) ) {
122
 
      my @vals;
123
 
 
124
 
      foreach my $host ( @$hosts ) {
125
 
         my $ea    = $host->{ea};
126
 
         my $stats = $ea->results->{classes}->{$where};
127
 
         if ( $stats && $stats->{$thing} ) {
128
 
            my $vals = $stats->{$thing};
129
 
            my $func = $thing =~ m/time$/ ? \&micro_t : \&shorten;
130
 
            my $metrics = $host->{ea}->metrics(attrib=>$thing, where=>$where);
131
 
            my @n = (
132
 
               @{$vals}{qw(sum min max)},
133
 
               ($vals->{sum} || 0) / ($vals->{cnt} || 1),
134
 
               @{$metrics}{qw(pct_95 stddev median)},
135
 
            );
136
 
            @n = map { defined $_ ? $func->($_) : '' } @n;
137
 
            push @vals, \@n;
138
 
         }
139
 
         else {
140
 
            push @vals, undef;
141
 
         }
142
 
      }
143
 
 
144
 
      if ( scalar @vals && grep { defined } @vals ) {
145
 
         $report->add_line($thing, map { '' } @$hosts);
146
 
         my @metrics = qw(sum min max avg pct_95 stddev median);
147
 
         for my $i ( 0..$#metrics ) {
148
 
            my @n = '  ' . $metrics[$i];
149
 
            push @n, map { $_ && defined $_->[$i] ? $_->[$i] : '' } @vals;
150
 
            $report->add_line(@n);
151
 
         }
152
 
      }
153
 
   }
154
 
 
155
 
   push @result, $report->get_report();
156
 
 
157
 
   return join("\n", map { s/\s+$//; $_ } @result) . "\n";
158
 
}
159
 
 
160
 
# Convert attribute names into labels
161
 
sub make_label {
162
 
   my ( $val ) = @_;
163
 
 
164
 
   $val =~ s/^different_//;
165
 
   $val =~ s/_/ /g;
166
 
 
167
 
   return $val;
168
 
}
169
 
 
170
 
# Does pretty-printing for lists of strings like users, hosts, db.
171
 
sub format_string_list {
172
 
   my ( $stats ) = @_;
173
 
   if ( exists $stats->{unq} ) {
174
 
      # Only class stats have unq.
175
 
      my $cnt_for = $stats->{unq};
176
 
      if ( 1 == keys %$cnt_for ) {
177
 
         my ($str) = keys %$cnt_for;
178
 
         # - 30 for label, spacing etc.
179
 
         $str = substr($str, 0, LINE_LENGTH - 30) . '...'
180
 
            if length $str > LINE_LENGTH - 30;
181
 
         return (1, $str);
182
 
      }
183
 
      my $line = '';
184
 
      my @top = sort { $cnt_for->{$b} <=> $cnt_for->{$a} || $a cmp $b }
185
 
                     keys %$cnt_for;
186
 
      my $i = 0;
187
 
      foreach my $str ( @top ) {
188
 
         my $print_str;
189
 
         if ( length $str > MAX_STRING_LENGTH ) {
190
 
            $print_str = substr($str, 0, MAX_STRING_LENGTH) . '...';
191
 
         }
192
 
         else {
193
 
            $print_str = $str;
194
 
         }
195
 
         last if (length $line) + (length $print_str)  > LINE_LENGTH - 27;
196
 
         $line .= "$print_str ($cnt_for->{$str}), ";
197
 
         $i++;
198
 
      }
199
 
      $line =~ s/, $//;
200
 
      if ( $i < @top ) {
201
 
         $line .= "... " . (@top - $i) . " more";
202
 
      }
203
 
      return (scalar keys %$cnt_for, $line);
204
 
   }
205
 
   else {
206
 
      # Global stats don't have unq.
207
 
      return ($stats->{cnt});
208
 
   }
209
 
}
210
 
 
211
 
sub _d {
212
 
   my ($package, undef, $line) = caller 0;
213
 
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
214
 
        map { defined $_ ? $_ : 'undef' }
215
 
        @_;
216
 
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
217
 
}
218
 
 
219
 
1;
220
 
}
221
 
# ###########################################################################
222
 
# End UpgradeReportFormatter package
223
 
# ###########################################################################