1# vim: ts=8 sw=4 expandtab: 2########################################################## 3# This script is part of the Devel::NYTProf distribution 4# 5# Copyright, contact and other information can be found 6# at the bottom of this file, or by going to: 7# http://metacpan.org/release/Devel-NYTProf/ 8# 9########################################################### 10package Devel::NYTProf::Data; 11 12=head1 NAME 13 14Devel::NYTProf::Data - L<Devel::NYTProf> data loading and manipulation 15 16=head1 SYNOPSIS 17 18 use Devel::NYTProf::Data; 19 20 $profile = Devel::NYTProf::Data->new( { filename => 'nytprof.out' } ); 21 22 $profile->dump_profile_data(); 23 24=head1 DESCRIPTION 25 26Reads a profile data file written by L<Devel::NYTProf>, aggregates the 27contents, and returns the results as a blessed data structure. 28 29Access to the data should be via methods in this class to avoid breaking 30encapsulation (and thus breaking your code when the data structures change in 31future versions). 32 33B<NOTE> the documentation is out of date and may not be updated soon. 34It's also likely that the API will change drastically in future. 35It's possible, for example, that the data model will switch to use SQLite 36and the http://metacpan.org/pod/ORLite ORM. 37 38Let me know if you come to depend on a particular API and I'll try to preserve 39it if practical. 40 41=head1 METHODS 42 43=cut 44 45 46use warnings; 47use strict; 48 49use Carp qw(carp croak cluck); 50use Cwd qw(getcwd); 51use Scalar::Util qw(blessed); 52 53use Devel::NYTProf::Core; 54use Devel::NYTProf::FileInfo; 55use Devel::NYTProf::SubInfo; 56use Devel::NYTProf::Util qw( trace_level _dumper ); 57 58our $VERSION = '6.10'; 59 60 61=head2 new 62 63 $profile = Devel::NYTProf::Data->new( ); 64 65 $profile = Devel::NYTProf::Data->new( { 66 filename => 'nytprof.out', # default 67 quiet => 0, # default, 1 to silence message 68 } ); 69 70Reads the specified file containing profile data written by L<Devel::NYTProf>, 71aggregates the contents, and returns the results as a blessed data structure. 72 73=cut 74 75 76sub new { 77 my $class = shift; 78 my $args = shift || { }; 79 80 my $file = $args->{filename} ||= 'nytprof.out'; 81 croak "Devel::NYTProf::new() could not locate file for processing" 82 unless -f $file; 83 84 print "Reading $file\n" unless $args->{quiet}; 85 86 my $profile = load_profile_data_from_file( 87 $file, 88 $args->{callback}, 89 ); 90 91 return undef if $args->{callback}; 92 93 print "Processing $file data\n" unless $args->{quiet}; 94 95 bless $profile => $class; 96 97 my $fid_fileinfo = $profile->{fid_fileinfo}; 98 my $sub_subinfo = $profile->{sub_subinfo}; 99 100 # add profile ref so fidinfo & subinfo objects 101 # XXX circular ref, add weaken 102 for (@$fid_fileinfo) { $_ and $_->[7] = $profile; } 103 $_->[7] = $profile for values %$sub_subinfo; 104 105 # bless sub_subinfo data 106 (my $sub_class = $class) =~ s/\w+$/SubInfo/; 107 $_ and bless $_ => $sub_class for values %$sub_subinfo; 108 109 # create profiler_active attribute by subtracting from profiler_duration 110 # currently we only subtract cumulative_overhead_ticks 111 my $attribute = $profile->{attribute}; 112 my $overhead_time = $attribute->{cumulative_overhead_ticks} / $attribute->{ticks_per_sec}; 113 $attribute->{profiler_active} = $attribute->{profiler_duration} - $overhead_time; 114 115 # find subs that have calls but no fid 116 my @homeless_subs = grep { $_->calls and not $_->fid } values %$sub_subinfo; 117 if (@homeless_subs) { # give them a home... 118 # currently just the first existing fileinfo 119 # XXX ought to create a new dummy fileinfo for them 120 my $new_fi = $profile->fileinfo_of(1); 121 $_->_alter_fileinfo(undef, $new_fi) for @homeless_subs; 122 } 123 124 125 # Where a given eval() has been invoked more than once 126 # rollup the corresponding fids if they're "uninteresting". 127 if (not $args->{skip_collapse_evals}) { 128 for my $fi ($profile->noneval_fileinfos) { 129 $profile->collapse_evals_in($fi); 130 } 131 } 132 133 $profile->_clear_caches; 134 135 # a hack for testing/debugging 136 # $ENV{NYTPROF_ONLOAD} must be a colon-delimited string of 137 # equal-sign-delimited substrings, e.g., 138 # 'alpha=beta:gamma=delta:dump=1:exit=1'; 139 140 if (my $env = $ENV{NYTPROF_ONLOAD}) { 141 my %onload = map { split /=/, $_, 2 } split /:/, $env, -1; 142 warn _dumper($profile) if $onload{dump}; 143 exit $onload{exit} if defined $onload{exit}; 144 } 145 146 return $profile; 147} 148 149 150sub collapse_evals_in { 151 my ($profile, $parent_fi) = @_; 152 my $parent_fid = $parent_fi->fid; 153 154 my %evals_on_line; 155 for my $fi ($parent_fi->has_evals) { 156 $profile->collapse_evals_in($fi); # recurse first 157 push @{ $evals_on_line{$fi->eval_line} }, $fi; 158 } 159 160 while ( my ($line, $siblings) = each %evals_on_line) { 161 162 next if @$siblings == 1; 163 164 # compare src code of evals and collapse identical ones 165 my %src_keyed; 166 for my $fi (@$siblings) { 167 my $key = $fi->src_digest; 168 if (!$key) { # include extra info to segregate when there's no src 169 $key .= ',evals' if $fi->has_evals; 170 $key .= ',subs' if $fi->subs_defined; 171 } 172 push @{$src_keyed{$key}}, $fi; 173 } 174 175 if (trace_level() >= 2) { 176 my @subs = map { $_->subs_defined } @$siblings; 177 my @evals = map { $_->has_evals(0) } @$siblings; 178 warn sprintf "%d:%d: has %d sibling evals (subs %d, evals %d, keys %d) in %s; fids: %s\n", 179 $parent_fid, $line, scalar @$siblings, scalar @subs, scalar @evals, 180 scalar keys %src_keyed, 181 $parent_fi->filename, 182 join(" ", map { $_->fid } @$siblings); 183 184 for my $si (@subs) { 185 warn sprintf "%d:%d evals: define sub %s in fid %s\n", 186 $parent_fid, $line, $si->subname, $si->fid; 187 } 188 for my $fi (@evals) { 189 warn sprintf "%d:%d evals: execute eval %s\n", 190 $parent_fid, $line, $fi->filename; 191 } 192 193 } 194 195 # if 'too many' distinct eval source keys then simply collapse all 196 my $max_evals_siblings = $ENV{NYTPROF_MAX_EVAL_SIBLINGS} || 200; 197 if (values %src_keyed > $max_evals_siblings) { 198 $parent_fi->collapse_sibling_evals(@$siblings); 199 } 200 else { 201 # finesse: consider each distinct src in turn 202 203 while ( my ($key, $src_same_fis) = each %src_keyed ) { 204 next if @$src_same_fis == 1; # unique src key 205 my @fids = map { $_->fid } @$src_same_fis; 206 207 if (grep { $_->has_evals(0) } @$src_same_fis) { 208 warn "evals($key): collapsing skipped due to evals in @fids\n" if trace_level() >= 3; 209 } 210 else { 211 warn "evals($key): collapsing identical: @fids\n" if trace_level() >= 3; 212 my $fi = $parent_fi->collapse_sibling_evals(@$src_same_fis); 213 @$src_same_fis = ( $fi ); # update list in-place 214 } 215 } 216 } 217 } 218 return 1; 219} 220 221sub _caches { return shift->{caches} ||= {} } 222sub _clear_caches { return delete shift->{caches} } 223 224sub attributes { 225 return shift->{attribute} || {}; 226} 227 228sub options { 229 return shift->{option} || {}; 230} 231 232sub subname_subinfo_map { 233 return { %{ shift->{sub_subinfo} } }; # shallow copy 234} 235 236sub _disconnect_subinfo { 237 my ($self, $si) = @_; 238 my $subname = $si->subname; 239 my $si2 = delete $self->{sub_subinfo}{$subname}; 240 # sanity check 241 carp sprintf "disconnect_subinfo: deleted entry %s %s doesn't match argument %s %s", 242 ($si2) ? ($si2, $si2->subname) : ('undef', 'undef'), 243 $si, $subname 244 if $si2 != $si or $si2->subname ne $subname; 245 # do more? 246} 247 248 249# package_tree_subinfo_map is like package_subinfo_map but returns 250# nested data instead of flattened. 251# for "Foo::Bar::Baz" package: 252# { Foo => { '' => [...], '::Bar' => { ''=>[...], '::Baz'=>[...] } } } 253# if merged is true then array contains a single 'merged' subinfo 254sub package_subinfo_map { 255 my $self = shift; 256 my ($merge_subs, $nested_pkgs) = @_; 257 258 my %pkg; 259 my %to_merge; 260 261 my $all_subs = $self->subname_subinfo_map; 262 while ( my ($name, $subinfo) = each %$all_subs ) { 263 $name =~ s/^(.*::).*/$1/; # XXX $subinfo->package 264 my $subinfos; 265 if ($nested_pkgs) { 266 my @parts = split /::/, $name; 267 my $node = $pkg{ shift @parts } ||= {}; 268 # TODO: Need to figure out how to provide a multi-part name, e.g., 'alpha::beta' 269 # Otherwise @parts is now empty and so next line is not exercised 270 # during testing. 271 $node = $node->{ shift @parts } ||= {} while @parts; 272 $subinfos = $node->{''} ||= []; 273 } 274 else { 275 $subinfos = $pkg{$name} ||= []; 276 } 277 push @$subinfos, $subinfo; 278 $to_merge{$subinfos} = $subinfos if $merge_subs; 279 } 280 281 for my $subinfos (values %to_merge) { 282 my $subinfo = shift(@$subinfos)->clone; 283 $subinfo->merge_in($_, src_keep => 1) 284 for @$subinfos; 285 # replace the many with the one 286 @$subinfos = ($subinfo); 287 } 288 289 return \%pkg; 290} 291 292sub all_fileinfos { 293 my @all = @{shift->{fid_fileinfo}}; 294 shift @all; # drop fid 0 295 # return all non-nullified fileinfos 296 return grep { $_->fid } @all; 297} 298 299sub eval_fileinfos { 300 return grep { $_->eval_line } shift->all_fileinfos; 301} 302 303sub noneval_fileinfos { 304 return grep { !$_->eval_line } shift->all_fileinfos; 305} 306 307 308sub fileinfo_of { 309 my ($self, $arg, $silent_if_undef) = @_; 310 311 if (not defined $arg) { 312 carp "Can't resolve fid of undef value" unless $silent_if_undef; 313 return undef; 314 } 315 316 # check if already a file info object 317 return $arg if ref $arg and UNIVERSAL::can($arg,'fid') and $arg->isa('Devel::NYTProf::FileInfo'); 318 319 my $fid = $self->resolve_fid($arg); 320 if (not $fid) { 321 carp "Can't resolve fid of '$arg'"; 322 return undef; 323 } 324 325 my $fi = $self->{fid_fileinfo}[$fid]; 326 return undef unless defined $fi->fid; # nullified? 327 return $fi; 328} 329 330 331sub subinfo_of { 332 my ($self, $subname) = @_; 333 334 if (not defined $subname) { 335 cluck "Can't resolve subinfo of undef value"; 336 return undef; 337 } 338 339 my $si = $self->{sub_subinfo}{$subname} 340 or cluck "Can't resolve subinfo of '$subname'"; 341 342 return $si; 343} 344 345 346sub inc { 347 348 # XXX should return inc from profile data, when it's there 349 return @INC; 350} 351 352=head2 dump_profile_data 353 354 $profile->dump_profile_data; 355 $profile->dump_profile_data( { 356 filehandle => \*STDOUT, 357 separator => "", 358 } ); 359 360Writes the profile data in a reasonably human friendly format to the specified 361C<filehandle> (default STDOUT). 362 363For non-trivial profiles the output can be very large. As a guide, there'll be 364at least one line of output for each line of code executed, plus one for each 365place a subroutine was called from, plus one per subroutine. 366 367The default format is a Data::Dumper style whitespace-indented tree. 368The types of data present can depend on the options used when profiling. 369 370If C<separator> is true then instead of whitespace, each item of data is 371indented with the I<path> through the structure with C<separator> used to 372separate the elements of the path. 373This format is especially useful for grep'ing and diff'ing. 374 375=cut 376 377 378sub dump_profile_data { 379 my $self = shift; 380 my $args = shift || {}; 381 my $separator = $args->{separator} || ''; 382 my $filehandle = $args->{filehandle} || \*STDOUT; 383 384 # shallow clone and add sub_caller for migration of tests 385 my $startnode = $self; 386 387 $self->_clear_caches; 388 389 my $callback = sub { 390 my ($path, $value) = @_; 391 392 # not needed currently 393 #if ($path->[0] eq 'attribute' && @$path == 1) { my %v = %$value; return ({}, \%v); } 394 395 if (my $hook = $args->{skip_fileinfo_hook}) { 396 397 # for fid_fileinfo elements... 398 if ($path->[0] eq 'fid_fileinfo' && @$path==2) { 399 my $fi = $value; 400 401 # skip nullified fileinfo 402 return undef unless $fi->fid; 403 404 # don't dump internal details of lib modules 405 return ({ skip_internal_details => scalar $hook->($fi, $path, $value) }, $value); 406 } 407 408 # skip sub_subinfo data for 'library modules' 409 if ($path->[0] eq 'sub_subinfo' && @$path==2 && $value->[0]) { 410 my $fi = $self->fileinfo_of($value->[0]); 411 return undef if !$fi or $hook->($fi, $path, $value); 412 } 413 414 # skip fid_*_time data for 'library modules' 415 if ($path->[0] =~ /^fid_\w+_time$/ && @$path==2) { 416 my $fi = $self->fileinfo_of($path->[1]); 417 return undef if !$fi or $hook->($fi, $path, $value); 418 } 419 } 420 return ({}, $value); 421 }; 422 423 _dump_elements($startnode, $separator, $filehandle, [], $callback); 424} 425 426 427sub _dump_elements { 428 my ($r, $separator, $fh, $path, $callback) = @_; 429 my $pad = " "; 430 my $padN; 431 432 my $is_hash = (UNIVERSAL::isa($r, 'HASH')); 433 my ($start, $end, $colon, $keys) = 434 ($is_hash) 435 ? ('{', '}', ' => ', [sort keys %$r]) 436 : ('[', ']', ': ', [0 .. @$r - 1]); 437 438 if ($separator) { 439 ($start, $end, $colon) = (undef, undef, $separator); 440 $padN = join $separator, @$path, ''; 441 } 442 else { 443 $padN = $pad x (@$path + 1); 444 } 445 446 my $format = {sub_subinfo => {compact => 1},}; 447 448 print $fh "$start\n" if $start; 449 my $key1 = $path->[0] || $keys->[0]; 450 for my $key (@$keys) { 451 452 next if $key eq 'fid_srclines'; 453 454 my $value = ($is_hash) ? $r->{$key} : $r->[$key]; 455 456 # skip undef elements in array 457 next if !$is_hash && !defined($value); 458 # skip refs to empty arrays in array 459 next if !$is_hash && ref $value eq 'ARRAY' && !@$value; 460 461 my $dump_opts = {}; 462 if ($callback) { 463 ($dump_opts, $value) = $callback->([ @$path, $key ], $value); 464 next if not $dump_opts; 465 } 466 467 my $prefix = "$padN$key$colon"; 468 469 if (UNIVERSAL::can($value,'dump')) { 470 $value->dump($separator, $fh, [ @$path, $key ], $prefix, $dump_opts); 471 } 472 else { 473 474 # special case some common cases to be more compact: 475 # fid_*_time [fid][line] = [N,N] 476 # sub_subinfo {subname} = [fid,startline,endline,calls,incl_time] 477 my $as_compact = $format->{$key1}{compact}; 478 if (not defined $as_compact) { # so guess... 479 $as_compact = 480 (UNIVERSAL::isa($value, 'ARRAY') && @$value <= 9 && !grep { ref or !defined } 481 @$value); 482 } 483 $as_compact = 0 if not ref $value eq 'ARRAY'; 484 485 if ($as_compact) { 486 no warnings qw(uninitialized); 487 printf $fh "%s[ %s ]\n", $prefix, join(" ", map { defined($_) ? $_ : 'undef' } @$value); 488 } 489 elsif (ref $value) { 490 _dump_elements($value, $separator, $fh, [ @$path, $key ], $callback); 491 } 492 else { 493 print $fh "$prefix$value\n"; 494 } 495 } 496 } 497 no warnings 'numeric'; # @$path can be non-positive 498 printf $fh "%s$end\n", ($pad x (@$path - 1)) if $end; 499 return 1; 500} 501 502 503sub get_profile_levels { 504 return shift->{profile_modes}; 505} 506 507sub get_fid_line_data { 508 my ($self, $level) = @_; 509 $level ||= 'line'; 510 my $fid_line_data = $self->{"fid_${level}_time"}; 511 return $fid_line_data; 512} 513 514 515=head2 normalize_variables 516 517 $profile->normalize_variables; 518 519Traverses the profile data structure and normalizes highly variable data, such 520as the time, in order that the data can more easily be compared. This is mainly of 521use to the test suite. 522 523The data normalized is: 524 525=over 526 527=item * 528 529profile timing data: set to 0 530 531=item * 532 533subroutines: timings are set to 0 534 535=item * 536 537attributes, like basetime, xs_version, etc., are set to 0 538 539=item * 540 541filenames: path prefixes matching absolute paths in @INC are changed to "/.../" 542 543=item * 544 545filenames: eval sequence numbers, like "(re_eval 2)" are changed to 0 546 547=back 548 549=cut 550 551 552sub normalize_variables { 553 my ($self, $normalize_options) = @_; 554 555 if ($normalize_options) { 556 %{ $self->options } = (); 557 } 558 559 my $attributes = $self->attributes; 560 561 for my $attr (qw( 562 basetime xs_version perl_version clock_id ticks_per_sec nv_size 563 profiler_duration profiler_end_time profiler_start_time 564 cumulative_overhead_ticks profiler_active 565 total_stmts_duration total_stmts_measured total_stmts_discounted 566 total_sub_calls sawampersand_line 567 )) { 568 $attributes->{$attr} = 0 if exists $attributes->{$attr}; 569 } 570 571 for my $attr (qw(PL_perldb cumulative_overhead_ticks)) { 572 delete $attributes->{$attr}; 573 } 574 575 # normalize line data 576 for my $level (qw(line block sub)) { 577 my $fid_line_data = $self->get_fid_line_data($level) || []; 578 579 # zero the statement timing data 580 for my $of_fid (@$fid_line_data) { 581 _zero_array_elem($of_fid, 0) if $of_fid; 582 } 583 } 584 585 my $sub_subinfo = $self->{sub_subinfo}; 586 for my $subname (keys %$sub_subinfo) { 587 my $si = $self->{sub_subinfo}{$subname}; 588 # zero sub info and sub caller times etc. 589 my $newname = $si->normalize_for_test; 590 if ($newname ne $subname) { 591 warn "Normalizing $subname to $newname overwrote other data\n" 592 if $sub_subinfo->{$newname}; 593 $sub_subinfo->{$newname} = delete $sub_subinfo->{$subname}; 594 } 595 } 596 597 $_->normalize_for_test for $self->all_fileinfos; 598 599 return 1; 600} 601 602 603sub _zero_array_elem { 604 my ($ary_of_line_data, $index) = @_; 605 for my $line_data (@$ary_of_line_data) { 606 next unless $line_data; 607 $line_data->[$index] = 0; 608 609 # if line was a string eval 610 # then recurse to zero the times within the eval lines 611 if (my $eval_lines = $line_data->[2]) { 612 _zero_array_elem($eval_lines, $index); # recurse 613 } 614 } 615} 616 617sub _filename_to_fid { 618 my $self = shift; 619 my $caches = $self->_caches; 620 return $caches->{_filename_to_fid_cache} ||= do { 621 my $filename_to_fid = {}; 622 $filename_to_fid->{$_->filename} = $_->fid for $self->all_fileinfos; 623 $filename_to_fid; 624 }; 625} 626 627 628=head2 subs_defined_in_file 629 630 $subs_defined_hash = $profile->subs_defined_in_file( $file, $include_lines ); 631 632Returns a reference to a hash containing information about subroutines defined 633in a source file. The $file argument can be an integer file id (fid) or a file 634path. 635 636Returns undef if the profile contains no C<sub_subinfo> data for the $file. 637 638The keys of the returned hash are fully qualified subroutine names and the 639corresponding value is a hash reference containing L<Devel::NYTProf::SubInfo> 640objects. 641 642If $include_lines is true then the hash also contains integer keys 643corresponding to the first line of the subroutine. The corresponding value is a 644reference to an array. The array contains a hash ref for each of the 645subroutines defined on that line, typically just one. 646 647=cut 648 649sub subs_defined_in_file { 650 my ($self, $fid, $incl_lines) = @_; 651 croak "incl_lines is deprecated in subs_defined_in_file, use subs_defined_in_file_by_line instead" if $incl_lines; 652 653 my $fi = $self->fileinfo_of($fid) 654 or return; 655 656 $fid = $fi->fid; 657 my $caches = $self->_caches; 658 659 my $cache_key = "subs_defined_in_file:$fid"; 660 return $caches->{$cache_key} if $caches->{$cache_key}; 661 662 my %subs = map { $_->subname => $_ } $fi->subs_defined; 663 664 $caches->{$cache_key} = \%subs; 665 return $caches->{$cache_key}; 666} 667 668 669sub subs_defined_in_file_by_line { 670 my $subs = shift->subs_defined_in_file(@_); 671 my %line2subs; 672 for (values %$subs) { 673 my $first_line = $_->first_line || 0; # 0 = xsub? 674 push @{$line2subs{$first_line}}, $_; 675 } 676 return \%line2subs; 677} 678 679 680=head2 file_line_range_of_sub 681 682 ($file, $fid, $first, $last, $fi) = $profile->file_line_range_of_sub("main::foo"); 683 684Returns the filename, fid, and first and last line numbers, and fileinfo object 685for the specified subroutine (which must be fully qualified with a package name). 686 687Returns an empty list if the subroutine name is not in the profile data. 688 689The $fid return is the 'original' fid associated with the file the subroutine was created in. 690 691The $file returned is the source file that defined the subroutine. 692 693Subroutines that are implemented in XS have a line range of 0,0 and a possibly 694unknown file (if NYTProf couldn't find a good match based on the package name). 695 696Subroutines that were called but only returned via an exception may have a line 697range of undef,undef if they're xsubs or were defined before NYTProf was enabled. 698 699=cut 700 701 702sub file_line_range_of_sub { 703 my ($self, $sub) = @_; 704 705 my $sub_subinfo = $self->subinfo_of($sub) 706 or return; # no such sub; warning supplied by subinfo_of() 707 my ($fid, $first, $last) = @$sub_subinfo; 708 709 return if not $fid; # sub has no known file 710 711 my $fileinfo = $fid && $self->fileinfo_of($fid) 712 or croak "No fid_fileinfo for sub $sub fid '$fid'"; 713 714 return ($fileinfo->filename, $fid, $first, $last, $fileinfo); 715} 716 717 718=head2 resolve_fid 719 720 $fid = $profile->resolve_fid( $file ); 721 722Returns the integer I<file id> that corresponds to $file. 723 724If $file can't be found and $file looks like a positive integer then it's 725presumed to already be a fid and is returned. This is used to enable other 726methods to work with fid or file arguments. 727 728If $file can't be found but it uniquely matches the suffix of one of the files 729then that corresponding fid is returned. 730 731=cut 732 733 734sub resolve_fid { 735 my ($self, $file) = @_; 736 Carp::confess("No file specified") unless defined $file; 737 my $resolve_fid_cache = $self->_filename_to_fid; 738 739 # exact match 740 return $resolve_fid_cache->{$file} 741 if exists $resolve_fid_cache->{$file}; 742 743 # looks like a fid already 744 return $file 745 if $file =~ m/^\d+$/; 746 747 # XXX hack needed to because of how _map_new_to_old deals 748 # with .pmc files because of how ::Reporter works 749 return $self->resolve_fid($file) if $file =~ s/\.pmc$/.pm/; 750 751 # unfound absolute path, so we're sure we won't find it 752 return undef # XXX carp? 753 if $file =~ m/^\//; 754 755 # prepend '/' and grep for trailing matches - if just one then use that 756 my $match = qr{/\Q$file\E$}; 757 my @matches = grep {m/$match/} keys %$resolve_fid_cache; 758 # XXX: Not clear how to exercise either of the following conditions 759 return $self->resolve_fid($matches[0]) 760 if @matches == 1; 761 carp "Can't resolve '$file' to a unique file id (matches @matches)" 762 if @matches >= 2; 763 764 return undef; 765} 766 7671; 768 769__END__ 770 771=head1 PROFILE DATA STRUTURE 772 773XXX 774 775=head1 LIMITATION 776 777There's currently no way to merge profile data from multiple files. 778 779=head1 SEE ALSO 780 781L<Devel::NYTProf> 782 783=head1 AUTHOR 784 785B<Adam Kaplan>, C<< <akaplan at nytimes.com> >> 786B<Tim Bunce>, L<http://blog.timbunce.org> 787B<Steve Peters>, C<< <steve at fisharerojo.org> >> 788 789=head1 COPYRIGHT AND LICENSE 790 791 Copyright (C) 2008 by Adam Kaplan and The New York Times Company. 792 Copyright (C) 2008,2009 by Tim Bunce, Ireland. 793 794This library is free software; you can redistribute it and/or modify 795it under the same terms as Perl itself, either Perl version 5.8.8 or, 796at your option, any later version of Perl 5 you may have available. 797 798=cut 799