| Filename | /usr/share/perl5/Module/Pluggable/Object.pm |
| Statements | Executed 728 statements in 4.79ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 8.52ms | 9.91ms | Module::Pluggable::Object::BEGIN@4 |
| 1 | 1 | 1 | 2.10ms | 2.30ms | Module::Pluggable::Object::BEGIN@7 |
| 12 | 1 | 1 | 869µs | 869µs | Module::Pluggable::Object::CORE:readline (opcode) |
| 1 | 1 | 1 | 804µs | 2.98ms | Module::Pluggable::Object::BEGIN@8 |
| 1 | 1 | 1 | 634µs | 828µs | Module::Pluggable::Object::BEGIN@6 |
| 10 | 1 | 1 | 573µs | 3.79ms | Module::Pluggable::Object::search_paths |
| 20 | 3 | 1 | 97µs | 97µs | Module::Pluggable::Object::CORE:regcomp (opcode) |
| 104 | 13 | 1 | 96µs | 96µs | Module::Pluggable::Object::CORE:match (opcode) |
| 12 | 2 | 1 | 76µs | 76µs | Module::Pluggable::Object::_is_legit |
| 1 | 1 | 1 | 74µs | 3.96ms | Module::Pluggable::Object::plugins |
| 6 | 1 | 1 | 51µs | 51µs | Module::Pluggable::Object::CORE:open (opcode) |
| 20 | 1 | 1 | 50µs | 50µs | Module::Pluggable::Object::CORE:ftis (opcode) |
| 8 | 2 | 1 | 41µs | 55µs | Module::Pluggable::Object::__ANON__[:317] |
| 6 | 1 | 1 | 33µs | 38µs | Module::Pluggable::Object::_is_editor_junk |
| 2 | 1 | 1 | 33µs | 521µs | Module::Pluggable::Object::find_files |
| 6 | 1 | 1 | 32µs | 85µs | Module::Pluggable::Object::handle_finding_plugin |
| 1 | 1 | 1 | 28µs | 3.82ms | Module::Pluggable::Object::search_directories |
| 6 | 1 | 1 | 26µs | 26µs | Module::Pluggable::Object::CORE:close (opcode) |
| 4 | 2 | 1 | 20µs | 52µs | Module::Pluggable::Object::handle_innerpackages |
| 1 | 1 | 1 | 15µs | 46µs | Module::Pluggable::Object::BEGIN@3 |
| 2 | 1 | 1 | 12µs | 12µs | Module::Pluggable::Object::handle_inc_hooks |
| 1 | 1 | 1 | 12µs | 73µs | Module::Pluggable::Object::BEGIN@11 |
| 12 | 2 | 1 | 11µs | 11µs | Module::Pluggable::Object::CORE:qr (opcode) |
| 1 | 1 | 1 | 9µs | 49µs | Module::Pluggable::Object::BEGIN@5 |
| 1 | 1 | 1 | 7µs | 7µs | Module::Pluggable::Object::_setup_exceptions |
| 1 | 1 | 1 | 6µs | 22µs | Module::Pluggable::Object::BEGIN@9 |
| 1 | 1 | 1 | 5µs | 5µs | Module::Pluggable::Object::CORE:sort (opcode) |
| 1 | 1 | 1 | 4µs | 4µs | Module::Pluggable::Object::new |
| 6 | 1 | 1 | 1µs | 1µs | Module::Pluggable::Object::CORE:subst (opcode) |
| 2 | 1 | 1 | 700ns | 700ns | Module::Pluggable::Object::CORE:ftdir (opcode) |
| 0 | 0 | 0 | 0s | 0s | Module::Pluggable::Object::__ANON__[:51] |
| 0 | 0 | 0 | 0s | 0s | Module::Pluggable::Object::__ANON__[:52] |
| 0 | 0 | 0 | 0s | 0s | Module::Pluggable::Object::_require |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Module::Pluggable::Object; | ||||
| 2 | |||||
| 3 | 2 | 25µs | 2 | 76µs | # spent 46µs (15+30) within Module::Pluggable::Object::BEGIN@3 which was called:
# once (15µs+30µs) by App::Cmd::BEGIN@12 at line 3 # spent 46µs making 1 call to Module::Pluggable::Object::BEGIN@3
# spent 30µs making 1 call to strict::import |
| 4 | 2 | 91µs | 1 | 9.91ms | # spent 9.91ms (8.52+1.39) within Module::Pluggable::Object::BEGIN@4 which was called:
# once (8.52ms+1.39ms) by App::Cmd::BEGIN@12 at line 4 # spent 9.91ms making 1 call to Module::Pluggable::Object::BEGIN@4 |
| 5 | 2 | 26µs | 2 | 89µs | # spent 49µs (9+40) within Module::Pluggable::Object::BEGIN@5 which was called:
# once (9µs+40µs) by App::Cmd::BEGIN@12 at line 5 # spent 49µs making 1 call to Module::Pluggable::Object::BEGIN@5
# spent 40µs making 1 call to Exporter::import |
| 6 | 2 | 422µs | 2 | 894µs | # spent 828µs (634+194) within Module::Pluggable::Object::BEGIN@6 which was called:
# once (634µs+194µs) by App::Cmd::BEGIN@12 at line 6 # spent 828µs making 1 call to Module::Pluggable::Object::BEGIN@6
# spent 66µs making 1 call to Exporter::import |
| 7 | 2 | 89µs | 2 | 2.34ms | # spent 2.30ms (2.10+200µs) within Module::Pluggable::Object::BEGIN@7 which was called:
# once (2.10ms+200µs) by App::Cmd::BEGIN@12 at line 7 # spent 2.30ms making 1 call to Module::Pluggable::Object::BEGIN@7
# spent 47µs making 1 call to Exporter::import |
| 8 | 2 | 407µs | 2 | 3.00ms | # spent 2.98ms (804µs+2.18) within Module::Pluggable::Object::BEGIN@8 which was called:
# once (804µs+2.18ms) by App::Cmd::BEGIN@12 at line 8 # spent 2.98ms making 1 call to Module::Pluggable::Object::BEGIN@8
# spent 20µs making 1 call to Exporter::import |
| 9 | 2 | 24µs | 2 | 38µs | # spent 22µs (6+16) within Module::Pluggable::Object::BEGIN@9 which was called:
# once (6µs+16µs) by App::Cmd::BEGIN@12 at line 9 # spent 22µs making 1 call to Module::Pluggable::Object::BEGIN@9
# spent 16µs making 1 call to vars::import |
| 10 | |||||
| 11 | 2 | 1.58ms | 2 | 75µs | # spent 73µs (12+61) within Module::Pluggable::Object::BEGIN@11 which was called:
# once (12µs+61µs) by App::Cmd::BEGIN@12 at line 11 # spent 73µs making 1 call to Module::Pluggable::Object::BEGIN@11
# spent 2µs making 1 call to if::import |
| 12 | |||||
| 13 | 1 | 400ns | $VERSION = '5.1'; | ||
| 14 | |||||
| 15 | |||||
| 16 | # spent 4µs within Module::Pluggable::Object::new which was called:
# once (4µs+0s) by App::Cmd::_plugins at line 238 of App/Cmd.pm | ||||
| 17 | 1 | 500ns | my $class = shift; | ||
| 18 | 1 | 1µs | my %opts = @_; | ||
| 19 | |||||
| 20 | 1 | 3µs | return bless \%opts, $class; | ||
| 21 | |||||
| 22 | } | ||||
| 23 | |||||
| 24 | ### Eugggh, this code smells | ||||
| 25 | ### This is what happens when you keep adding patches | ||||
| 26 | ### *sigh* | ||||
| 27 | |||||
| 28 | |||||
| 29 | # spent 3.96ms (74µs+3.88) within Module::Pluggable::Object::plugins which was called:
# once (74µs+3.88ms) by App::Cmd::_plugins at line 243 of App/Cmd.pm | ||||
| 30 | 1 | 300ns | my $self = shift; | ||
| 31 | 1 | 500ns | my @args = @_; | ||
| 32 | |||||
| 33 | # override 'require' | ||||
| 34 | 1 | 4µs | $self->{'require'} = 1 if $self->{'inner'}; | ||
| 35 | |||||
| 36 | 1 | 500ns | my $filename = $self->{'filename'}; | ||
| 37 | 1 | 400ns | my $pkg = $self->{'package'}; | ||
| 38 | |||||
| 39 | # Get the exception params instantiated | ||||
| 40 | 1 | 2µs | 1 | 7µs | $self->_setup_exceptions; # spent 7µs making 1 call to Module::Pluggable::Object::_setup_exceptions |
| 41 | |||||
| 42 | # automatically turn a scalar search path or namespace into a arrayref | ||||
| 43 | 1 | 1µs | for (qw(search_path search_dirs)) { | ||
| 44 | 2 | 2µs | $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); | ||
| 45 | } | ||||
| 46 | |||||
| 47 | # default search path is '<Module>::<Name>::Plugin' | ||||
| 48 | 1 | 500ns | $self->{'search_path'} ||= ["${pkg}::Plugin"]; | ||
| 49 | |||||
| 50 | # default error handler | ||||
| 51 | 1 | 3µs | $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; | ||
| 52 | 1 | 2µs | $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; | ||
| 53 | |||||
| 54 | # default whether to follow symlinks | ||||
| 55 | 1 | 2µs | $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; | ||
| 56 | |||||
| 57 | # check to see if we're running under test | ||||
| 58 | 1 | 2µs | my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; | ||
| 59 | |||||
| 60 | # add any search_dir params | ||||
| 61 | 1 | 500ns | unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; | ||
| 62 | |||||
| 63 | # set our @INC up to include and prefer our search_dirs if necessary | ||||
| 64 | 1 | 4µs | my @tmp = @INC; | ||
| 65 | 1 | 2µs | unshift @tmp, @{$self->{'search_dirs'} || []}; | ||
| 66 | 1 | 500ns | local @INC = @tmp if defined $self->{'search_dirs'}; | ||
| 67 | |||||
| 68 | 1 | 4µs | 1 | 3.82ms | my @plugins = $self->search_directories(@SEARCHDIR); # spent 3.82ms making 1 call to Module::Pluggable::Object::search_directories |
| 69 | 1 | 5µs | 2 | 12µs | push(@plugins, $self->handle_inc_hooks($_, @SEARCHDIR)) for @{$self->{'search_path'}}; # spent 12µs making 2 calls to Module::Pluggable::Object::handle_inc_hooks, avg 6µs/call |
| 70 | 1 | 3µs | 2 | 17µs | push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; # spent 17µs making 2 calls to Module::Pluggable::Object::handle_innerpackages, avg 9µs/call |
| 71 | |||||
| 72 | # return blank unless we've found anything | ||||
| 73 | 1 | 400ns | return () unless @plugins; | ||
| 74 | |||||
| 75 | # remove duplicates | ||||
| 76 | # probably not necessary but hey ho | ||||
| 77 | 1 | 300ns | my %plugins; | ||
| 78 | 1 | 700ns | for(@plugins) { | ||
| 79 | 6 | 4µs | 6 | 23µs | next unless $self->_is_legit($_); # spent 23µs making 6 calls to Module::Pluggable::Object::_is_legit, avg 4µs/call |
| 80 | 6 | 4µs | $plugins{$_} = 1; | ||
| 81 | } | ||||
| 82 | |||||
| 83 | # are we instantiating or requiring? | ||||
| 84 | 1 | 400ns | if (defined $self->{'instantiate'}) { | ||
| 85 | my $method = $self->{'instantiate'}; | ||||
| 86 | my @objs = (); | ||||
| 87 | foreach my $package (sort keys %plugins) { | ||||
| 88 | next unless $package->can($method); | ||||
| 89 | my $obj = eval { $package->$method(@_) }; | ||||
| 90 | $self->{'on_instantiate_error'}->($package, $@) if $@; | ||||
| 91 | push @objs, $obj if $obj; | ||||
| 92 | } | ||||
| 93 | return @objs; | ||||
| 94 | } else { | ||||
| 95 | # no? just return the names | ||||
| 96 | 1 | 11µs | 1 | 5µs | my @objs= sort keys %plugins; # spent 5µs making 1 call to Module::Pluggable::Object::CORE:sort |
| 97 | 1 | 6µs | return @objs; | ||
| 98 | } | ||||
| 99 | } | ||||
| 100 | |||||
| 101 | # spent 7µs within Module::Pluggable::Object::_setup_exceptions which was called:
# once (7µs+0s) by Module::Pluggable::Object::plugins at line 40 | ||||
| 102 | 1 | 200ns | my $self = shift; | ||
| 103 | |||||
| 104 | 1 | 200ns | my %only; | ||
| 105 | 1 | 100ns | my %except; | ||
| 106 | 1 | 200ns | my $only; | ||
| 107 | 1 | 100ns | my $except; | ||
| 108 | |||||
| 109 | 1 | 400ns | if (defined $self->{'only'}) { | ||
| 110 | if (ref($self->{'only'}) eq 'ARRAY') { | ||||
| 111 | %only = map { $_ => 1 } @{$self->{'only'}}; | ||||
| 112 | } elsif (ref($self->{'only'}) eq 'Regexp') { | ||||
| 113 | $only = $self->{'only'} | ||||
| 114 | } elsif (ref($self->{'only'}) eq '') { | ||||
| 115 | $only{$self->{'only'}} = 1; | ||||
| 116 | } | ||||
| 117 | } | ||||
| 118 | |||||
| 119 | |||||
| 120 | 1 | 400ns | if (defined $self->{'except'}) { | ||
| 121 | if (ref($self->{'except'}) eq 'ARRAY') { | ||||
| 122 | %except = map { $_ => 1 } @{$self->{'except'}}; | ||||
| 123 | } elsif (ref($self->{'except'}) eq 'Regexp') { | ||||
| 124 | $except = $self->{'except'} | ||||
| 125 | } elsif (ref($self->{'except'}) eq '') { | ||||
| 126 | $except{$self->{'except'}} = 1; | ||||
| 127 | } | ||||
| 128 | } | ||||
| 129 | 1 | 2µs | $self->{_exceptions}->{only_hash} = \%only; | ||
| 130 | 1 | 800ns | $self->{_exceptions}->{only} = $only; | ||
| 131 | 1 | 800ns | $self->{_exceptions}->{except_hash} = \%except; | ||
| 132 | 1 | 3µs | $self->{_exceptions}->{except} = $except; | ||
| 133 | |||||
| 134 | } | ||||
| 135 | |||||
| 136 | sub _is_legit { | ||||
| 137 | 12 | 1µs | my $self = shift; | ||
| 138 | 12 | 2µs | my $plugin = shift; | ||
| 139 | 12 | 12µs | my %only = %{$self->{_exceptions}->{only_hash}||{}}; | ||
| 140 | 12 | 4µs | my %except = %{$self->{_exceptions}->{except_hash}||{}}; | ||
| 141 | 12 | 4µs | my $only = $self->{_exceptions}->{only}; | ||
| 142 | 12 | 3µs | my $except = $self->{_exceptions}->{except}; | ||
| 143 | 12 | 17µs | my $depth = () = split '::', $plugin, -1; | ||
| 144 | |||||
| 145 | 12 | 2µs | return 0 if (keys %only && !$only{$plugin} ); | ||
| 146 | 12 | 2µs | return 0 unless (!defined $only || $plugin =~ m!$only! ); | ||
| 147 | |||||
| 148 | 12 | 1µs | return 0 if (keys %except && $except{$plugin} ); | ||
| 149 | 12 | 2µs | return 0 if (defined $except && $plugin =~ m!$except! ); | ||
| 150 | |||||
| 151 | 12 | 3µs | return 0 if defined $self->{max_depth} && $depth>$self->{max_depth}; | ||
| 152 | 12 | 1µs | return 0 if defined $self->{min_depth} && $depth<$self->{min_depth}; | ||
| 153 | |||||
| 154 | 12 | 26µs | return 1; | ||
| 155 | } | ||||
| 156 | |||||
| 157 | # spent 3.82ms (28µs+3.79) within Module::Pluggable::Object::search_directories which was called:
# once (28µs+3.79ms) by Module::Pluggable::Object::plugins at line 68 | ||||
| 158 | 1 | 600ns | my $self = shift; | ||
| 159 | 1 | 1µs | my @SEARCHDIR = @_; | ||
| 160 | |||||
| 161 | 1 | 200ns | my @plugins; | ||
| 162 | # go through our @INC | ||||
| 163 | 1 | 700ns | foreach my $dir (@SEARCHDIR) { | ||
| 164 | 10 | 14µs | 10 | 3.79ms | push @plugins, $self->search_paths($dir); # spent 3.79ms making 10 calls to Module::Pluggable::Object::search_paths, avg 379µs/call |
| 165 | } | ||||
| 166 | 1 | 6µs | return @plugins; | ||
| 167 | } | ||||
| 168 | |||||
| 169 | |||||
| 170 | # spent 3.79ms (573µs+3.22) within Module::Pluggable::Object::search_paths which was called 10 times, avg 379µs/call:
# 10 times (573µs+3.22ms) by Module::Pluggable::Object::search_directories at line 164, avg 379µs/call | ||||
| 171 | 10 | 2µs | my $self = shift; | ||
| 172 | 10 | 2µs | my $dir = shift; | ||
| 173 | 10 | 1µs | my @plugins; | ||
| 174 | |||||
| 175 | 10 | 29µs | 10 | 9µs | my $file_regex = $self->{'file_regex'} || qr/\.pm$/; # spent 9µs making 10 calls to Module::Pluggable::Object::CORE:qr, avg 900ns/call |
| 176 | |||||
| 177 | |||||
| 178 | # and each directory in our search path | ||||
| 179 | 10 | 13µs | foreach my $searchpath (@{$self->{'search_path'}}) { | ||
| 180 | # create the search directory in a cross platform goodness way | ||||
| 181 | 20 | 31µs | 20 | 285µs | my $sp = catdir($dir, (split /::/, $searchpath)); # spent 285µs making 20 calls to File::Spec::Functions::__ANON__[File/Spec/Functions.pm:43], avg 14µs/call |
| 182 | |||||
| 183 | # if it doesn't exist or it's not a dir then skip it | ||||
| 184 | 20 | 88µs | 22 | 51µs | next unless ( -e $sp && -d _ ); # Use the cached stat the second time # spent 50µs making 20 calls to Module::Pluggable::Object::CORE:ftis, avg 3µs/call
# spent 700ns making 2 calls to Module::Pluggable::Object::CORE:ftdir, avg 350ns/call |
| 185 | |||||
| 186 | 2 | 4µs | 2 | 521µs | my @files = $self->find_files($sp); # spent 521µs making 2 calls to Module::Pluggable::Object::find_files, avg 261µs/call |
| 187 | |||||
| 188 | # foreach one we've found | ||||
| 189 | 2 | 1µs | foreach my $file (@files) { | ||
| 190 | # untaint the file; accept .pm only | ||||
| 191 | 6 | 45µs | 12 | 23µs | next unless ($file) = ($file =~ /(.*$file_regex)$/); # spent 13µs making 6 calls to Module::Pluggable::Object::CORE:regcomp, avg 2µs/call
# spent 10µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 2µs/call |
| 192 | # parse the file to get the name | ||||
| 193 | 6 | 10µs | 6 | 126µs | my ($name, $directory, $suffix) = fileparse($file, $file_regex); # spent 126µs making 6 calls to File::Basename::fileparse, avg 21µs/call |
| 194 | |||||
| 195 | 6 | 10µs | 6 | 38µs | next if (!$self->{include_editor_junk} && $self->_is_editor_junk($name)); # spent 38µs making 6 calls to Module::Pluggable::Object::_is_editor_junk, avg 6µs/call |
| 196 | |||||
| 197 | 6 | 8µs | 6 | 741µs | $directory = abs2rel($directory, $sp); # spent 741µs making 6 calls to File::Spec::Functions::__ANON__[File/Spec/Functions.pm:43], avg 123µs/call |
| 198 | |||||
| 199 | # If we have a mixed-case package name, assume case has been preserved | ||||
| 200 | # correctly. Otherwise, root through the file to locate the case-preserved | ||||
| 201 | # version of the package name. | ||||
| 202 | 6 | 2µs | my @pkg_dirs = (); | ||
| 203 | 6 | 6µs | if ( $name eq lc($name) || $name eq uc($name) ) { | ||
| 204 | 6 | 8µs | 6 | 179µs | my $pkg_file = catfile($sp, $directory, "$name$suffix"); # spent 179µs making 6 calls to File::Spec::Functions::__ANON__[File/Spec/Functions.pm:43], avg 30µs/call |
| 205 | 6 | 69µs | 6 | 51µs | open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!"; # spent 51µs making 6 calls to Module::Pluggable::Object::CORE:open, avg 9µs/call |
| 206 | 6 | 2µs | my $in_pod = 0; | ||
| 207 | 6 | 916µs | 12 | 869µs | while ( my $line = <PKGFILE> ) { # spent 869µs making 12 calls to Module::Pluggable::Object::CORE:readline, avg 72µs/call |
| 208 | 12 | 32µs | 12 | 6µs | $in_pod = 1 if $line =~ m/^=\w/; # spent 6µs making 12 calls to Module::Pluggable::Object::CORE:match, avg 533ns/call |
| 209 | 12 | 25µs | 12 | 4µs | $in_pod = 0 if $line =~ /^=cut/; # spent 4µs making 12 calls to Module::Pluggable::Object::CORE:match, avg 292ns/call |
| 210 | 12 | 26µs | 12 | 4µs | next if ($in_pod || $line =~ /^=cut/); # skip pod text # spent 4µs making 12 calls to Module::Pluggable::Object::CORE:match, avg 300ns/call |
| 211 | 12 | 88µs | 12 | 30µs | next if $line =~ /^\s*#/; # and comments # spent 30µs making 12 calls to Module::Pluggable::Object::CORE:match, avg 2µs/call |
| 212 | 6 | 114µs | 12 | 91µs | if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { # spent 78µs making 6 calls to Module::Pluggable::Object::CORE:regcomp, avg 13µs/call
# spent 13µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 2µs/call |
| 213 | 6 | 19µs | @pkg_dirs = split /::/, $1 if defined $1;; | ||
| 214 | 6 | 5µs | $name = $2; | ||
| 215 | 6 | 5µs | last; | ||
| 216 | } | ||||
| 217 | } | ||||
| 218 | 6 | 41µs | 6 | 26µs | close PKGFILE; # spent 26µs making 6 calls to Module::Pluggable::Object::CORE:close, avg 4µs/call |
| 219 | } | ||||
| 220 | |||||
| 221 | # then create the class name in a cross platform way | ||||
| 222 | 6 | 17µs | 6 | 8µs | $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); # remove volume # spent 8µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 1µs/call |
| 223 | 6 | 2µs | my @dirs = (); | ||
| 224 | 6 | 2µs | if ($directory) { | ||
| 225 | 6 | 17µs | 6 | 6µs | ($directory) = ($directory =~ /(.*)/); # spent 6µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 983ns/call |
| 226 | 6 | 9µs | 6 | 22µs | @dirs = grep(length($_), splitdir($directory)) # spent 22µs making 6 calls to File::Spec::Functions::__ANON__[File/Spec/Functions.pm:43], avg 4µs/call |
| 227 | unless $directory eq curdir(); | ||||
| 228 | 6 | 6µs | for my $d (reverse @dirs) { | ||
| 229 | my $pkg_dir = pop @pkg_dirs; | ||||
| 230 | last unless defined $pkg_dir; | ||||
| 231 | $d =~ s/\Q$pkg_dir\E/$pkg_dir/i; # Correct case | ||||
| 232 | } | ||||
| 233 | } else { | ||||
| 234 | $directory = ""; | ||||
| 235 | } | ||||
| 236 | 6 | 5µs | my $plugin = join '::', $searchpath, @dirs, $name; | ||
| 237 | |||||
| 238 | 6 | 20µs | 6 | 6µs | next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]*!i; # spent 6µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 933ns/call |
| 239 | |||||
| 240 | 6 | 16µs | 6 | 85µs | $self->handle_finding_plugin($plugin, \@plugins) # spent 85µs making 6 calls to Module::Pluggable::Object::handle_finding_plugin, avg 14µs/call |
| 241 | } | ||||
| 242 | |||||
| 243 | # now add stuff that may have been in package | ||||
| 244 | # NOTE we should probably use all the stuff we've been given already | ||||
| 245 | # but then we can't unload it :( | ||||
| 246 | 2 | 6µs | 2 | 35µs | push @plugins, $self->handle_innerpackages($searchpath); # spent 35µs making 2 calls to Module::Pluggable::Object::handle_innerpackages, avg 18µs/call |
| 247 | } # foreach $searchpath | ||||
| 248 | |||||
| 249 | 10 | 21µs | return @plugins; | ||
| 250 | } | ||||
| 251 | |||||
| 252 | # spent 38µs (33+4) within Module::Pluggable::Object::_is_editor_junk which was called 6 times, avg 6µs/call:
# 6 times (33µs+4µs) by Module::Pluggable::Object::search_paths at line 195, avg 6µs/call | ||||
| 253 | 6 | 1µs | my $self = shift; | ||
| 254 | 6 | 1µs | my $name = shift; | ||
| 255 | |||||
| 256 | # Emacs (and other Unix-y editors) leave temp files ending in a | ||||
| 257 | # tilde as a backup. | ||||
| 258 | 6 | 11µs | 6 | 2µs | return 1 if $name =~ /~$/; # spent 2µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 333ns/call |
| 259 | # Emacs makes these files while a buffer is edited but not yet | ||||
| 260 | # saved. | ||||
| 261 | 6 | 9µs | 6 | 1µs | return 1 if $name =~ /^\.#/; # spent 1µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 183ns/call |
| 262 | # Vim can leave these files behind if it crashes. | ||||
| 263 | 6 | 9µs | 6 | 1µs | return 1 if $name =~ /\.sw[po]$/; # spent 1µs making 6 calls to Module::Pluggable::Object::CORE:match, avg 200ns/call |
| 264 | |||||
| 265 | 6 | 10µs | return 0; | ||
| 266 | } | ||||
| 267 | |||||
| 268 | # spent 85µs (32+53) within Module::Pluggable::Object::handle_finding_plugin which was called 6 times, avg 14µs/call:
# 6 times (32µs+53µs) by Module::Pluggable::Object::search_paths at line 240, avg 14µs/call | ||||
| 269 | 6 | 2µs | my $self = shift; | ||
| 270 | 6 | 1µs | my $plugin = shift; | ||
| 271 | 6 | 2µs | my $plugins = shift; | ||
| 272 | 6 | 1µs | my $no_req = shift || 0; | ||
| 273 | |||||
| 274 | 6 | 14µs | 6 | 53µs | return unless $self->_is_legit($plugin); # spent 53µs making 6 calls to Module::Pluggable::Object::_is_legit, avg 9µs/call |
| 275 | 6 | 3µs | unless (defined $self->{'instantiate'} || $self->{'require'}) { | ||
| 276 | 6 | 3µs | push @$plugins, $plugin; | ||
| 277 | 6 | 10µs | return; | ||
| 278 | } | ||||
| 279 | |||||
| 280 | $self->{before_require}->($plugin) || return if defined $self->{before_require}; | ||||
| 281 | unless ($no_req) { | ||||
| 282 | my $tmp = $@; | ||||
| 283 | my $res = eval { $self->_require($plugin) }; | ||||
| 284 | my $err = $@; | ||||
| 285 | $@ = $tmp; | ||||
| 286 | if ($err) { | ||||
| 287 | if (defined $self->{on_require_error}) { | ||||
| 288 | $self->{on_require_error}->($plugin, $err) || return; | ||||
| 289 | } else { | ||||
| 290 | return; | ||||
| 291 | } | ||||
| 292 | } | ||||
| 293 | } | ||||
| 294 | $self->{after_require}->($plugin) || return if defined $self->{after_require}; | ||||
| 295 | push @$plugins, $plugin; | ||||
| 296 | } | ||||
| 297 | |||||
| 298 | # spent 521µs (33+488) within Module::Pluggable::Object::find_files which was called 2 times, avg 261µs/call:
# 2 times (33µs+488µs) by Module::Pluggable::Object::search_paths at line 186, avg 261µs/call | ||||
| 299 | 2 | 500ns | my $self = shift; | ||
| 300 | 2 | 800ns | my $search_path = shift; | ||
| 301 | 2 | 6µs | 2 | 2µs | my $file_regex = $self->{'file_regex'} || qr/\.pm$/; # spent 2µs making 2 calls to Module::Pluggable::Object::CORE:qr, avg 1µs/call |
| 302 | |||||
| 303 | |||||
| 304 | # find all the .pm files in it | ||||
| 305 | # this isn't perfect and won't find multiple plugins per file | ||||
| 306 | #my $cwd = Cwd::getcwd; | ||||
| 307 | 2 | 1µs | my @files = (); | ||
| 308 | { # for the benefit of perl 5.6.1's Find, localize topic | ||||
| 309 | 4 | 5µs | local $_; | ||
| 310 | File::Find::find( { no_chdir => 1, | ||||
| 311 | follow => $self->{'follow_symlinks'}, | ||||
| 312 | # spent 55µs (41+13) within Module::Pluggable::Object::__ANON__[/usr/share/perl5/Module/Pluggable/Object.pm:317] which was called 8 times, avg 7µs/call:
# 6 times (31µs+10µs) by File::Find::_find_dir_symlnk at line 1012 of File/Find.pm, avg 7µs/call
# 2 times (10µs+3µs) by File::Find::_find_dir_symlnk at line 933 of File/Find.pm, avg 7µs/call | ||||
| 313 | # Inlined from File::Find::Rule C< name => '*.pm' > | ||||
| 314 | 8 | 39µs | 16 | 12µs | return unless $File::Find::name =~ /$file_regex/; # spent 6µs making 8 calls to Module::Pluggable::Object::CORE:match, avg 762ns/call
# spent 6µs making 8 calls to Module::Pluggable::Object::CORE:regcomp, avg 725ns/call |
| 315 | 6 | 11µs | 6 | 1µs | (my $path = $File::Find::name) =~ s#^\\./##; # spent 1µs making 6 calls to Module::Pluggable::Object::CORE:subst, avg 233ns/call |
| 316 | 6 | 11µs | push @files, $path; | ||
| 317 | } | ||||
| 318 | 2 | 15µs | 2 | 486µs | }, $search_path ); # spent 486µs making 2 calls to File::Find::find, avg 243µs/call |
| 319 | } | ||||
| 320 | #chdir $cwd; | ||||
| 321 | 2 | 8µs | return @files; | ||
| 322 | |||||
| 323 | } | ||||
| 324 | |||||
| 325 | # spent 12µs within Module::Pluggable::Object::handle_inc_hooks which was called 2 times, avg 6µs/call:
# 2 times (12µs+0s) by Module::Pluggable::Object::plugins at line 69, avg 6µs/call | ||||
| 326 | 2 | 500ns | my $self = shift; | ||
| 327 | 2 | 400ns | my $path = shift; | ||
| 328 | 2 | 3µs | my @SEARCHDIR = @_; | ||
| 329 | |||||
| 330 | 2 | 300ns | my @plugins; | ||
| 331 | 2 | 3µs | for my $dir ( @SEARCHDIR ) { | ||
| 332 | 20 | 2µs | next unless ref $dir && eval { $dir->can( 'files' ) }; | ||
| 333 | |||||
| 334 | foreach my $plugin ( $dir->files ) { | ||||
| 335 | $plugin =~ s/\.pm$//; | ||||
| 336 | $plugin =~ s{/}{::}g; | ||||
| 337 | next unless $plugin =~ m!^${path}::!; | ||||
| 338 | $self->handle_finding_plugin( $plugin, \@plugins ); | ||||
| 339 | } | ||||
| 340 | } | ||||
| 341 | 2 | 5µs | return @plugins; | ||
| 342 | } | ||||
| 343 | |||||
| 344 | # spent 52µs (20+32) within Module::Pluggable::Object::handle_innerpackages which was called 4 times, avg 13µs/call:
# 2 times (14µs+21µs) by Module::Pluggable::Object::search_paths at line 246, avg 18µs/call
# 2 times (6µs+11µs) by Module::Pluggable::Object::plugins at line 70, avg 9µs/call | ||||
| 345 | 4 | 700ns | my $self = shift; | ||
| 346 | 4 | 2µs | return () if (exists $self->{inner} && !$self->{inner}); | ||
| 347 | |||||
| 348 | 4 | 1µs | my $path = shift; | ||
| 349 | 4 | 2µs | my @plugins; | ||
| 350 | |||||
| 351 | 4 | 7µs | 4 | 32µs | foreach my $plugin (Devel::InnerPackage::list_packages($path)) { # spent 32µs making 4 calls to Devel::InnerPackage::list_packages, avg 8µs/call |
| 352 | $self->handle_finding_plugin($plugin, \@plugins, 1); | ||||
| 353 | } | ||||
| 354 | 4 | 9µs | return @plugins; | ||
| 355 | |||||
| 356 | } | ||||
| 357 | |||||
| 358 | |||||
| 359 | sub _require { | ||||
| 360 | my $self = shift; | ||||
| 361 | my $pack = shift; | ||||
| 362 | eval "CORE::require $pack"; | ||||
| 363 | die ($@) if $@; | ||||
| 364 | return 1; | ||||
| 365 | } | ||||
| 366 | |||||
| 367 | |||||
| 368 | 1 | 2µs | 1; | ||
| 369 | |||||
| 370 | =pod | ||||
| 371 | |||||
| 372 | =head1 NAME | ||||
| 373 | |||||
| 374 | Module::Pluggable::Object - automatically give your module the ability to have plugins | ||||
| 375 | |||||
| 376 | =head1 SYNOPSIS | ||||
| 377 | |||||
| 378 | |||||
| 379 | Simple use Module::Pluggable - | ||||
| 380 | |||||
| 381 | package MyClass; | ||||
| 382 | use Module::Pluggable::Object; | ||||
| 383 | |||||
| 384 | my $finder = Module::Pluggable::Object->new(%opts); | ||||
| 385 | print "My plugins are: ".join(", ", $finder->plugins)."\n"; | ||||
| 386 | |||||
| 387 | =head1 DESCRIPTION | ||||
| 388 | |||||
| 389 | Provides a simple but, hopefully, extensible way of having 'plugins' for | ||||
| 390 | your module. Obviously this isn't going to be the be all and end all of | ||||
| 391 | solutions but it works for me. | ||||
| 392 | |||||
| 393 | Essentially all it does is export a method into your namespace that | ||||
| 394 | looks through a search path for .pm files and turn those into class names. | ||||
| 395 | |||||
| 396 | Optionally it instantiates those classes for you. | ||||
| 397 | |||||
| 398 | This object is wrapped by C<Module::Pluggable>. If you want to do something | ||||
| 399 | odd or add non-general special features you're probably best to wrap this | ||||
| 400 | and produce your own subclass. | ||||
| 401 | |||||
| 402 | =head1 OPTIONS | ||||
| 403 | |||||
| 404 | See the C<Module::Pluggable> docs. | ||||
| 405 | |||||
| 406 | =head1 AUTHOR | ||||
| 407 | |||||
| 408 | Simon Wistow <simon@thegestalt.org> | ||||
| 409 | |||||
| 410 | =head1 COPYING | ||||
| 411 | |||||
| 412 | Copyright, 2006 Simon Wistow | ||||
| 413 | |||||
| 414 | Distributed under the same terms as Perl itself. | ||||
| 415 | |||||
| 416 | =head1 BUGS | ||||
| 417 | |||||
| 418 | None known. | ||||
| 419 | |||||
| 420 | =head1 SEE ALSO | ||||
| 421 | |||||
| 422 | L<Module::Pluggable> | ||||
| 423 | |||||
| 424 | =cut | ||||
| 425 | |||||
# spent 26µs within Module::Pluggable::Object::CORE:close which was called 6 times, avg 4µs/call:
# 6 times (26µs+0s) by Module::Pluggable::Object::search_paths at line 218, avg 4µs/call | |||||
# spent 700ns within Module::Pluggable::Object::CORE:ftdir which was called 2 times, avg 350ns/call:
# 2 times (700ns+0s) by Module::Pluggable::Object::search_paths at line 184, avg 350ns/call | |||||
# spent 50µs within Module::Pluggable::Object::CORE:ftis which was called 20 times, avg 3µs/call:
# 20 times (50µs+0s) by Module::Pluggable::Object::search_paths at line 184, avg 3µs/call | |||||
# spent 96µs within Module::Pluggable::Object::CORE:match which was called 104 times, avg 928ns/call:
# 12 times (30µs+0s) by Module::Pluggable::Object::search_paths at line 211, avg 2µs/call
# 12 times (6µs+0s) by Module::Pluggable::Object::search_paths at line 208, avg 533ns/call
# 12 times (4µs+0s) by Module::Pluggable::Object::search_paths at line 210, avg 300ns/call
# 12 times (4µs+0s) by Module::Pluggable::Object::search_paths at line 209, avg 292ns/call
# 8 times (6µs+0s) by Module::Pluggable::Object::__ANON__[/usr/share/perl5/Module/Pluggable/Object.pm:317] at line 314, avg 762ns/call
# 6 times (13µs+0s) by Module::Pluggable::Object::search_paths at line 212, avg 2µs/call
# 6 times (10µs+0s) by Module::Pluggable::Object::search_paths at line 191, avg 2µs/call
# 6 times (8µs+0s) by Module::Pluggable::Object::search_paths at line 222, avg 1µs/call
# 6 times (6µs+0s) by Module::Pluggable::Object::search_paths at line 225, avg 983ns/call
# 6 times (6µs+0s) by Module::Pluggable::Object::search_paths at line 238, avg 933ns/call
# 6 times (2µs+0s) by Module::Pluggable::Object::_is_editor_junk at line 258, avg 333ns/call
# 6 times (1µs+0s) by Module::Pluggable::Object::_is_editor_junk at line 263, avg 200ns/call
# 6 times (1µs+0s) by Module::Pluggable::Object::_is_editor_junk at line 261, avg 183ns/call | |||||
# spent 51µs within Module::Pluggable::Object::CORE:open which was called 6 times, avg 9µs/call:
# 6 times (51µs+0s) by Module::Pluggable::Object::search_paths at line 205, avg 9µs/call | |||||
sub Module::Pluggable::Object::CORE:qr; # opcode | |||||
# spent 869µs within Module::Pluggable::Object::CORE:readline which was called 12 times, avg 72µs/call:
# 12 times (869µs+0s) by Module::Pluggable::Object::search_paths at line 207, avg 72µs/call | |||||
# spent 97µs within Module::Pluggable::Object::CORE:regcomp which was called 20 times, avg 5µs/call:
# 8 times (6µs+0s) by Module::Pluggable::Object::__ANON__[/usr/share/perl5/Module/Pluggable/Object.pm:317] at line 314, avg 725ns/call
# 6 times (78µs+0s) by Module::Pluggable::Object::search_paths at line 212, avg 13µs/call
# 6 times (13µs+0s) by Module::Pluggable::Object::search_paths at line 191, avg 2µs/call | |||||
# spent 5µs within Module::Pluggable::Object::CORE:sort which was called:
# once (5µs+0s) by Module::Pluggable::Object::plugins at line 96 | |||||
# spent 1µs within Module::Pluggable::Object::CORE:subst which was called 6 times, avg 233ns/call:
# 6 times (1µs+0s) by Module::Pluggable::Object::__ANON__[/usr/share/perl5/Module/Pluggable/Object.pm:317] at line 315, avg 233ns/call |