Change the Report modules to use Lmo

This commit is contained in:
Brian Fraser fraserb@gmail.com
2013-02-01 14:06:13 -03:00
parent d816c6497e
commit 809164becd
18 changed files with 476 additions and 238 deletions

View File

@@ -394,10 +394,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -677,6 +678,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}

View File

@@ -1416,10 +1416,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1699,6 +1700,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}

View File

@@ -20,6 +20,7 @@ BEGIN {
Diskstats
DiskstatsGroupByAll
DiskstatsGroupByDisk
DiskstatsGroupBySample
DiskstatsMenu
VersionCheck
HTTPMicro
@@ -1090,24 +1091,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;
@@ -2798,6 +2801,190 @@ sub compute_in_progress {
# See https://launchpad.net/percona-toolkit for more information.
# ###########################################################################
{
package DiskstatsGroupBySample;
use warnings;
use strict;
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use base qw( Diskstats );
use POSIX qw( ceil );
sub new {
my ( $class, %args ) = @_;
my $self = $class->SUPER::new(%args);
$self->{_iterations} = 0;
$self->{_save_curr_as_prev} = 0;
return $self;
}
sub group_by {
my ( $self, %args ) = @_;
my @optional_args = qw( header_callback rows_callback );
my ( $header_callback, $rows_callback ) = $args{ @optional_args };
$self->clear_state() unless $self->interactive();
$self->parse_from(
sample_callback => $self->can("_sample_callback"),
filehandle => $args{filehandle},
filename => $args{filename},
data => $args{data},
);
return;
}
sub _sample_callback {
my ( $self, $ts, %args ) = @_;
my $printed_a_line = 0;
if ( $self->has_stats() ) {
$self->{_iterations}++;
}
my $elapsed = ($self->curr_ts() || 0)
- ($self->prev_ts() || 0);
if ( $ts > 0 && ceil($elapsed) >= $self->sample_time() ) {
$self->print_deltas(
max_device_length => 6,
header_callback => sub {
my ( $self, $header, @args ) = @_;
if ( $self->force_header() ) {
my $method = $args{header_callback} || "print_header";
$self->$method( $header, @args );
$self->set_force_header(undef);
}
},
rows_callback => sub {
my ( $self, $format, $cols, $stat ) = @_;
my $method = $args{rows_callback} || "print_rows";
$self->$method( $format, $cols, $stat );
$printed_a_line = 1;
}
);
}
if ( $self->{_iterations} == 1 || $printed_a_line == 1 ) {
$self->{_save_curr_as_prev} = 1;
$self->_save_curr_as_prev( $self->stats_for() );
$self->set_prev_ts_line( $self->curr_ts_line() );
$self->{_save_curr_as_prev} = 0;
}
return;
}
sub delta_against {
my ( $self, $dev ) = @_;
return $self->prev_stats_for($dev);
}
sub ts_line_for_timestamp {
my ($self) = @_;
return $self->prev_ts_line();
}
sub delta_against_ts {
my ( $self ) = @_;
return $self->prev_ts();
}
sub clear_state {
my ( $self, @args ) = @_;
$self->{_iterations} = 0;
$self->{_save_curr_as_prev} = 0;
$self->SUPER::clear_state(@args);
}
sub compute_devs_in_group {
my ($self) = @_;
my $stats = $self->stats_for();
return scalar grep {
$stats->{$_} && $self->_print_device_if($_)
} $self->ordered_devs;
}
sub compute_dev {
my ( $self, $devs ) = @_;
$devs ||= $self->compute_devs_in_group();
return "{" . $devs . "}" if $devs > 1;
return (grep { $self->_print_device_if($_) } $self->ordered_devs())[0];
}
sub _calc_stats_for_deltas {
my ( $self, $elapsed ) = @_;
my $delta_for;
foreach my $dev ( grep { $self->_print_device_if($_) } $self->ordered_devs() ) {
my $curr = $self->stats_for($dev);
my $against = $self->delta_against($dev);
next unless $curr && $against;
my $delta = $self->_calc_delta_for( $curr, $against );
$delta->{ios_in_progress} = $curr->[Diskstats::IOS_IN_PROGRESS];
while ( my ( $k, $v ) = each %$delta ) {
$delta_for->{$k} += $v;
}
}
return unless $delta_for && %{$delta_for};
my $in_progress = $delta_for->{ios_in_progress};
my $tot_in_progress = 0;
my $devs_in_group = $self->compute_devs_in_group() || 1;
my %stats = (
$self->_calc_read_stats(
delta_for => $delta_for,
elapsed => $elapsed,
devs_in_group => $devs_in_group,
),
$self->_calc_write_stats(
delta_for => $delta_for,
elapsed => $elapsed,
devs_in_group => $devs_in_group,
),
in_progress =>
$self->compute_in_progress( $in_progress, $tot_in_progress ),
);
my %extras = $self->_calc_misc_stats(
delta_for => $delta_for,
elapsed => $elapsed,
devs_in_group => $devs_in_group,
stats => \%stats,
);
@stats{ keys %extras } = values %extras;
$stats{dev} = $self->compute_dev( $devs_in_group );
$self->{_first_time_magic} = undef;
if ( @{$self->{_nochange_skips}} ) {
my $devs = join ", ", @{$self->{_nochange_skips}};
PTDEBUG && _d("Skipping [$devs], haven't changed from the first sample");
$self->{_nochange_skips} = [];
}
return \%stats;
}
sub compute_line_ts {
my ($self, %args) = @_;
if ( $self->show_timestamps() ) {
@args{ qw( first_ts curr_ts ) } = @args{ qw( curr_ts first_ts ) }
}
return $self->SUPER::compute_line_ts(%args);
}
1;
}
# ###########################################################################
# End DiskstatsGroupBySample package

View File

@@ -1793,24 +1793,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -3019,24 +3019,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -3211,24 +3211,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;
@@ -4434,61 +4436,6 @@ sub fingerprint {
my ($explain) = @args{@required_args};
}
sub sparkline {
my ( $self, %args ) = @_;
my @required_args = qw(explain);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless defined $args{$arg};
}
my ($explain) = @args{@required_args};
PTDEBUG && _d("Making sparkline for", Dumper($explain));
my $access_code = {
'ALL' => 'a',
'const' => 'c',
'eq_ref' => 'e',
'fulltext' => 'f',
'index' => 'i',
'index_merge' => 'm',
'range' => 'n',
'ref_or_null' => 'o',
'ref' => 'r',
'system' => 's',
'unique_subquery' => 'u',
};
my $sparkline = '';
my ($T, $F); # Using temporary, Using filesort
foreach my $tbl ( @$explain ) {
my $code;
if ( defined $tbl->{type} ) {
$code = $access_code->{$tbl->{type}} || "?";
$code = uc $code if $tbl->{Extra}->{'Using index'};
}
else {
$code = '-'
};
$sparkline .= $code;
$T = 1 if $tbl->{Extra}->{'Using temporary'};
$F = 1 if $tbl->{Extra}->{'Using filesort'};
}
if ( $T || $F ) {
if ( $explain->[-1]->{Extra}->{'Using temporary'}
|| $explain->[-1]->{Extra}->{'Using filesort'} ) {
$sparkline .= ">" . ($T ? "T" : "") . ($F ? "F" : "");
}
else {
$sparkline = ($T ? "T" : "") . ($F ? "F" : "") . ">$sparkline";
}
}
PTDEBUG && _d("sparkline:", $sparkline);
return $sparkline;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }

View File

@@ -1423,10 +1423,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1706,6 +1707,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}
@@ -2312,24 +2323,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -2517,7 +2517,7 @@ sub _d {
{
package ReportFormatter;
use Mo;
use Lmo;
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
@@ -2920,6 +2920,7 @@ sub _d {
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
no Lmo;
1;
}
# ###########################################################################

View File

@@ -1416,10 +1416,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1699,6 +1700,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}
@@ -2305,24 +2316,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -1395,10 +1395,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1678,6 +1679,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}
@@ -3212,24 +3223,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -1543,10 +1543,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1826,6 +1827,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}

