percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2026-05-06 01:01:24 +08:00
Code Issues Packages Projects Releases Wiki Activity

Merge lp:~percona-toolkit-dev/percona-toolkit/simplify-pqd r541.

Browse Source
This commit is contained in:
Daniel Nichter
2013-01-18 16:21:10 -07:00
parent f999686610 4a06dc2008
commit fcb5a0c0f8
146 changed files with 2276 additions and 3656 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lib/EventAggregator.pm
-77
View File
@@ -619,16 +619,6 @@ sub calculate_statistical_metrics {
$classes->{$class}->{$attrib}->{all},
$classes->{$class}->{$attrib}
);
# Apdex (http://code.google.com/p/maatkit/issues/detail?id=1054)
if ( $args{apdex_t} && $attrib eq 'Query_time' ) {
$class_metrics->{$class}->{$attrib}->{apdex_t} = $args{apdex_t};
$class_metrics->{$class}->{$attrib}->{apdex}
= $self->calculate_apdex(
t => $args{apdex_t},
samples => $classes->{$class}->{$attrib}->{all},
);
}
}
}
}
@@ -784,9 +774,6 @@ sub metrics {
median => $metrics->{classes}->{$where}->{$attrib}->{median} || 0,
pct_95 => $metrics->{classes}->{$where}->{$attrib}->{pct_95} || 0,
stddev => $metrics->{classes}->{$where}->{$attrib}->{stddev} || 0,
apdex_t => $metrics->{classes}->{$where}->{$attrib}->{apdex_t},
apdex => $metrics->{classes}->{$where}->{$attrib}->{apdex},
};
}
@@ -1164,70 +1151,6 @@ sub _deep_copy_attrib_vals {
return $copy;
}
# Sub: calculate_apdex
# Calculate the Apdex score for the given T and response times.
# <http://www.apdex.org/documents/ApdexTechnicalSpecificationV11_000.pdf>
#
# Parameters:
# %args - Arguments
#
# Required Arguments:
# t - Target threshold
# samples - Hashref with bucketized response time values,
# i.e. { bucket_number => n_responses, }
#
# Returns:
# Apdex score
sub calculate_apdex {
my ( $self, %args ) = @_;
my @required_args = qw(t samples);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my ($t, $samples) = @args{@required_args};
if ( $t <= 0 ) {
die "Invalid target threshold (T): $t. T must be greater than zero";
}
my $f = 4 * $t;
PTDEBUG && _d("Apdex T =", $t, "F =", $f);
my $satisfied = 0;
my $tolerating = 0;
my $frustrated = 0; # just for debug output
my $n_samples = 0;
BUCKET:
for my $bucket ( keys %$samples ) {
my $n_responses = $samples->{$bucket};
my $response_time = $buck_vals[$bucket];
# Response time increases from 0 to F.
# 0 --- T --- F
# ^ ^-- tolerating zone
# |
# +-------- satisfied zone
if ( $response_time <= $t ) {
$satisfied += $n_responses;
}
elsif ( $response_time <= $f ) {
$tolerating += $n_responses;
}
else {
$frustrated += $n_responses;
}
$n_samples += $n_responses;
}
my $apdex = sprintf('%.2f', ($satisfied + ($tolerating / 2)) / $n_samples);
PTDEBUG && _d($n_samples, "samples,", $satisfied, "satisfied,",
$tolerating, "tolerating,", $frustrated, "frustrated, Apdex score:",
$apdex);
return $apdex;
}
# Sub: _get_value
# Get the value of the attribute (or one of its alternatives) from the event.
# Undef is a valid value. If the attrib or none of its alternatives exist
lib/ExplainAnalyzer.pm
+1 -87
View File
@@ -215,7 +215,7 @@ sub save_usage_for {
# explain - Hashref of normalized EXPLAIN data
#
# Returns:
# Fingerprint/sparkline string
# Fingerprint string
sub fingerprint {
my ( $self, %args ) = @_;
my @required_args = qw(explain);
@@ -225,92 +225,6 @@ sub fingerprint {
my ($explain) = @args{@required_args};
}
# Sub: sparkline
# Create a sparkline of EXPLAIN data from <normalize()>. A spark line
# is a very compact, terse fingerprint that represents just the following.
# See <issue 1141 at http://code.google.com/p/maatkit/issues/detail?id=1141>.
#
# access (for each table):
# - a: ALL
# - c: const
# - e: eq_ref
# - f: fulltext
# - i: index
# - m: index_merge
# - n: range
# - o: ref_or_null
# - r: ref
# - s: system
# - u: unique_subquery
#
# Extra:
# - uppsercaes access code: Using extra
# - T: Using temprary
# - F: Using filesort
#
# Parameters:
# %args - Arguments
#
# Required Arguments:
# explain - Hashref of normalized EXPLAIN data
#
# Returns:
# Sparkline string like (start code)TF>Ree(end code)
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; }
lib/JSONReportFormatter.pm
+96
View File
@@ -0,0 +1,96 @@
{
package JSONReportFormatter;
use Mo;
use JSON;
use List::Util qw(sum);
use Transformers qw(make_checksum parse_timestamp);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
extends qw(QueryReportFormatter);
override [qw(rusage date hostname files header profile prepared)] => sub {
return;
};
override event_report => sub {
my ($self, %args) = @_;
return $self->event_report_values(%args);
};
override query_report => sub {
my ($self, %args) = @_;
foreach my $arg ( qw(ea worst orderby groupby) ) {
die "I need a $arg argument" unless defined $arg;
}
my $ea = $args{ea};
my $worst = $args{worst};
my @attribs = @{$ea->get_attributes()};
my @queries;
foreach my $worst_info ( @$worst ) {
my $item = $worst_info->[0];
my $stats = $ea->results->{classes}->{$item};
my $sample = $ea->results->{samples}->{$item};
my $all_log_pos = $ea->{result_classes}->{$item}->{pos_in_log}->{all};
my $times_seen = sum values %$all_log_pos;
my %class = (
sample => $sample->{arg},
fingerprint => $item,
checksum => make_checksum($item),
cnt => $times_seen,
);
my %metrics;
foreach my $attrib ( @attribs ) {
$metrics{$attrib} = $ea->metrics(
attrib => $attrib,
where => $item,
);
}
foreach my $attrib ( keys %metrics ) {
if ( ! grep { $_ } values %{$metrics{$attrib}} ) {
delete $metrics{$attrib};
next;
}
if ($attrib eq 'ts') {
my $ts = delete $metrics{ts};
foreach my $thing ( qw(min max) ) {
next unless defined $ts && defined $ts->{$thing};
$ts->{$thing} = parse_timestamp($ts->{$thing});
}
$class{ts_min} = $ts->{min};
$class{ts_max} = $ts->{max};
}
elsif ( ($ea->{type_for}->{$attrib} || '') eq 'num' ) {
# Avoid scientific notation in the metrics by forcing it to use
# six decimal places.
for my $value ( values %{$metrics{$attrib}} ) {
next unless $value;
$value = sprintf '%.6f', $value;
}
# ..except for the percentage, which only needs two
if ( my $pct = $metrics{$attrib}->{pct} ) {
$metrics{$attrib}->{pct} = sprintf('%.2f', $pct);
}
}
}
push @queries, {
class => \%class,
attributes => \%metrics,
};
}
return encode_json(\@queries) . "\n";
};
1;
}
lib/Pipeline.pm
+1 -1
View File
@@ -42,7 +42,7 @@ sub new {
my $self = {
# default values for optional args
instrument => 0,
instrument => PTDEBUG,
continue_on_error => 0,
# specified arg values override defaults
lib/QueryReportFormatter.pm
+291 -371
View File
@@ -29,8 +29,7 @@
# which is also in mk-query-digest.
package QueryReportFormatter;
use strict;
use warnings FATAL => 'all';
use Mo;
use English qw(-no_match_vars);
use POSIX qw(floor);
@@ -43,6 +42,9 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use constant LINE_LENGTH => 74;
use constant MAX_STRING_LENGTH => 10;
{ local $EVAL_ERROR; eval { require Quoter } };
{ local $EVAL_ERROR; eval { require ReportFormatter } };
# Sub: new
#
# Parameters:
@@ -56,31 +58,69 @@ use constant MAX_STRING_LENGTH => 10;
# Optional arguments:
# QueryReview - <QueryReview> object used in <query_report()>
# dbh - dbh used in <explain_report()>
# ExplainAnalyzer - <ExplainAnalyzer> object used in <explain_report()>.
# This causes a sparkline to be printed (issue 1141).
#
# Returns:
# QueryReportFormatter object
sub new {
my ( $class, %args ) = @_;
foreach my $arg ( qw(OptionParser QueryRewriter Quoter) ) {
die "I need a $arg argument" unless $args{$arg};
has Quoter => (
is => 'ro',
isa => 'Quoter',
default => sub { Quoter->new() },
);
has label_width => (
is => 'ro',
isa => 'Int',
);
has global_headers => (
is => 'ro',
isa => 'ArrayRef',
default => sub { [qw( total min max avg 95% stddev median)] },
);
has event_headers => (
is => 'ro',
isa => 'ArrayRef',
default => sub { [qw(pct total min max avg 95% stddev median)] },
);
has ReportFormatter => (
is => 'ro',
isa => 'ReportFormatter',
builder => '_build_report_formatter',
);
sub _build_report_formatter {
return ReportFormatter->new(
line_width => LINE_LENGTH,
extend_right => 1,
);
}
sub BUILDARGS {
my $class = shift;
my $args = $class->SUPER::BUILDARGS(@_);
foreach my $arg ( qw(OptionParser QueryRewriter) ) {
die "I need a $arg argument" unless $args->{$arg};
}
# If ever someone wishes for a wider label width.
my $label_width = $args{label_width} || 12;
my $label_width = $args->{label_width} ||= 12;
PTDEBUG && _d('Label width:', $label_width);
my $cheat_width = $label_width + 1;
my $o = delete $args->{OptionParser};
my $self = {
%args,
label_width => $label_width,
%$args,
options => {
show_all => $o->get('show-all'),
shorten => $o->get('shorten'),
report_all => $o->get('report-all'),
report_histogram => $o->get('report-histogram'),
},
num_format => "# %-${label_width}s %3s %7s %7s %7s %7s %7s %7s %7s",
bool_format => "# %-${label_width}s %3d%% yes, %3d%% no",
string_format => "# %-${label_width}s %s",
global_headers => [qw( total min max avg 95% stddev median)],
event_headers => [qw(pct total min max avg 95% stddev median)],
hidden_attrib => { # Don't sort/print these attribs in the reports.
arg => 1, # They're usually handled specially, or not
fingerprint => 1, # printed at all.
@@ -88,32 +128,7 @@ sub new {
ts => 1,
},
};
return bless $self, $class;
}
# Sub: set_report_formatter
# Set a report formatter object for a report. By default this package will
# instantiate ReportFormatter objects to format columnized reports (e.g.
# for profile and prepared reports). Setting a caller-created formatter
# object (usually a <ReportFormatter> obj) is used for tested and also by
# <mk-query-digest> to extend the profile report line width to 82 for
# the --explain sparkline.
#
# Parameters:
# %args - Arguments
#
# Required Arguments:
# report - Report name, e.g. profile, prepared, etc.
# formatter - Formatter object, usually a <ReportFormatter> obj
sub set_report_formatter {
my ( $self, %args ) = @_;
my @required_args = qw(report formatter);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless exists $args{$arg};
}
my ($report, $formatter) = @args{@required_args};
$self->{formatter_for}->{$report} = $formatter;
return;
return $self;
}
# Arguments:
@@ -243,7 +258,7 @@ sub header {
shorten(scalar keys %{$results->{classes}}, d=>1_000),
shorten($qps || 0, d=>1_000),
shorten($conc || 0, d=>1_000));
$line .= ('_' x (LINE_LENGTH - length($line) + $self->{label_width} - 12));
$line .= ('_' x (LINE_LENGTH - length($line) + $self->label_width() - 12));
push @result, $line;
# Second line: time range
@@ -308,6 +323,70 @@ sub header {
return join("\n", map { s/\s+$//; $_ } @result) . "\n";
}
sub query_report_values {
my ($self, %args) = @_;
foreach my $arg ( qw(ea worst orderby groupby) ) {
die "I need a $arg argument" unless defined $arg;
}
my $ea = $args{ea};
my $groupby = $args{groupby};
my $worst = $args{worst};
my $q = $self->Quoter;
my $qv = $self->{QueryReview};
my $qr = $self->{QueryRewriter};
my @values;
# Print each worst item: its stats/metrics (sum/min/max/95%/etc.),
# Query_time distro chart, tables, EXPLAIN, fingerprint, etc.
# Items are usually unique queries/fingerprints--depends on how
# the events were grouped.
ITEM:
foreach my $top_event ( @$worst ) {
my $item = $top_event->[0];
my $reason = $args{explain_why} ? $top_event->[1] : '';
my $rank = $top_event->[2];
my $stats = $ea->results->{classes}->{$item};
my $sample = $ea->results->{samples}->{$item};
my $samp_query = $sample->{arg} || '';
my %item_vals = (
item => $item,
samp_query => $samp_query,
rank => ($rank || 0),
reason => $reason,
);
# ###############################################################
# Possibly skip item for --review.
# ###############################################################
my $review_vals;
if ( $qv ) {
$review_vals = $qv->get_review_info($item);
next ITEM if $review_vals->{reviewed_by} && !$self->{options}->{report_all};
for my $col ( $qv->review_cols() ) {
push @{$item_vals{review_vals}}, [$col, $review_vals->{$col}];
}
}
$item_vals{default_db} = $sample->{db} ? $sample->{db}
: $stats->{db}->{unq} ? keys %{$stats->{db}->{unq}}
: undef;
$item_vals{tables} = [$self->{QueryParser}->extract_tables(
query => $samp_query,
default_db => $item_vals{default_db},
Quoter => $self->Quoter,
)];
if ( $samp_query && ($args{variations} && @{$args{variations}}) ) {
$item_vals{crc} = crc32($samp_query);
}
push @values, \%item_vals;
}
return \@values;
}
# Arguments:
# * ea obj: EventAggregator
# * worst arrayref: worst items
@@ -319,16 +398,11 @@ sub header {
# * print_header bool: "Report grouped by" header
sub query_report {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea worst orderby groupby) ) {
die "I need a $arg argument" unless defined $arg;
}
my $ea = $args{ea};
my $groupby = $args{groupby};
my $worst = $args{worst};
my $report_values = $self->query_report_values(%args);
my $o = $self->{OptionParser};
my $q = $self->{Quoter};
my $qv = $self->{QueryReview};
my $qr = $self->{QueryRewriter};
my $report = '';
@@ -350,66 +424,36 @@ sub query_report {
# Items are usually unique queries/fingerprints--depends on how
# the events were grouped.
ITEM:
foreach my $top_event ( @$worst ) {
my $item = $top_event->[0];
my $reason = $args{explain_why} ? $top_event->[1] : '';
my $rank = $top_event->[2];
my $stats = $ea->results->{classes}->{$item};
my $sample = $ea->results->{samples}->{$item};
my $samp_query = $sample->{arg} || '';
# ###############################################################
# Possibly skip item for --review.
# ###############################################################
my $review_vals;
if ( $qv ) {
$review_vals = $qv->get_review_info($item);
next ITEM if $review_vals->{reviewed_by} && !$o->get('report-all');
}
# ###############################################################
# Get tables for --for-explain.
# ###############################################################
my ($default_db) = $sample->{db} ? $sample->{db}
: $stats->{db}->{unq} ? keys %{$stats->{db}->{unq}}
: undef;
my @tables;
if ( $o->get('for-explain') ) {
@tables = $self->{QueryParser}->extract_tables(
query => $samp_query,
default_db => $default_db,
Quoter => $self->{Quoter},
);
}
foreach my $vals ( @$report_values ) {
my $item = $vals->{item};
# ###############################################################
# Print the standard query analysis report.
# ###############################################################
$report .= "\n" if $rank > 1; # space between each event report
$report .= "\n" if $vals->{rank} > 1; # space between each event report
$report .= $self->event_report(
%args,
item => $item,
sample => $sample,
rank => $rank,
reason => $reason,
sample => $ea->results->{samples}->{$item},
rank => $vals->{rank},
reason => $vals->{reason},
attribs => $attribs,
db => $default_db,
db => $vals->{default_db},
);
if ( $o->get('report-histogram') ) {
if ( $self->{options}->{report_histogram} ) {
$report .= $self->chart_distro(
%args,
attrib => $o->get('report-histogram'),
item => $item,
attrib => $self->{options}->{report_histogram},
item => $vals->{item},
);
}
if ( $qv && $review_vals ) {
if ( $vals->{review_vals} ) {
# Print the review information that is already in the table
# before putting anything new into the table.
$report .= "# Review information\n";
foreach my $col ( $qv->review_cols() ) {
my $val = $review_vals->{$col};
foreach my $elem ( @{$vals->{review_vals}} ) {
my ($col, $val) = @$elem;
if ( !$val || $val ne '0000-00-00 00:00:00' ) { # issue 202
$report .= sprintf "# %13s: %-s\n", $col, ($val ? $val : '');
}
@@ -418,25 +462,22 @@ sub query_report {
if ( $groupby eq 'fingerprint' ) {
# Shorten it if necessary (issue 216 and 292).
$samp_query = $qr->shorten($samp_query, $o->get('shorten'))
if $o->get('shorten');
my $samp_query = $qr->shorten($vals->{samp_query}, $self->{options}->{shorten})
if $self->{options}->{shorten};
# Print query fingerprint.
$report .= "# Fingerprint\n# $item\n"
if $o->get('fingerprints');
PTDEBUG && _d("Fingerprint\n# $vals->{item}\n");
# Print tables used by query.
$report .= $self->tables_report(@tables)
if $o->get('for-explain');
$report .= $self->tables_report(@{$vals->{tables}});
# Print sample (worst) query's CRC % 1_000. We mod 1_000 because
# that's actually the value stored in the ea, not the full checksum.
# So the report will print something like,
# # arg crc 685 (2/66%), 159 (1/33%)
# Thus we want our "CRC" line to be 685 and not 18547302820.
if ( $samp_query && ($args{variations} && @{$args{variations}}) ) {
my $crc = crc32($samp_query);
$report.= "# CRC " . ($crc ? $crc % 1_000 : "") . "\n";
if ( $vals->{crc} ) {
$report.= "# CRC " . ($vals->{crc} % 1_000) . "\n";
}
my $log_type = $args{log_type} || '';
@@ -450,14 +491,13 @@ sub query_report {
}
else {
$report .= "# EXPLAIN /*!50100 PARTITIONS*/\n$samp_query${mark}\n";
$report .= $self->explain_report($samp_query, $default_db);
$report .= $self->explain_report($samp_query, $vals->{default_db});
}
}
else {
$report .= "$samp_query${mark}\n";
my $converted = $qr->convert_to_select($samp_query);
if ( $o->get('for-explain')
&& $converted
if ( $converted
&& $converted =~ m/^[\(\s]*select/i ) {
# It converted OK to a SELECT
$report .= "# Converted for EXPLAIN\n# EXPLAIN /*!50100 PARTITIONS*/\n$converted${mark}\n";
@@ -466,7 +506,7 @@ sub query_report {
}
else {
if ( $groupby eq 'tables' ) {
my ( $db, $tbl ) = $q->split_unquote($item);
my ( $db, $tbl ) = $self->Quoter->split_unquote($item);
$report .= $self->tables_report([$db, $tbl]);
}
$report .= "$item\n";
@@ -486,21 +526,20 @@ sub query_report {
# * rank scalar: item rank among the worst
# Print a report about the statistics in the EventAggregator.
# Called by query_report().
sub event_report {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea item orderby) ) {
die "I need a $arg argument" unless defined $args{$arg};
}
my $ea = $args{ea};
my $item = $args{item};
sub event_report_values {
my ($self, %args) = @_;
my $ea = $args{ea};
my $item = $args{item};
my $orderby = $args{orderby};
my $results = $ea->results();
my $o = $self->{OptionParser};
my @result;
my %vals;
# Return unless the item exists in the results (it should).
my $store = $results->{classes}->{$item};
return "# No such event $item\n" unless $store;
return unless $store;
# Pick the first attribute to get counts
my $global_cnt = $results->{globals}->{$orderby}->{cnt};
@@ -521,80 +560,26 @@ sub event_report {
};
}
# First line like:
# Query 1: 9 QPS, 0x concurrency, ID 0x7F7D57ACDD8A346E at byte 5 ________
my $line = sprintf(
'# %s %d: %s QPS, %sx concurrency, ID 0x%s at byte %.f ',
($ea->{groupby} eq 'fingerprint' ? 'Query' : 'Item'),
$args{rank} || 0,
shorten($qps || 0, d=>1_000),
shorten($conc || 0, d=>1_000),
make_checksum($item),
$results->{samples}->{$item}->{pos_in_log} || 0,
);
$line .= ('_' x (LINE_LENGTH - length($line) + $self->{label_width} - 12));
push @result, $line;
# Second line: reason why this class is being reported.
if ( $args{reason} ) {
push @result,
"# This item is included in the report because it matches "
. ($args{reason} eq 'top' ? '--limit.' : '--outliers.');
}
# Third line: Apdex and variance-to-mean (V/M) ratio, like:
# Scores: Apdex = 0.93 [1.0], V/M = 1.5
{
$vals{groupby} = $ea->{groupby};
$vals{qps} = $qps || 0;
$vals{concurrency} = $conc || 0;
$vals{checksum} = make_checksum($item);
$vals{pos_in_log} = $results->{samples}->{$item}->{pos_in_log} || 0;
$vals{reason} = $args{reason};
$vals{variance_to_mean} = do {
my $query_time = $ea->metrics(where => $item, attrib => 'Query_time');
push @result,
sprintf("# Scores: Apdex = %s [%3.1f]%s, V/M = %.2f",
(defined $query_time->{apdex} ? "$query_time->{apdex}" : "NS"),
($query_time->{apdex_t} || 0),
($query_time->{cnt} < 100 ? "*" : ""),
($query_time->{stddev}**2 / ($query_time->{avg} || 1)),
);
$query_time->{stddev}**2 / ($query_time->{avg} || 1)
};
$vals{counts} = {
class_cnt => $class_cnt,
global_cnt => $global_cnt,
};
if ( my $ts = $store->{ts}) {
$vals{time_range} = $self->format_time_range($ts) || "unknown";
}
# Fourth line: EXPLAIN sparkline if --explain.
if ( $o->get('explain') && $results->{samples}->{$item}->{arg} ) {
eval {
my $sparkline = $self->explain_sparkline(
$results->{samples}->{$item}->{arg}, $args{db});
push @result, "# EXPLAIN sparkline: $sparkline\n";
};
if ( $EVAL_ERROR ) {
PTDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR);
}
}
if ( my $attrib = $o->get('report-histogram') ) {
my $sparkline = $self->distro_sparkline(
%args,
attrib => $attrib,
item => $item,
);
if ( $sparkline ) {
# I find the | | bookends help make the sparkchart graph more clear.
# Else with just .^- it's difficult to tell where the chart beings
# or ends.
push @result, "# $attrib sparkline: |$sparkline|";
}
}
# Last line before column headers: time range
if ( my $ts = $store->{ts} ) {
my $time_range = $self->format_time_range($ts) || "unknown";
push @result, "# Time range: $time_range";
}
# Column header line
push @result, $self->make_event_header();
# Count line
push @result,
sprintf $self->{num_format}, 'Count',
percentage_of($class_cnt, $global_cnt), $class_cnt, map { '' } (1..8);
# Sort the attributes, removing any hidden attributes, if they're not
# already given to us. In mk-query-digest, this sub is called from
# query_report(), but in testing it's called directly. query_report()
@@ -607,11 +592,10 @@ sub event_report {
);
}
$vals{attributes} = { map { $_ => [] } qw(num innodb bool string) };
foreach my $type ( qw(num innodb) ) {
# Add "InnoDB:" sub-header before grouped InnoDB_* attributes.
if ( $type eq 'innodb' && @{$attribs->{$type}} ) {
push @result, "# InnoDB:";
};
NUM_ATTRIB:
foreach my $attrib ( @{$attribs->{$type}} ) {
@@ -631,15 +615,12 @@ sub event_report {
$pct = percentage_of(
$vals->{sum}, $results->{globals}->{$attrib}->{sum});
push @result,
sprintf $self->{num_format},
$self->make_label($attrib), $pct, @values;
push @{$vals{attributes}{$type}},
[ $attrib, $pct, @values ];
}
}
if ( @{$attribs->{bool}} ) {
push @result, "# Boolean:";
my $printed_bools = 0;
BOOL_ATTRIB:
foreach my $attrib ( @{$attribs->{bool}} ) {
next BOOL_ATTRIB unless exists $store->{$attrib};
@@ -647,33 +628,125 @@ sub event_report {
next unless scalar %$vals;
if ( $vals->{sum} > 0 ) {
push @result,
sprintf $self->{bool_format},
$self->make_label($attrib), $self->bool_percents($vals);
$printed_bools = 1;
push @{$vals{attributes}{bool}},
[ $attrib, $self->bool_percents($vals) ];
}
}
pop @result unless $printed_bools;
}
if ( @{$attribs->{string}} ) {
push @result, "# String:";
my $printed_strings = 0;
STRING_ATTRIB:
foreach my $attrib ( @{$attribs->{string}} ) {
next STRING_ATTRIB unless exists $store->{$attrib};
my $vals = $store->{$attrib};
next unless scalar %$vals;
push @{$vals{attributes}{string}},
[ $attrib, $vals ];
}
}
return \%vals;
}
# TODO I maybe've broken the groupby report
sub event_report {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea item orderby) ) {
die "I need a $arg argument" unless defined $args{$arg};
}
my $item = $args{item};
my $val = $self->event_report_values(%args);
my @result;
return "# No such event $item\n" unless $val;
# First line like:
# Query 1: 9 QPS, 0x concurrency, ID 0x7F7D57ACDD8A346E at byte 5 ________
my $line = sprintf(
'# %s %d: %s QPS, %sx concurrency, ID 0x%s at byte %.f ',
($val->{groupby} eq 'fingerprint' ? 'Query' : 'Item'),
$args{rank} || 0,
shorten($val->{qps}, d=>1_000),
shorten($val->{concurrency}, d=>1_000),
$val->{checksum},
$val->{pos_in_log},
);
$line .= ('_' x (LINE_LENGTH - length($line) + $self->label_width() - 12));
push @result, $line;
# Second line: reason why this class is being reported.
if ( $val->{reason} ) {
push @result,
"# This item is included in the report because it matches "
. ($val->{reason} eq 'top' ? '--limit.' : '--outliers.');
}
# Third line: Variance-to-mean (V/M) ratio, like:
# Scores: V/M = 1.5
push @result,
sprintf("# Scores: V/M = %.2f", $val->{variance_to_mean} );
# Last line before column headers: time range
if ( $val->{time_range} ) {
push @result, "# Time range: $val->{time_range}";
}
# Column header line
push @result, $self->make_event_header();
# Count line
push @result,
sprintf $self->{num_format}, 'Count',
percentage_of($val->{counts}{class_cnt}, $val->{counts}{global_cnt}),
$val->{counts}{class_cnt},
map { '' } (1..8);
my $attribs = $val->{attributes};
foreach my $type ( qw(num innodb) ) {
# Add "InnoDB:" sub-header before grouped InnoDB_* attributes.
if ( $type eq 'innodb' && @{$attribs->{$type}} ) {
push @result, "# InnoDB:";
};
NUM_ATTRIB:
foreach my $attrib ( @{$attribs->{$type}} ) {
my ($attrib_name, @vals) = @$attrib;
push @result,
sprintf $self->{num_format},
$self->make_label($attrib_name), @vals;
}
}
if ( @{$attribs->{bool}} ) {
push @result, "# Boolean:";
BOOL_ATTRIB:
foreach my $attrib ( @{$attribs->{bool}} ) {
my ($attrib_name, @vals) = @$attrib;
push @result,
sprintf $self->{bool_format},
$self->make_label($attrib_name), @vals;
}
}
if ( @{$attribs->{string}} ) {
push @result, "# String:";
STRING_ATTRIB:
foreach my $attrib ( @{$attribs->{string}} ) {
my ($attrib_name, $vals) = @$attrib;
push @result,
sprintf $self->{string_format},
$self->make_label($attrib),
$self->format_string_list($attrib, $vals, $class_cnt);
$printed_strings = 1;
$self->make_label($attrib_name),
$self->format_string_list($attrib_name, $vals, $val->{counts}{class_cnt});
}
pop @result unless $printed_strings;
}
return join("\n", map { s/\s+$//; $_ } @result) . "\n";
}
@@ -739,98 +812,6 @@ sub chart_distro {
return join("\n", @results) . "\n";
}
# Sub: distro_sparkline
# Make a sparkline of the <chart_distro()> graph. The following
# character codes are used: _.-^ If a bucket doesn't have a value, a
# space is used. So _ buckets are the lowest lines on the full graph
# (<chart_distro()>), and ^ are the peaks on the full graph. See
# QueryReportFormatter.t for several examples.
#
# This sub isn't the most optimized. The first half is the same code
# as <chart_distro()>. Then the latter code, unique to this sub,
# essentially compresses the full chart further into 8 characters using
# the 4 char codes above.
#
# Parameters:
# %args - Arguments
#
# Required Arguments:
# ea - <EventAggregator> object
# item - Item in results to chart
# attrib - Attribute of item to chart
#
# Returns:
# Sparkchart string
sub distro_sparkline {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea item attrib) ) {
die "I need a $arg argument" unless defined $args{$arg};
}
my $ea = $args{ea};
my $item = $args{item};
my $attrib = $args{attrib};
my $results = $ea->results();
my $store = $results->{classes}->{$item}->{$attrib};
my $vals = $store->{all};
my $all_zeros_sparkline = " " x 8;
return $all_zeros_sparkline unless defined $vals && scalar %$vals;
my @buck_tens = $ea->buckets_of(10);
my @distro = map { 0 } (0 .. 7);
my @buckets = map { 0 } (0..999);
map { $buckets[$_] = $vals->{$_} } keys %$vals;
$vals = \@buckets;
map { $distro[$buck_tens[$_]] += $vals->[$_] } (1 .. @$vals - 1);
my $vals_per_mark;
my $max_val = 0;
my $max_disp_width = 64;
foreach my $n_vals ( @distro ) {
$max_val = $n_vals if $n_vals > $max_val;
}
$vals_per_mark = $max_val / $max_disp_width;
my ($min, $max);
foreach my $i ( 0 .. $#distro ) {
my $n_vals = $distro[$i];
my $n_marks = $n_vals / ($vals_per_mark || 1);
$n_marks = 1 if $n_marks < 1 && $n_vals > 0;
$min = $n_marks if $n_marks && (!$min || $n_marks < $min);
$max = $n_marks if !$max || $n_marks > $max;
}
return $all_zeros_sparkline unless $min && $max;
# That ^ code is mostly the same as chart_distro(). Now here's
# our own unique code.
# Divide the range by 4 because there are 4 char codes: _.-^
$min = 0 if $min == $max;
my @range_min;
my $d = floor((($max+0.00001)-$min) / 4);
for my $x ( 1..4 ) {
push @range_min, $min + ($d * $x);
}
my $sparkline = "";
foreach my $i ( 0 .. $#distro ) {
my $n_vals = $distro[$i];
my $n_marks = $n_vals / ($vals_per_mark || 1);
$n_marks = 1 if $n_marks < 1 && $n_vals > 0;
$sparkline .= $n_marks <= 0 ? ' '
: $n_marks <= $range_min[0] ? '_'
: $n_marks <= $range_min[1] ? '.'
: $n_marks <= $range_min[2] ? '-'
: '^';
}
return $sparkline;
}
# Profile subreport (issue 381).
# Arguments:
# * ea obj: EventAggregator
@@ -839,7 +820,6 @@ sub distro_sparkline {
# Optional arguments:
# * other arrayref: other items (that didn't make it into top worst)
# * distill_args hashref: extra args for distill()
# * ReportFormatter obj: passed-in ReportFormatter for testing
sub profile {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea worst groupby) ) {
@@ -851,7 +831,6 @@ sub profile {
my $groupby = $args{groupby};
my $qr = $self->{QueryRewriter};
my $o = $self->{OptionParser};
# Total response time of all events.
my $results = $ea->results();
@@ -874,41 +853,20 @@ sub profile {
$qr->distill($samp_query, %{$args{distill_args}}) : $item,
id => $groupby eq 'fingerprint' ? make_checksum($item) : '',
vmr => ($query_time->{stddev}**2) / ($query_time->{avg} || 1),
apdex => defined $query_time->{apdex} ? $query_time->{apdex} : "NS",
);
# Get EXPLAIN sparkline if --explain.
if ( $o->get('explain') && $samp_query ) {
my ($default_db) = $sample->{db} ? $sample->{db}
: $stats->{db}->{unq} ? keys %{$stats->{db}->{unq}}
: undef;
eval {
$profile{explain_sparkline} = $self->explain_sparkline(
$samp_query, $default_db);
};
if ( $EVAL_ERROR ) {
PTDEBUG && _d("Failed to get EXPLAIN sparkline:", $EVAL_ERROR);
}
}
push @profiles, \%profile;
}
my $report = $self->{formatter_for}->{profile} || new ReportFormatter(
line_width => LINE_LENGTH,
long_last_column => 1,
extend_right => 1,
);
$report->set_title('Profile');
my $report = $self->ReportFormatter();
$report->title('Profile');
my @cols = (
{ name => 'Rank', right_justify => 1, },
{ name => 'Query ID', },
{ name => 'Response time', right_justify => 1, },
{ name => 'Calls', right_justify => 1, },
{ name => 'R/Call', right_justify => 1, },
{ name => 'Apdx', right_justify => 1, width => 4, },
{ name => 'V/M', right_justify => 1, width => 5, },
( $o->get('explain') ? { name => 'EXPLAIN' } : () ),
{ name => 'Item', },
);
$report->set_columns(@cols);
@@ -924,9 +882,7 @@ sub profile {
"$rt $rtp",
$item->{cnt},
$rc,
$item->{apdex},
$vmr,
( $o->get('explain') ? $item->{explain_sparkline} || "" : () ),
$item->{sample},
);
$report->add_line(@vals);
@@ -954,9 +910,7 @@ sub profile {
"$rt $rtp",
$misc->{cnt},
$rc,
'NS', # Apdex is not meaningful here
'0.0', # variance-to-mean ratio is not meaningful here
( $o->get('explain') ? "MISC" : () ),
"<".scalar @$other." ITEMS>",
);
}
@@ -971,7 +925,6 @@ sub profile {
# * groupby scalar: attrib worst items grouped by
# Optional arguments:
# * distill_args hashref: extra args for distill()
# * ReportFormatter obj: passed-in ReportFormatter for testing
sub prepared {
my ( $self, %args ) = @_;
foreach my $arg ( qw(ea worst groupby) ) {
@@ -1056,12 +1009,8 @@ sub prepared {
# Return unless there are prepared statements to report.
return unless scalar @prepared;
my $report = $self->{formatter_for}->{prepared} || new ReportFormatter(
line_width => LINE_LENGTH,
long_last_column => 1,
extend_right => 1,
);
$report->set_title('Prepared statements');
my $report = $self->ReportFormatter();
$report->title('Prepared statements');
$report->set_columns(
{ name => 'Rank', right_justify => 1, },
{ name => 'Query ID', },
@@ -1097,7 +1046,7 @@ sub make_global_header {
# First line:
# Attribute total min max avg 95% stddev median
push @lines,
sprintf $self->{num_format}, "Attribute", '', @{$self->{global_headers}};
sprintf $self->{num_format}, "Attribute", '', @{$self->global_headers()};
# Underline first line:
# ========= ======= ======= ======= ======= ======= ======= =======
@@ -1105,7 +1054,7 @@ sub make_global_header {
# Hard-coded values aren't ideal but this code rarely changes.
push @lines,
sprintf $self->{num_format},
(map { "=" x $_ } $self->{label_width}),
(map { "=" x $_ } $self->label_width()),
(map { " " x $_ } qw(3)), # no pct column in global header
(map { "=" x $_ } qw(7 7 7 7 7 7 7));
@@ -1123,13 +1072,13 @@ sub make_event_header {
my @lines;
push @lines,
sprintf $self->{num_format}, "Attribute", @{$self->{event_headers}};
sprintf $self->{num_format}, "Attribute", @{$self->event_headers()};
# The numbers 6, 7, 7, etc. are the field widths from make_header().
# Hard-coded values aren't ideal but this code rarely changes.
push @lines,
sprintf $self->{num_format},
map { "=" x $_ } ($self->{label_width}, qw(3 7 7 7 7 7 7 7));
map { "=" x $_ } ($self->label_width(), qw(3 7 7 7 7 7 7 7));
# End result should be like:
# Attribute pct total min max avg 95% stddev median
@@ -1148,7 +1097,7 @@ sub make_label {
if ( $val =~ m/^InnoDB/ ) {
$val =~ s/^InnoDB //;
$val = $val eq 'trx id' ? "InnoDB trxID"
: substr($val, 0, $self->{label_width});
: substr($val, 0, $self->label_width());
}
$val = $val eq 'user' ? 'Users'
@@ -1159,7 +1108,7 @@ sub make_label {
: $val eq 'bytes' ? 'Query size'
: $val eq 'Tmp disk tables' ? 'Tmp disk tbl'
: $val eq 'Tmp table sizes' ? 'Tmp tbl size'
: substr($val, 0, $self->{label_width});
: substr($val, 0, $self->label_width);
return $val;
}
@@ -1177,8 +1126,7 @@ sub bool_percents {
# Does pretty-printing for lists of strings like users, hosts, db.
sub format_string_list {
my ( $self, $attrib, $vals, $class_cnt ) = @_;
my $o = $self->{OptionParser};
my $show_all = $o->get('show-all');
my $show_all = $self->{options}->{show_all};
# Only class result values have unq. So if unq doesn't exist,
# then we've been given global values.
@@ -1318,7 +1266,7 @@ sub pref_sort {
sub tables_report {
my ( $self, @tables ) = @_;
return '' unless @tables;
my $q = $self->{Quoter};
my $q = $self->Quoter();
my $tables = "";
foreach my $db_tbl ( @tables ) {
my ( $db, $tbl ) = @$db_tbl;
@@ -1337,7 +1285,7 @@ sub explain_report {
return '' unless $query;
my $dbh = $self->{dbh};
my $q = $self->{Quoter};
my $q = $self->Quoter();
my $qp = $self->{QueryParser};
return '' unless $dbh && $q && $qp;
@@ -1387,34 +1335,6 @@ sub format_time_range {
return $min && $max ? "$min to $max" : '';
}
sub explain_sparkline {
my ( $self, $query, $db ) = @_;
return unless $query;
my $q = $self->{Quoter};
my $dbh = $self->{dbh};
my $ex = $self->{ExplainAnalyzer};
return unless $dbh && $ex;
if ( $db ) {
PTDEBUG && _d($dbh, "USE", $db);
$dbh->do("USE " . $q->quote($db));
}
my $res = $ex->normalize(
$ex->explain_query(
dbh => $dbh,
query => $query,
)
);
my $sparkline;
if ( $res ) {
$sparkline = $ex->sparkline(explain => $res);
}
return $sparkline;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
lib/ReportFormatter.pm
+140 -71
View File
@@ -56,8 +56,7 @@
# calculated widths.
package ReportFormatter;
use strict;
use warnings FATAL => 'all';
use Mo;
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
@@ -67,7 +66,6 @@ use POSIX qw(ceil);
eval { require Term::ReadKey };
my $have_term = $EVAL_ERROR ? 0 : 1;
# Arguments:
# * underline_header bool: underline headers with =
# * line_prefix scalar: prefix every line with this string
# * line_width scalar: line width in characters or 'auto'
@@ -77,42 +75,106 @@ my $have_term = $EVAL_ERROR ? 0 : 1;
# * column_errors scalar: die or warn on column errors (default warn)
# * truncate_header_side scalar: left or right (default left)
# * strip_whitespace bool: strip leading and trailing whitespace
sub new {
my ( $class, %args ) = @_;
my @required_args = qw();
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my $self = {
underline_header => 1,
line_prefix => '# ',
line_width => 78,
column_spacing => ' ',
extend_right => 0,
truncate_line_mark => '...',
column_errors => 'warn',
truncate_header_side => 'left',
strip_whitespace => 1,
%args, # args above can be overriden, args below cannot
n_cols => 0,
};
# * title scalar: title for the report
has underline_header => (
is => 'ro',
isa => 'Bool',
default => sub { 1 },
);
has line_prefix => (
is => 'ro',
isa => 'Str',
default => sub { '# ' },
);
has line_width => (
is => 'ro',
isa => 'Int',
default => sub { 78 },
);
has column_spacing => (
is => 'ro',
isa => 'Str',
default => sub { ' ' },
);
has extend_right => (
is => 'ro',
isa => 'Bool',
default => sub { '' },
);
has truncate_line_mark => (
is => 'ro',
isa => 'Str',
default => sub { '...' },
);
has column_errors => (
is => 'ro',
isa => 'Str',
default => sub { 'warn' },
);
has truncate_header_side => (
is => 'ro',
isa => 'Str',
default => sub { 'left' },
);
has strip_whitespace => (
is => 'ro',
isa => 'Bool',
default => sub { 1 },
);
has title => (
is => 'rw',
isa => 'Str',
predicate => 'has_title',
);
# Internal
has n_cols => (
is => 'rw',
isa => 'Int',
default => sub { 0 },
init_arg => undef,
);
has cols => (
is => 'ro',
isa => 'ArrayRef',
init_arg => undef,
default => sub { [] },
clearer => 'clear_cols',
);
has lines => (
is => 'ro',
isa => 'ArrayRef',
init_arg => undef,
default => sub { [] },
clearer => 'clear_lines',
);
has truncate_headers => (
is => 'rw',
isa => 'Bool',
default => sub { undef },
init_arg => undef,
clearer => 'clear_truncate_headers',
);
sub BUILDARGS {
my $class = shift;
my $args = $class->SUPER::BUILDARGS(@_);
# This is not tested or currently used, but I like the idea and
# think one day it will be very handy in mk-config-diff.
if ( ($self->{line_width} || '') eq 'auto' ) {
# think one day it will be very handy in pt-config-diff.
if ( ($args->{line_width} || '') eq 'auto' ) {
die "Cannot auto-detect line width because the Term::ReadKey module "
. "is not installed" unless $have_term;
($self->{line_width}) = GetTerminalSize();
($args->{line_width}) = GetTerminalSize();
PTDEBUG && _d('Line width:', $args->{line_width});
}
PTDEBUG && _d('Line width:', $self->{line_width});
return bless $self, $class;
}
sub set_title {
my ( $self, $title ) = @_;
$self->{title} = $title;
return;
return $args;
}
# @cols is an array of hashrefs. Each hashref describes a column and can
@@ -139,7 +201,7 @@ sub set_columns {
die "Column does not have a name" unless defined $col_name;
if ( $col->{width} ) {
$col->{width_pct} = ceil(($col->{width} * 100) / $self->{line_width});
$col->{width_pct} = ceil(($col->{width} * 100) / $self->line_width());
PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =',
$col->{width_pct}, '%');
}
@@ -172,10 +234,10 @@ sub set_columns {
# Used with extend_right.
$col->{right_most} = 1 if $i == $#cols;
push @{$self->{cols}}, $col;
push @{$self->cols}, $col;
}
$self->{n_cols} = scalar @cols;
$self->n_cols( scalar @cols );
if ( ($used_width || 0) > 100 ) {
die "Total width_pct for all columns is >100%";
@@ -186,16 +248,16 @@ sub set_columns {
my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols);
PTDEBUG && _d('Line width left:', (100-$used_width), '%;',
'each auto width col:', $wid_per_col, '%');
map { $self->{cols}->[$_]->{width_pct} = $wid_per_col } @auto_width_cols;
map { $self->cols->[$_]->{width_pct} = $wid_per_col } @auto_width_cols;
}
# Add to the minimum possible header width the spacing between columns.
$min_hdr_wid += ($self->{n_cols} - 1) * length $self->{column_spacing};
$min_hdr_wid += ($self->n_cols() - 1) * length $self->column_spacing();
PTDEBUG && _d('min header width:', $min_hdr_wid);
if ( $min_hdr_wid > $self->{line_width} ) {
if ( $min_hdr_wid > $self->line_width() ) {
PTDEBUG && _d('Will truncate headers because min header width',
$min_hdr_wid, '> line width', $self->{line_width});
$self->{truncate_headers} = 1;
$min_hdr_wid, '> line width', $self->line_width());
$self->truncate_headers(1);
}
return;
@@ -207,14 +269,14 @@ sub set_columns {
sub add_line {
my ( $self, @vals ) = @_;
my $n_vals = scalar @vals;
if ( $n_vals != $self->{n_cols} ) {
if ( $n_vals != $self->n_cols() ) {
$self->_column_error("Number of values $n_vals does not match "
. "number of columns $self->{n_cols}");
. "number of columns " . $self->n_cols());
}
for my $i ( 0..($n_vals-1) ) {
my $col = $self->{cols}->[$i];
my $col = $self->cols->[$i];
my $val = defined $vals[$i] ? $vals[$i] : $col->{undef_value};
if ( $self->{strip_whitespace} ) {
if ( $self->strip_whitespace() ) {
$val =~ s/^\s+//g;
$val =~ s/\s+$//;
$vals[$i] = $val;
@@ -223,7 +285,7 @@ sub add_line {
$col->{min_val} = min($width, ($col->{min_val} || $width));
$col->{max_val} = max($width, ($col->{max_val} || $width));
}
push @{$self->{lines}}, \@vals;
push @{$self->lines}, \@vals;
return;
}
@@ -232,12 +294,14 @@ sub get_report {
my ( $self, %args ) = @_;
$self->_calculate_column_widths();
$self->_truncate_headers() if $self->{truncate_headers};
if ( $self->truncate_headers() ) {
$self->_truncate_headers();
}
$self->_truncate_line_values(%args);
my @col_fmts = $self->_make_column_formats();
my $fmt = ($self->{line_prefix} || '')
. join($self->{column_spacing}, @col_fmts);
my $fmt = $self->line_prefix()
. join($self->column_spacing(), @col_fmts);
PTDEBUG && _d('Format:', $fmt);
# Make the printf line format for the header and ensure that its labels
@@ -246,15 +310,15 @@ sub get_report {
# Build the report line by line, starting with the title and header lines.
my @lines;
push @lines, sprintf "$self->{line_prefix}$self->{title}" if $self->{title};
push @lines, $self->line_prefix() . $self->title() if $self->has_title();
push @lines, $self->_truncate_line(
sprintf($hdr_fmt, map { $_->{name} } @{$self->{cols}}),
sprintf($hdr_fmt, map { $_->{name} } @{$self->cols}),
strip => 1,
mark => '',
);
if ( $self->{underline_header} ) {
my @underlines = map { '=' x $_->{print_width} } @{$self->{cols}};
if ( $self->underline_header() ) {
my @underlines = map { '=' x $_->{print_width} } @{$self->cols};
push @lines, $self->_truncate_line(
sprintf($fmt, map { $_ || '' } @underlines),
mark => '',
@@ -265,19 +329,24 @@ sub get_report {
my $vals = $_;
my $i = 0;
my @vals = map {
my $val = defined $_ ? $_ : $self->{cols}->[$i++]->{undef_value};
my $val = defined $_ ? $_ : $self->cols->[$i++]->{undef_value};
$val = '' if !defined $val;
$val =~ s/\n/ /g;
$val;
} @$vals;
my $line = sprintf($fmt, @vals);
if ( $self->{extend_right} ) {
if ( $self->extend_right() ) {
$line;
}
else {
$self->_truncate_line($line);
}
} @{$self->{lines}};
} @{$self->lines};
# Clean up any leftover state
$self->clear_cols();
$self->clear_lines();
$self->clear_truncate_headers();
return join("\n", @lines) . "\n";
}
@@ -285,7 +354,7 @@ sub get_report {
sub truncate_value {
my ( $self, $col, $val, $width, $side ) = @_;
return $val if length $val <= $width;
return $val if $col->{right_most} && $self->{extend_right};
return $val if $col->{right_most} && $self->extend_right();
$side ||= $col->{truncate_side};
my $mark = $col->{truncate_mark};
if ( $side eq 'right' ) {
@@ -305,8 +374,8 @@ sub _calculate_column_widths {
my ( $self ) = @_;
my $extra_space = 0;
foreach my $col ( @{$self->{cols}} ) {
my $print_width = int($self->{line_width} * ($col->{width_pct} / 100));
foreach my $col ( @{$self->cols} ) {
my $print_width = int($self->line_width() * ($col->{width_pct} / 100));
PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct},
'char width:', $print_width,
@@ -330,7 +399,7 @@ sub _calculate_column_widths {
PTDEBUG && _d('Extra space:', $extra_space);
while ( $extra_space-- ) {
foreach my $col ( @{$self->{cols}} ) {
foreach my $col ( @{$self->cols} ) {
if ( $col->{auto_width}
&& ( $col->{print_width} < $col->{max_val}
|| $col->{print_width} < $col->{header_width})
@@ -346,8 +415,8 @@ sub _calculate_column_widths {
sub _truncate_headers {
my ( $self, $col ) = @_;
my $side = $self->{truncate_header_side};
foreach my $col ( @{$self->{cols}} ) {
my $side = $self->truncate_header_side();
foreach my $col ( @{$self->cols} ) {
my $col_name = $col->{name};
my $print_width = $col->{print_width};
next if length $col_name <= $print_width;
@@ -360,10 +429,10 @@ sub _truncate_headers {
sub _truncate_line_values {
my ( $self, %args ) = @_;
my $n_vals = $self->{n_cols} - 1;
foreach my $vals ( @{$self->{lines}} ) {
my $n_vals = $self->n_cols() - 1;
foreach my $vals ( @{$self->lines} ) {
for my $i ( 0..$n_vals ) {
my $col = $self->{cols}->[$i];
my $col = $self->cols->[$i];
my $val = defined $vals->[$i] ? $vals->[$i] : $col->{undef_value};
my $width = length $val;
@@ -393,9 +462,9 @@ sub _truncate_line_values {
sub _make_column_formats {
my ( $self ) = @_;
my @col_fmts;
my $n_cols = $self->{n_cols} - 1;
my $n_cols = $self->n_cols() - 1;
for my $i ( 0..$n_cols ) {
my $col = $self->{cols}->[$i];
my $col = $self->cols->[$i];
# Normally right-most col has no width so it can potentially
# extend_right. But if it's right-justified, it requires a width.
@@ -410,12 +479,12 @@ sub _make_column_formats {
sub _truncate_line {
my ( $self, $line, %args ) = @_;
my $mark = defined $args{mark} ? $args{mark} : $self->{truncate_line_mark};
my $mark = defined $args{mark} ? $args{mark} : $self->truncate_line_mark();
if ( $line ) {
$line =~ s/\s+$// if $args{strip};
my $len = length($line);
if ( $len > $self->{line_width} ) {
$line = substr($line, 0, $self->{line_width} - length $mark);
if ( $len > $self->line_width() ) {
$line = substr($line, 0, $self->line_width() - length $mark);
$line .= $mark if $mark;
}
}
@@ -425,7 +494,7 @@ sub _truncate_line {
sub _column_error {
my ( $self, $err ) = @_;
my $msg = "Column error: $err";
$self->{column_errors} eq 'die' ? die $msg : warn $msg;
$self->column_errors() eq 'die' ? die $msg : warn $msg;
return;
}
lib/Transformers.pm
+20 -18
View File
@@ -31,24 +31,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+)?/;