| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Class/Load.pm |
| Statements | Executed 23 statements in 880µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 654µs | 752µs | Class::Load::BEGIN@9 |
| 1 | 1 | 1 | 605µs | 1.73ms | Class::Load::BEGIN@11 |
| 1 | 1 | 1 | 467µs | 4.47ms | Class::Load::BEGIN@10 |
| 1 | 1 | 1 | 10µs | 12µs | Moose::BEGIN@1 |
| 1 | 1 | 1 | 6µs | 11µs | Class::Load::BEGIN@12 |
| 1 | 1 | 1 | 4µs | 9µs | Moose::BEGIN@2 |
| 1 | 1 | 1 | 4µs | 28µs | Class::Load::BEGIN@13 |
| 0 | 0 | 0 | 0s | 0s | Class::Load::__ANON__[:149] |
| 0 | 0 | 0 | 0s | 0s | Class::Load::__ANON__[:152] |
| 0 | 0 | 0 | 0s | 0s | Class::Load::__ANON__[:177] |
| 0 | 0 | 0 | 0s | 0s | Class::Load::__ANON__[:180] |
| 0 | 0 | 0 | 0s | 0s | Class::Load::_croak |
| 0 | 0 | 0 | 0s | 0s | Class::Load::_error |
| 0 | 0 | 0 | 0s | 0s | Class::Load::_nonexistent_fail_re |
| 0 | 0 | 0 | 0s | 0s | Class::Load::_or_list |
| 0 | 0 | 0 | 0s | 0s | Class::Load::_version_fail_re |
| 0 | 0 | 0 | 0s | 0s | Class::Load::load_class |
| 0 | 0 | 0 | 0s | 0s | Class::Load::load_first_existing_class |
| 0 | 0 | 0 | 0s | 0s | Class::Load::load_optional_class |
| 0 | 0 | 0 | 0s | 0s | Class::Load::try_load_class |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | 2 | 14µs | 2 | 14µs | # spent 12µs (10+2) within Moose::BEGIN@1 which was called:
# once (10µs+2µs) by Moose::BEGIN@12 at line 1 # spent 12µs making 1 call to Moose::BEGIN@1
# spent 2µs making 1 call to strict::import |
| 2 | 2 | 28µs | 2 | 14µs | # spent 9µs (4+5) within Moose::BEGIN@2 which was called:
# once (4µs+5µs) by Moose::BEGIN@12 at line 2 # spent 9µs making 1 call to Moose::BEGIN@2
# spent 5µs making 1 call to warnings::import |
| 3 | package Class::Load; # git description: v0.22-9-g29ebb54 | ||||
| 4 | # ABSTRACT: A working (require "Class::Name") and more | ||||
| 5 | # KEYWORDS: class module load require use runtime | ||||
| 6 | |||||
| 7 | 1 | 300ns | our $VERSION = '0.23'; | ||
| 8 | |||||
| 9 | 2 | 55µs | 2 | 802µs | # spent 752µs (654+98) within Class::Load::BEGIN@9 which was called:
# once (654µs+98µs) by Moose::BEGIN@12 at line 9 # spent 752µs making 1 call to Class::Load::BEGIN@9
# spent 50µs making 1 call to base::import |
| 10 | 2 | 63µs | 1 | 4.47ms | # spent 4.47ms (467µs+4.00) within Class::Load::BEGIN@10 which was called:
# once (467µs+4.00ms) by Moose::BEGIN@12 at line 10 # spent 4.47ms making 1 call to Class::Load::BEGIN@10 |
| 11 | 3 | 111µs | 2 | 1.74ms | # spent 1.73ms (605µs+1.13) within Class::Load::BEGIN@11 which was called:
# once (605µs+1.13ms) by Moose::BEGIN@12 at line 11 # spent 1.73ms making 1 call to Class::Load::BEGIN@11
# spent 10µs making 1 call to UNIVERSAL::VERSION |
| 12 | 3 | 21µs | 2 | 16µs | # spent 11µs (6+5) within Class::Load::BEGIN@12 which was called:
# once (6µs+5µs) by Moose::BEGIN@12 at line 12 # spent 11µs making 1 call to Class::Load::BEGIN@12
# spent 5µs making 1 call to UNIVERSAL::VERSION |
| 13 | 2 | 573µs | 2 | 51µs | # spent 28µs (4+24) within Class::Load::BEGIN@13 which was called:
# once (4µs+24µs) by Moose::BEGIN@12 at line 13 # spent 28µs making 1 call to Class::Load::BEGIN@13
# spent 24µs making 1 call to Exporter::import |
| 14 | |||||
| 15 | { | ||||
| 16 | 2 | 4µs | 1 | 19µs | my $loader = Module::Implementation::build_loader_sub( # spent 19µs making 1 call to Module::Implementation::build_loader_sub |
| 17 | implementations => [ 'XS', 'PP' ], | ||||
| 18 | symbols => ['is_class_loaded'], | ||||
| 19 | ); | ||||
| 20 | |||||
| 21 | 1 | 3µs | 1 | 473µs | $loader->(); # spent 473µs making 1 call to Module::Implementation::__ANON__[Module/Implementation.pm:52] |
| 22 | } | ||||
| 23 | |||||
| 24 | 1 | 1µs | our @EXPORT_OK = qw/load_class load_optional_class try_load_class is_class_loaded load_first_existing_class/; | ||
| 25 | 1 | 1µs | our %EXPORT_TAGS = ( | ||
| 26 | all => \@EXPORT_OK, | ||||
| 27 | ); | ||||
| 28 | |||||
| 29 | our $ERROR; | ||||
| 30 | |||||
| 31 | sub load_class { | ||||
| 32 | my $class = shift; | ||||
| 33 | my $options = shift; | ||||
| 34 | |||||
| 35 | my ($res, $e) = try_load_class($class, $options); | ||||
| 36 | return $class if $res; | ||||
| 37 | |||||
| 38 | _croak($e); | ||||
| 39 | } | ||||
| 40 | |||||
| 41 | sub load_first_existing_class { | ||||
| 42 | my $classes = Data::OptList::mkopt(\@_) | ||||
| 43 | or return; | ||||
| 44 | |||||
| 45 | foreach my $class (@{$classes}) { | ||||
| 46 | Module::Runtime::check_module_name($class->[0]); | ||||
| 47 | } | ||||
| 48 | |||||
| 49 | for my $class (@{$classes}) { | ||||
| 50 | my ($name, $options) = @{$class}; | ||||
| 51 | |||||
| 52 | # We need to be careful not to pass an undef $options to this sub, | ||||
| 53 | # since the XS version will blow up if that happens. | ||||
| 54 | return $name if is_class_loaded($name, ($options ? $options : ())); | ||||
| 55 | |||||
| 56 | my ($res, $e) = try_load_class($name, $options); | ||||
| 57 | |||||
| 58 | return $name if $res; | ||||
| 59 | |||||
| 60 | my $file = Module::Runtime::module_notional_filename($name); | ||||
| 61 | |||||
| 62 | next if $e =~ /^Can't locate \Q$file\E in \@INC/; | ||||
| 63 | next | ||||
| 64 | if $options | ||||
| 65 | && defined $options->{-version} | ||||
| 66 | && $e =~ _version_fail_re($name, $options->{-version}); | ||||
| 67 | |||||
| 68 | _croak("Couldn't load class ($name) because: $e"); | ||||
| 69 | } | ||||
| 70 | |||||
| 71 | my @list = map { | ||||
| 72 | $_->[0] | ||||
| 73 | . ( $_->[1] && defined $_->[1]{-version} | ||||
| 74 | ? " (version >= $_->[1]{-version})" | ||||
| 75 | : q{} ) | ||||
| 76 | } @{$classes}; | ||||
| 77 | |||||
| 78 | my $err | ||||
| 79 | .= q{Can't locate } | ||||
| 80 | . _or_list(@list) | ||||
| 81 | . " in \@INC (\@INC contains: @INC)."; | ||||
| 82 | _croak($err); | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | sub _version_fail_re { | ||||
| 86 | my $name = shift; | ||||
| 87 | my $vers = shift; | ||||
| 88 | |||||
| 89 | return qr/\Q$name\E version \Q$vers\E required--this is only version/; | ||||
| 90 | } | ||||
| 91 | |||||
| 92 | sub _nonexistent_fail_re { | ||||
| 93 | my $name = shift; | ||||
| 94 | |||||
| 95 | my $file = Module::Runtime::module_notional_filename($name); | ||||
| 96 | return qr/Can't locate \Q$file\E in \@INC/; | ||||
| 97 | } | ||||
| 98 | |||||
| 99 | sub _or_list { | ||||
| 100 | return $_[0] if @_ == 1; | ||||
| 101 | |||||
| 102 | return join ' or ', @_ if @_ ==2; | ||||
| 103 | |||||
| 104 | my $last = pop; | ||||
| 105 | |||||
| 106 | my $list = join ', ', @_; | ||||
| 107 | $list .= ', or ' . $last; | ||||
| 108 | |||||
| 109 | return $list; | ||||
| 110 | } | ||||
| 111 | |||||
| 112 | sub load_optional_class { | ||||
| 113 | my $class = shift; | ||||
| 114 | my $options = shift; | ||||
| 115 | |||||
| 116 | Module::Runtime::check_module_name($class); | ||||
| 117 | |||||
| 118 | my ($res, $e) = try_load_class($class, $options); | ||||
| 119 | return 1 if $res; | ||||
| 120 | |||||
| 121 | return 0 | ||||
| 122 | if $options | ||||
| 123 | && defined $options->{-version} | ||||
| 124 | && $e =~ _version_fail_re($class, $options->{-version}); | ||||
| 125 | |||||
| 126 | return 0 | ||||
| 127 | if $e =~ _nonexistent_fail_re($class); | ||||
| 128 | |||||
| 129 | _croak($e); | ||||
| 130 | } | ||||
| 131 | |||||
| 132 | sub try_load_class { | ||||
| 133 | my $class = shift; | ||||
| 134 | my $options = shift; | ||||
| 135 | |||||
| 136 | Module::Runtime::check_module_name($class); | ||||
| 137 | |||||
| 138 | local $@; | ||||
| 139 | undef $ERROR; | ||||
| 140 | |||||
| 141 | if (is_class_loaded($class)) { | ||||
| 142 | # We need to check this here rather than in is_class_loaded() because | ||||
| 143 | # we want to return the error message for a failed version check, but | ||||
| 144 | # is_class_loaded just returns true/false. | ||||
| 145 | return 1 unless $options && defined $options->{-version}; | ||||
| 146 | return try { | ||||
| 147 | $class->VERSION($options->{-version}); | ||||
| 148 | 1; | ||||
| 149 | } | ||||
| 150 | catch { | ||||
| 151 | _error($_); | ||||
| 152 | }; | ||||
| 153 | } | ||||
| 154 | |||||
| 155 | my $file = Module::Runtime::module_notional_filename($class); | ||||
| 156 | # This says "our diagnostics of the package | ||||
| 157 | # say perl's INC status about the file being loaded are | ||||
| 158 | # wrong", so we delete it from %INC, so when we call require(), | ||||
| 159 | # perl will *actually* try reloading the file. | ||||
| 160 | # | ||||
| 161 | # If the file is already in %INC, it won't retry, | ||||
| 162 | # And on 5.8, it won't fail either! | ||||
| 163 | # | ||||
| 164 | # The extra benefit of this trick, is it helps even on | ||||
| 165 | # 5.10, as instead of dying with "Compilation failed", | ||||
| 166 | # it will die with the actual error, and that's a win-win. | ||||
| 167 | delete $INC{$file}; | ||||
| 168 | return try { | ||||
| 169 | local $SIG{__DIE__} = 'DEFAULT'; | ||||
| 170 | if ($options && defined $options->{-version}) { | ||||
| 171 | Module::Runtime::use_module($class, $options->{-version}); | ||||
| 172 | } | ||||
| 173 | else { | ||||
| 174 | Module::Runtime::require_module($class); | ||||
| 175 | } | ||||
| 176 | 1; | ||||
| 177 | } | ||||
| 178 | catch { | ||||
| 179 | _error($_); | ||||
| 180 | }; | ||||
| 181 | } | ||||
| 182 | |||||
| 183 | sub _error { | ||||
| 184 | my $e = shift; | ||||
| 185 | |||||
| 186 | $e =~ s/ at .+?Runtime\.pm line [0-9]+\.$//; | ||||
| 187 | chomp $e; | ||||
| 188 | |||||
| 189 | $ERROR = $e; | ||||
| 190 | return 0 unless wantarray; | ||||
| 191 | return 0, $ERROR; | ||||
| 192 | } | ||||
| 193 | |||||
| 194 | sub _croak { | ||||
| 195 | require Carp; | ||||
| 196 | local $Carp::CarpLevel = $Carp::CarpLevel + 2; | ||||
| 197 | Carp::croak(shift); | ||||
| 198 | } | ||||
| 199 | |||||
| 200 | 1 | 4µs | 1; | ||
| 201 | |||||
| 202 | __END__ |