View File

@@ -3116,10 +3116,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -3399,6 +3400,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}
@@ -3568,7 +3579,7 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Mo;
use Lmo;
use Data::Dumper;
sub get_cluster_name {
@@ -7397,24 +7408,26 @@ use Time::Local qw(timegm timelocal);
use Digest::MD5 qw(md5_hex);
use B qw();
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ();
our @EXPORT = ();
our @EXPORT_OK = qw(
micro_t
percentage_of
secs_to_time
time_to_secs
shorten
ts
parse_timestamp
unix_timestamp
any_unix_timestamp
make_checksum
crc32
encode_json
);
}
our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;

View File

@@ -2214,7 +2214,7 @@ sub _d {
{
package VersionParser;
use Mo;
use Lmo;
use Scalar::Util qw(blessed);
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;

View File

@@ -1420,10 +1420,11 @@ sub import {
my $caller = scalar caller(); # Caller's package
my %exports = (
extends => \&extends,
has => \&has,
with => \&with,
confess => \&Carp::confess,
extends => \&extends,
has => \&has,
with => \&with,
override => \&override,
confess => \&Carp::confess,
);
$export_for{$caller} = \%exports;
@@ -1703,6 +1704,16 @@ BEGIN {
}
}
sub override {
my ($methods, $code) = @_;
my $caller = scalar caller;
for my $method ( ref($methods) ? @$methods : $methods ) {
my $full_method = "${caller}::${method}";
*{_glob_for $full_method} = $code;
}
}
}
1;
}

View File

@@ -1,6 +1,6 @@
{
package JSONReportFormatter;
use Mo;
use Lmo;
use List::Util qw(sum);
use Transformers qw(make_checksum parse_timestamp);
@@ -120,5 +120,6 @@ override query_report => sub {
return $json . "\n";
};
no Lmo;
1;
}

View File

@@ -27,7 +27,7 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use Mo;
use Lmo;
use Data::Dumper;
sub get_cluster_name {

View File

@@ -29,7 +29,7 @@
# which is also in mk-query-digest.
package QueryReportFormatter;
use Mo;
use Lmo;
use English qw(-no_match_vars);
use POSIX qw(floor);
@@ -1343,6 +1343,7 @@ sub _d {
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
no Lmo;
1;
}
# ###########################################################################

View File

@@ -56,7 +56,7 @@
# calculated widths.
package ReportFormatter;
use Mo;
use Lmo;
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
@@ -506,6 +506,7 @@ sub _d {
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
no Lmo;
1;
}
# ###########################################################################