mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-10-18 16:40:23 +00:00
Change the Report modules to use Lmo
This commit is contained in:
@@ -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;
|
||||
}
|
||||
|
@@ -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;
|
||||
}
|
||||
|
223
bin/pt-diskstats
223
bin/pt-diskstats
@@ -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
|
||||
|
@@ -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+)?/;
|
||||
|
@@ -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+)?/;
|
||||
|
@@ -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; }
|
||||
|
57
bin/pt-kill
57
bin/pt-kill
@@ -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+)?/;
|
||||
|
@@ -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;
|
||||
}
|
||||
# ###########################################################################
|
||||
|
@@ -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+)?/;
|
||||
|
@@ -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+)?/;
|
||||
|
@@ -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;
|
||||
}
|
||||
|
@@ -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+)?/;
|
||||
|
@@ -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;
|
||||
|
@@ -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;
|
||||
}
|
||||
|
@@ -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;
|
||||
}
|
||||
|
@@ -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 {
|
||||
|
@@ -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;
|
||||
}
|
||||
# ###########################################################################
|
||||
|
@@ -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;
|
||||
}
|
||||
# ###########################################################################
|
||||
|
Reference in New Issue
Block a user