Author: tim.bunce
Date: Wed Nov 19 02:06:20 2008
New Revision: 611
Modified:
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/lib/Devel/NYTProf/Reader.pm
Log:
Rework handling of filename, specifically don't call
make_filenames_relative() to edit them to be relative.
Add abs_filename method to abstract search @INC.
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Wed Nov 19 02:06:20 2008
@@ -608,6 +608,9 @@
my ($t_stmt_exec, $t_stmt_time) = (0,0);
foreach my $filestats (sort { $b->{'time'} <=> $a->{'time'} }
values %$stats) {
+ my $fi = $profile->fileinfo_of($filestats->{filename})
+ or die "Can't find fileinfo for $filestats->{filename}";
+
print OUT qq{<tr class="index">};
print OUT determine_severity($filestats->{'calls'}, undef, 0,
@@ -630,11 +633,8 @@
} qw(line block sub);
print OUT "<td>$rep_links</td>";
- my $filename = $filestats->{filename};
- my $fid = $profile->resolve_fid($filename) or warn "Can't find fid
for $_";
- (my $shortname = $filename) =~ s/$inc_path_regex//;
- print OUT sprintf q{<td><a name="f%s" title="%s">%s</a></td>},
$fid, $filename,
- $shortname;
+ print OUT sprintf q{<td><a name="f%s" title="%s">%s</a></td>},
+ $fi->fid, $fi->abs_filename, $fi->filename_without_inc;
print OUT "</tr>\n";
}
if ($add_totals) {
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Wed Nov 19 02:06:20 2008
@@ -127,34 +127,44 @@
return;
}
-sub srclines_array {
+sub abs_filename {
my $self = shift;
- my $profile = $self->profile;
- #warn Dumper($profile->{fid_srclines});
- my $fid = $self->fid;
- if (my $srclines = $profile->{fid_srclines}[ $fid ]) {
- my $copy = [ @$srclines ]; # shallow clone
- shift @$copy; # line 0 not used
- return $copy;
- }
- # open file
+
my $filename = $self->filename;
+
# if it's a .pmc then assume that's the file we want to look at
# (because the main use for .pmc's are related to perl6)
$filename .= "c" if $self->is_pmc;
- # search @INC if filename is not absolute
+ # search profile @INC if filename is not absolute
my @files = ($filename);
if ($filename !~ m/^\//) {
- @files = map { "$_/$filename" } @INC;
+ my @inc = $self->profile->inc;
+ @files = map { "$_/$filename" } @inc;
}
+
for my $file (@files) {
- open my $fh, "<", $file
- or next;
- return [ <$fh> ];
+ return $file if -f $file;
}
-
return undef;
+}
+
+sub srclines_array {
+ my $self = shift;
+ my $profile = $self->profile;
+ #warn Dumper($profile->{fid_srclines});
+
+ my $fid = $self->fid;
+ if (my $srclines = $profile->{fid_srclines}[ $fid ]) {
+ my $copy = [ @$srclines ]; # shallow clone
+ shift @$copy; # line 0 not used
+ return $copy;
+ }
+
+ my $filename = $self->abs_filename;
+ open my $fh, "<", $filename
+ or return undef;
+ return [ <$fh> ];
}
1;
Modified: trunk/lib/Devel/NYTProf/Reader.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/lib/Devel/NYTProf/Reader.pm Wed Nov 19 02:06:20 2008
@@ -112,8 +112,6 @@
bless($self, $class);
$self->{profile} = Devel::NYTProf::Data->new({filename =>
$self->{file}});
- $self->{profile}->make_filenames_relative();
-
# a hack for testing/debugging
exit $ENV{NYTPROF_EXIT_AFTER_LOAD} if defined
$ENV{NYTPROF_EXIT_AFTER_LOAD};
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
