Revision: 1276
Author: [email protected]
Date: Mon Jun 7 07:15:27 2010
Log: Replate $trace env var hack with new trace_level function.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1276
Modified:
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/Reader.pm
/trunk/lib/Devel/NYTProf/SubInfo.pm
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Sat Jun 5 15:40:22 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Mon Jun 7 07:15:27 2010
@@ -50,11 +50,13 @@
use Devel::NYTProf::Core;
use Devel::NYTProf::FileInfo;
use Devel::NYTProf::SubInfo;
-use Devel::NYTProf::Util qw(make_path_strip_editor strip_prefix_from_paths
get_abs_paths_alternation_regex);
+use Devel::NYTProf::Util qw(
+ make_path_strip_editor strip_prefix_from_paths
get_abs_paths_alternation_regex
+ trace_level
+);
our $VERSION = '4.00';
-my $trace = (($ENV{NYTPROF}||'') =~ m/\b trace=(\d+) /x) && $1; # XXX a
hack
=head2 new
@@ -154,7 +156,7 @@
push @{$src_keyed{$key}}, $fi;
}
- if ($trace >= 1) {
+ if (trace_level() >= 1) {
my @subs = map { $_->subs_defined } @$siblings;
my @evals = map { $_->has_evals(0) } @$siblings;
warn sprintf "%d:%d: has %d sibling evals (subs %d, evals %d,
keys %d) in %s; fids: %s\n",
@@ -177,10 +179,10 @@
my @fids = map { $_->fid } @$src_same_fis;
if (grep { $_->has_evals(0) } @$src_same_fis) {
- warn "evals($key): collapsing skipped due to evals in
@fids\n" if $trace >= 3;
+ warn "evals($key): collapsing skipped due to evals in
@fids\n" if trace_level() >= 3;
}
else {
- warn "evals($key): collapsing identical: @fids\n" if
$trace >= 3;
+ warn "evals($key): collapsing identical: @fids\n" if
trace_level() >= 3;
my $fi =
$parent_fi->collapse_sibling_evals(@$src_same_fis);
@$src_same_fis = ( $fi ); # update list in-place
}
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Sat Jun 5 15:40:22 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Mon Jun 7 07:15:27 2010
@@ -5,7 +5,7 @@
use Carp;
use List::Util qw(sum max);
-use Devel::NYTProf::Util qw(strip_prefix_from_paths);
+use Devel::NYTProf::Util qw(strip_prefix_from_paths trace_level);
use Devel::NYTProf::Constants qw(
NYTP_FIDf_HAS_SRC NYTP_FIDf_SAVE_SRC NYTP_FIDf_IS_FAKE NYTP_FIDf_IS_PMC
@@ -25,8 +25,6 @@
NYTP_FIDi_cache => NYTP_FIDi_elements + 2,
};
-my $trace = (($ENV{NYTPROF}||'') =~ m/\b trace=(\d+) /x) && $1; # XXX a
hack
-
sub filename { shift->[NYTP_FIDi_FILENAME()] }
sub eval_fid { shift->[NYTP_FIDi_EVAL_FID()] }
sub eval_line { shift->[NYTP_FIDi_EVAL_LINE()] }
@@ -272,7 +270,7 @@
# copy data from donor to survivor_fi then delete donor
warn sprintf "collapse_sibling_evals: processing donor
fid %d: %s\n",
$donor_fi->fid, $donor_fi->filename
- if $trace;
+ if trace_level();
# XXX nested evals not handled yet
warn sprintf "collapse_sibling_evals: nested evals in %s not
handled",
@@ -284,10 +282,10 @@
for my $si (@subs_defined) {
warn sprintf " - moving from fid %d: sub %s\n",
$donor_fi->fid, $si->subname
- if $trace;
+ if trace_level();
$si->_alter_fileinfo($donor_fi, $survivor_fi);
warn sprintf " - moving done\n"
- if $trace;
+ if trace_level();
}
}
@@ -359,7 +357,7 @@
warn sprintf "collapse_sibling_evals: merging %d subs
into %s: %s\n",
scalar @$to_merge, $survivor_subname,
join ", ", map { $_->subname } @$to_merge
- if $trace;
+ if trace_level();
for my $delete_si (@$to_merge) {
my $delete_subname = $delete_si->subname;
@@ -389,7 +387,7 @@
}
warn sprintf "collapse_sibling_evals done\n"
- if $trace;
+ if trace_level();
return $survivor_fi;
}
=======================================
--- /trunk/lib/Devel/NYTProf/Reader.pm Sun May 30 04:24:31 2010
+++ /trunk/lib/Devel/NYTProf/Reader.pm Mon Jun 7 07:15:27 2010
@@ -28,6 +28,7 @@
strip_prefix_from_paths
html_safe_filename
calculate_median_absolute_deviation
+ trace_level
);
# These control the limits for what the script will consider ok to severe
times
@@ -36,7 +37,6 @@
use constant SEVERITY_BAD => 1.0;
use constant SEVERITY_GOOD => 0.5; # within this deviation, okay
-my $trace = 0;
# Static class variables
our $FLOAT_FORMAT = $Config{nvfformat};
@@ -222,7 +222,7 @@
warn sprintf "%s %s max lines: stmts %d, subcalls %d, subdefs %d,
evals %d\n",
$filestr, $LEVEL, scalar @$lines_array,
$subcalls_max_line, $subdefs_max_line, $evals_max_line
- if $trace;
+ if trace_level();
my %stats_accum; # holds all line times. used to find
median
my %stats_by_line; # holds individual line stats
@@ -286,7 +286,7 @@
}
warn "$linenum: @{[ %{ $stats_by_line{$linenum} } ]}\n"
- if $trace >= 3 && $stats_by_line{$linenum};
+ if trace_level() >= 3 && $stats_by_line{$linenum};
}
warn "unprocessed keys in subdefs_at_line: @{[
keys %$subdefs_at_line ]}\n"
@@ -384,7 +384,7 @@
if (my $z = $stats_by_line{0}) {
# typically indicates cases where we could do better
- if ($trace) {
+ if (trace_level()) {
warn "$filestr has unexpected info for line 0: @{[ %$z
]}\n";
# sub defs: used to be xsubs but they're handled
separately now
# so there are no known causes of this any more
=======================================
--- /trunk/lib/Devel/NYTProf/SubInfo.pm Sat Jun 5 15:40:22 2010
+++ /trunk/lib/Devel/NYTProf/SubInfo.pm Mon Jun 7 07:15:27 2010
@@ -7,6 +7,9 @@
use List::Util qw(sum min max);
use Data::Dumper;
+use Devel::NYTProf::Util qw(
+ trace_level
+);
use Devel::NYTProf::Constants qw(
NYTP_SIi_FID NYTP_SIi_FIRST_LINE NYTP_SIi_LAST_LINE
NYTP_SIi_CALL_COUNT NYTP_SIi_INCL_RTIME NYTP_SIi_EXCL_RTIME
@@ -27,8 +30,6 @@
};
-my $trace = (($ENV{NYTPROF}||'') =~ m/\b trace=(\d+) /x) && $1; # XXX a
hack
-
sub fid { shift->[NYTP_SIi_FID] || 0 }
sub first_line { shift->[NYTP_SIi_FIRST_LINE] }
@@ -185,7 +186,7 @@
warn sprintf "Altering %s to change calls from fid %d to be
from fid %d\n",
$self->subname, $remove_fid, $new_fid
- if $trace;
+ if trace_level();
if (my $new_cb = $called_by->{$new_fid}) {
# need to merge $cb into $new_cb
@@ -216,7 +217,7 @@
warn sprintf "Merging sub %s into %s (%s)\n",
$donor_subname, $self_subname, join(" ", %opts)
- if $trace;
+ if trace_level();
# see also "case NYTP_TAG_SUB_CALLERS:" in
load_profile_data_from_stream()
push @{ $self->meta->{merged_sub_names} }, $donor->subname;
@@ -257,7 +258,7 @@
if (!...@$src_line_info) {
carp sprintf "_merge_in_caller_info%s skipped (empty donor)", $tag
- if $trace;
+ if trace_level();
return;
}
if (!...@$dst_line_info) {
@@ -265,7 +266,7 @@
$dst_line_info->[NYTP_SCi_CALLING_SUB] = undef;
}
- if ($trace) {
+ if (trace_level()) {
carp sprintf "_merge_in_caller_info%s merging:", $tag;
warn sprintf " . %s\n", fmt_sc($src_line_info);
warn sprintf " + %s\n", fmt_sc($dst_line_info);
@@ -286,7 +287,7 @@
$dst_cs->{$_} = $src_cs->{$_} for keys %$src_cs;
warn sprintf " = %s\n", fmt_sc($dst_line_info)
- if $trace;
+ if trace_level();
@$src_line_info = (); # zap!
--
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]
