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