| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Log/Any/Manager.pm |
| Statements | Executed 8085 statements in 16.1ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2003 | 1 | 1 | 7.86ms | 8.51ms | Log::Any::Manager::get_adapter |
| 3 | 1 | 1 | 197µs | 577µs | Log::Any::Manager::_require_dynamic |
| 3 | 1 | 1 | 29µs | 625µs | Log::Any::Manager::_choose_entry_for_category |
| 3 | 1 | 1 | 16µs | 19µs | Log::Any::Manager::_get_adapter_class |
| 3 | 1 | 1 | 14µs | 32µs | Log::Any::Manager::_new_adapter_for_entry |
| 1 | 1 | 1 | 8µs | 8µs | Log::Any::BEGIN@1 |
| 1 | 1 | 1 | 6µs | 20µs | Log::Any::Manager::BEGIN@36 |
| 1 | 1 | 1 | 4µs | 6µs | Log::Any::BEGIN@2 |
| 1 | 1 | 1 | 3µs | 6µs | Log::Any::BEGIN@3 |
| 1 | 1 | 1 | 3µs | 3µs | Log::Any::Manager::new |
| 3 | 1 | 1 | 2µs | 2µs | Log::Any::Manager::CORE:subst (opcode) |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::_Guard::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::_Guard::new |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::__ANON__[:103] |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::_new_entry |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::_reselect_matching_adapters |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::remove |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::set |
| 0 | 0 | 0 | 0s | 0s | Log::Any::Manager::set_default |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | 2 | 22µs | 1 | 8µs | # spent 8µs within Log::Any::BEGIN@1 which was called:
# once (8µs+0s) by Log::Any::BEGIN@10 at line 1 # spent 8µs making 1 call to Log::Any::BEGIN@1 |
| 2 | 2 | 13µs | 2 | 7µs | # spent 6µs (4+1) within Log::Any::BEGIN@2 which was called:
# once (4µs+1µs) by Log::Any::BEGIN@10 at line 2 # spent 6µs making 1 call to Log::Any::BEGIN@2
# spent 1µs making 1 call to strict::import |
| 3 | 2 | 101µs | 2 | 8µs | # spent 6µs (3+2) within Log::Any::BEGIN@3 which was called:
# once (3µs+2µs) by Log::Any::BEGIN@10 at line 3 # spent 6µs making 1 call to Log::Any::BEGIN@3
# spent 2µs making 1 call to warnings::import |
| 4 | |||||
| 5 | package Log::Any::Manager; | ||||
| 6 | |||||
| 7 | 1 | 300ns | our $VERSION = '1.032'; | ||
| 8 | |||||
| 9 | # spent 3µs within Log::Any::Manager::new which was called:
# once (3µs+0s) by CHI::Stats::BEGIN@5 at line 27 of Log/Any.pm | ||||
| 10 | 1 | 400ns | my $class = shift; | ||
| 11 | 1 | 1µs | my $self = { | ||
| 12 | entries => [], | ||||
| 13 | category_cache => {}, | ||||
| 14 | default_adapter => {}, | ||||
| 15 | }; | ||||
| 16 | 1 | 300ns | bless $self, $class; | ||
| 17 | |||||
| 18 | 1 | 3µs | return $self; | ||
| 19 | } | ||||
| 20 | |||||
| 21 | # spent 8.51ms (7.86+656µs) within Log::Any::Manager::get_adapter which was called 2003 times, avg 4µs/call:
# 2003 times (7.86ms+656µs) by Log::Any::get_logger at line 82 of Log/Any.pm, avg 4µs/call | ||||
| 22 | 2003 | 821µs | my ( $self, $category ) = @_; | ||
| 23 | |||||
| 24 | # Create a new adapter for this category if it is not already in cache | ||||
| 25 | # | ||||
| 26 | 2003 | 1.52ms | my $category_cache = $self->{category_cache}; | ||
| 27 | 2003 | 1.51ms | if ( !defined( $category_cache->{$category} ) ) { | ||
| 28 | 3 | 4µs | 3 | 625µs | my $entry = $self->_choose_entry_for_category($category); # spent 625µs making 3 calls to Log::Any::Manager::_choose_entry_for_category, avg 208µs/call |
| 29 | 3 | 5µs | 3 | 32µs | my $adapter = $self->_new_adapter_for_entry( $entry, $category ); # spent 32µs making 3 calls to Log::Any::Manager::_new_adapter_for_entry, avg 10µs/call |
| 30 | 3 | 6µs | $category_cache->{$category} = { entry => $entry, adapter => $adapter }; | ||
| 31 | } | ||||
| 32 | 2003 | 11.5ms | return $category_cache->{$category}->{adapter}; | ||
| 33 | } | ||||
| 34 | |||||
| 35 | { | ||||
| 36 | 3 | 477µs | 2 | 33µs | # spent 20µs (6+13) within Log::Any::Manager::BEGIN@36 which was called:
# once (6µs+13µs) by Log::Any::BEGIN@10 at line 36 # spent 20µs making 1 call to Log::Any::Manager::BEGIN@36
# spent 13µs making 1 call to warnings::unimport |
| 37 | 1 | 800ns | *get_logger = \&get_adapter; # backwards compatibility | ||
| 38 | } | ||||
| 39 | |||||
| 40 | # spent 625µs (29+596) within Log::Any::Manager::_choose_entry_for_category which was called 3 times, avg 208µs/call:
# 3 times (29µs+596µs) by Log::Any::Manager::get_adapter at line 28, avg 208µs/call | ||||
| 41 | 3 | 1µs | my ( $self, $category ) = @_; | ||
| 42 | |||||
| 43 | 3 | 4µs | foreach my $entry ( @{ $self->{entries} } ) { | ||
| 44 | if ( $category =~ $entry->{pattern} ) { | ||||
| 45 | return $entry; | ||||
| 46 | } | ||||
| 47 | } | ||||
| 48 | # nothing requested so fallback to default | ||||
| 49 | 3 | 7µs | 3 | 19µs | my $default = $self->{default_adapter}{$category} # spent 19µs making 3 calls to Log::Any::Manager::_get_adapter_class, avg 6µs/call |
| 50 | || [ $self->_get_adapter_class("Null"), [] ]; | ||||
| 51 | 3 | 1µs | my ($adapter_class, $adapter_params) = @$default; | ||
| 52 | 3 | 4µs | 3 | 577µs | _require_dynamic($adapter_class); # spent 577µs making 3 calls to Log::Any::Manager::_require_dynamic, avg 192µs/call |
| 53 | return { | ||||
| 54 | 3 | 10µs | adapter_class => $adapter_class, | ||
| 55 | adapter_params => $adapter_params, | ||||
| 56 | }; | ||||
| 57 | } | ||||
| 58 | |||||
| 59 | # spent 32µs (14+18) within Log::Any::Manager::_new_adapter_for_entry which was called 3 times, avg 10µs/call:
# 3 times (14µs+18µs) by Log::Any::Manager::get_adapter at line 29, avg 10µs/call | ||||
| 60 | 3 | 1µs | my ( $self, $entry, $category ) = @_; | ||
| 61 | |||||
| 62 | return $entry->{adapter_class} | ||||
| 63 | 3 | 11µs | 3 | 18µs | ->new( @{ $entry->{adapter_params} }, category => $category ); # spent 18µs making 3 calls to Log::Any::Adapter::Base::new, avg 6µs/call |
| 64 | } | ||||
| 65 | |||||
| 66 | sub set_default { | ||||
| 67 | my ( $self, $category, $adapter_name, @adapter_params ) = @_; | ||||
| 68 | my $adapter_class = $self->_get_adapter_class($adapter_name); | ||||
| 69 | $self->{default_adapter}{$category} = [$adapter_class, \@adapter_params]; | ||||
| 70 | } | ||||
| 71 | |||||
| 72 | sub set { | ||||
| 73 | my $self = shift; | ||||
| 74 | my $options; | ||||
| 75 | if ( ref( $_[0] ) eq 'HASH' ) { | ||||
| 76 | $options = shift(@_); | ||||
| 77 | } | ||||
| 78 | my ( $adapter_name, @adapter_params ) = @_; | ||||
| 79 | |||||
| 80 | unless ( defined($adapter_name) && $adapter_name =~ /\S/ ) { | ||||
| 81 | require Carp; | ||||
| 82 | Carp::croak("expected adapter name"); | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | my $pattern = $options->{category}; | ||||
| 86 | if ( !defined($pattern) ) { | ||||
| 87 | $pattern = qr/.*/; | ||||
| 88 | } | ||||
| 89 | elsif ( !ref($pattern) ) { | ||||
| 90 | $pattern = qr/^\Q$pattern\E$/; | ||||
| 91 | } | ||||
| 92 | |||||
| 93 | my $adapter_class = $self->_get_adapter_class($adapter_name); | ||||
| 94 | _require_dynamic($adapter_class); | ||||
| 95 | |||||
| 96 | my $entry = $self->_new_entry( $pattern, $adapter_class, \@adapter_params ); | ||||
| 97 | unshift( @{ $self->{entries} }, $entry ); | ||||
| 98 | |||||
| 99 | $self->_reselect_matching_adapters($pattern); | ||||
| 100 | |||||
| 101 | if ( my $lex_ref = $options->{lexically} ) { | ||||
| 102 | $$lex_ref = Log::Any::Manager::_Guard->new( | ||||
| 103 | sub { $self->remove($entry) unless _in_global_destruction() } ); | ||||
| 104 | } | ||||
| 105 | |||||
| 106 | return $entry; | ||||
| 107 | } | ||||
| 108 | |||||
| 109 | sub remove { | ||||
| 110 | my ( $self, $entry ) = @_; | ||||
| 111 | |||||
| 112 | my $pattern = $entry->{pattern}; | ||||
| 113 | $self->{entries} = [ grep { $_ ne $entry } @{ $self->{entries} } ]; | ||||
| 114 | $self->_reselect_matching_adapters($pattern); | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | sub _new_entry { | ||||
| 118 | my ( $self, $pattern, $adapter_class, $adapter_params ) = @_; | ||||
| 119 | |||||
| 120 | return { | ||||
| 121 | pattern => $pattern, | ||||
| 122 | adapter_class => $adapter_class, | ||||
| 123 | adapter_params => $adapter_params, | ||||
| 124 | }; | ||||
| 125 | } | ||||
| 126 | |||||
| 127 | sub _reselect_matching_adapters { | ||||
| 128 | my ( $self, $pattern ) = @_; | ||||
| 129 | |||||
| 130 | return if _in_global_destruction(); | ||||
| 131 | |||||
| 132 | # Reselect adapter for each category matching $pattern | ||||
| 133 | # | ||||
| 134 | while ( my ( $category, $category_info ) = | ||||
| 135 | each( %{ $self->{category_cache} } ) ) | ||||
| 136 | { | ||||
| 137 | my $new_entry = $self->_choose_entry_for_category($category); | ||||
| 138 | if ( $new_entry ne $category_info->{entry} ) { | ||||
| 139 | my $new_adapter = | ||||
| 140 | $self->_new_adapter_for_entry( $new_entry, $category ); | ||||
| 141 | %{ $category_info->{adapter} } = %$new_adapter; | ||||
| 142 | bless( $category_info->{adapter}, ref($new_adapter) ); | ||||
| 143 | $category_info->{entry} = $new_entry; | ||||
| 144 | } | ||||
| 145 | } | ||||
| 146 | } | ||||
| 147 | |||||
| 148 | # spent 19µs (16+2) within Log::Any::Manager::_get_adapter_class which was called 3 times, avg 6µs/call:
# 3 times (16µs+2µs) by Log::Any::Manager::_choose_entry_for_category at line 49, avg 6µs/call | ||||
| 149 | 3 | 900ns | my ( $self, $adapter_name ) = @_; | ||
| 150 | 3 | 600ns | return $Log::Any::OverrideDefaultAdapterClass if $Log::Any::OverrideDefaultAdapterClass; | ||
| 151 | 3 | 9µs | 3 | 2µs | $adapter_name =~ s/^Log:://; # Log::Dispatch -> Dispatch, etc. # spent 2µs making 3 calls to Log::Any::Manager::CORE:subst, avg 800ns/call |
| 152 | 3 | 5µs | my $adapter_class = ( | ||
| 153 | substr( $adapter_name, 0, 1 ) eq '+' | ||||
| 154 | ? substr( $adapter_name, 1 ) | ||||
| 155 | : "Log::Any::Adapter::$adapter_name" | ||||
| 156 | ); | ||||
| 157 | 3 | 6µs | return $adapter_class; | ||
| 158 | } | ||||
| 159 | |||||
| 160 | # This is adapted from the pure perl parts of Devel::GlobalDestruction | ||||
| 161 | 1 | 900ns | if ( defined ${^GLOBAL_PHASE} ) { | ||
| 162 | 1 | 18µs | eval 'sub _in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' ## no critic # spent 2µs executing statements in string eval | ||
| 163 | or die $@; | ||||
| 164 | } | ||||
| 165 | else { | ||||
| 166 | require B; | ||||
| 167 | my $started = !B::main_start()->isa(q[B::NULL]); | ||||
| 168 | unless ($started) { | ||||
| 169 | eval '0 && $started; CHECK { $started = 1 }; 1' ## no critic | ||||
| 170 | or die $@; | ||||
| 171 | } | ||||
| 172 | eval ## no critic | ||||
| 173 | '0 && $started; sub _in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1' | ||||
| 174 | or die $@; | ||||
| 175 | } | ||||
| 176 | |||||
| 177 | # XXX not DRY and not a great way to do this, but oh, well. | ||||
| 178 | # spent 577µs (197+380) within Log::Any::Manager::_require_dynamic which was called 3 times, avg 192µs/call:
# 3 times (197µs+380µs) by Log::Any::Manager::_choose_entry_for_category at line 52, avg 192µs/call | ||||
| 179 | 3 | 800ns | my ($class) = @_; | ||
| 180 | |||||
| 181 | 3 | 25µs | 3 | 6µs | return 1 if $class->can('new'); # duck-type that class is loaded # spent 6µs making 3 calls to UNIVERSAL::can, avg 2µs/call |
| 182 | |||||
| 183 | 1 | 17µs | unless ( defined( eval "require $class; 1" ) ) # spent 33µs executing statements in string eval | ||
| 184 | { ## no critic (ProhibitStringyEval) | ||||
| 185 | die $@; | ||||
| 186 | } | ||||
| 187 | } | ||||
| 188 | |||||
| 189 | package # hide from PAUSE | ||||
| 190 | Log::Any::Manager::_Guard; | ||||
| 191 | |||||
| 192 | sub new { bless $_[1], $_[0] } | ||||
| 193 | |||||
| 194 | sub DESTROY { $_[0]->() } | ||||
| 195 | |||||
| 196 | 1 | 4µs | 1; | ||
# spent 2µs within Log::Any::Manager::CORE:subst which was called 3 times, avg 800ns/call:
# 3 times (2µs+0s) by Log::Any::Manager::_get_adapter_class at line 151, avg 800ns/call |