| Filename | /Users/ap13/perl5/lib/perl5/Package/DeprecationManager.pm |
| Statements | Executed 102 statements in 1.43ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 822µs | 1.76ms | Package::DeprecationManager::BEGIN@10 |
| 3 | 3 | 3 | 127µs | 540µs | Package::DeprecationManager::import |
| 6 | 6 | 6 | 58µs | 58µs | Package::DeprecationManager::__ANON__[:61] |
| 3 | 1 | 1 | 42µs | 42µs | Package::DeprecationManager::_build_warn |
| 3 | 1 | 1 | 20µs | 20µs | Package::DeprecationManager::_build_import |
| 1 | 1 | 1 | 19µs | 38µs | Package::DeprecationManager::BEGIN@6 |
| 1 | 1 | 1 | 17µs | 142µs | Package::DeprecationManager::BEGIN@11 |
| 1 | 1 | 1 | 15µs | 23µs | Package::DeprecationManager::BEGIN@12 |
| 1 | 1 | 1 | 12µs | 17µs | Package::DeprecationManager::BEGIN@7 |
| 1 | 1 | 1 | 11µs | 47µs | Package::DeprecationManager::BEGIN@9 |
| 0 | 0 | 0 | 0s | 0s | Package::DeprecationManager::__ANON__[:123] |
| 0 | 0 | 0 | 0s | 0s | Package::DeprecationManager::__ANON__[:83] |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Package::DeprecationManager; | ||||
| 2 | { | ||||
| 3 | 2 | 2µs | $Package::DeprecationManager::VERSION = '0.13'; | ||
| 4 | } | ||||
| 5 | |||||
| 6 | 2 | 37µs | 2 | 56µs | # spent 38µs (19+19) within Package::DeprecationManager::BEGIN@6 which was called:
# once (19µs+19µs) by Moose::Deprecated::BEGIN@7 at line 6 # spent 38µs making 1 call to Package::DeprecationManager::BEGIN@6
# spent 19µs making 1 call to strict::import |
| 7 | 2 | 38µs | 2 | 23µs | # spent 17µs (12+6) within Package::DeprecationManager::BEGIN@7 which was called:
# once (12µs+6µs) by Moose::Deprecated::BEGIN@7 at line 7 # spent 17µs making 1 call to Package::DeprecationManager::BEGIN@7
# spent 6µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 2 | 41µs | 2 | 84µs | # spent 47µs (11+36) within Package::DeprecationManager::BEGIN@9 which was called:
# once (11µs+36µs) by Moose::Deprecated::BEGIN@7 at line 9 # spent 47µs making 1 call to Package::DeprecationManager::BEGIN@9
# spent 36µs making 1 call to Exporter::import |
| 10 | 2 | 169µs | 2 | 1.92ms | # spent 1.76ms (822µs+941µs) within Package::DeprecationManager::BEGIN@10 which was called:
# once (822µs+941µs) by Moose::Deprecated::BEGIN@7 at line 10 # spent 1.76ms making 1 call to Package::DeprecationManager::BEGIN@10
# spent 161µs making 1 call to Exporter::import |
| 11 | 2 | 44µs | 2 | 267µs | # spent 142µs (17+125) within Package::DeprecationManager::BEGIN@11 which was called:
# once (17µs+125µs) by Moose::Deprecated::BEGIN@7 at line 11 # spent 142µs making 1 call to Package::DeprecationManager::BEGIN@11
# spent 125µs making 1 call to Exporter::import |
| 12 | 2 | 840µs | 2 | 30µs | # spent 23µs (15+7) within Package::DeprecationManager::BEGIN@12 which was called:
# once (15µs+7µs) by Moose::Deprecated::BEGIN@7 at line 12 # spent 23µs making 1 call to Package::DeprecationManager::BEGIN@12
# spent 7µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:284] |
| 13 | |||||
| 14 | # spent 540µs (127+413) within Package::DeprecationManager::import which was called 3 times, avg 180µs/call:
# once (49µs+156µs) by Moose::Deprecated::BEGIN@7 at line 12 of Moose/Deprecated.pm
# once (45µs+149µs) by Package::Stash::BEGIN@35 at line 43 of Package/Stash.pm
# once (33µs+108µs) by Class::MOP::Deprecated::BEGIN@7 at line 9 of Class/MOP/Deprecated.pm | ||||
| 15 | 30 | 114µs | shift; | ||
| 16 | my %args = @_; | ||||
| 17 | |||||
| 18 | 3 | 5µs | croak # spent 5µs making 3 calls to Params::Util::_HASH0, avg 2µs/call | ||
| 19 | 'You must provide a hash reference -deprecations parameter when importing Package::DeprecationManager' | ||||
| 20 | unless $args{-deprecations} && _HASH0( $args{-deprecations} ); | ||||
| 21 | |||||
| 22 | my %registry; | ||||
| 23 | |||||
| 24 | 3 | 20µs | my $import = _build_import( \%registry ); # spent 20µs making 3 calls to Package::DeprecationManager::_build_import, avg 7µs/call | ||
| 25 | 3 | 42µs | my $warn = _build_warn( \%registry, $args{-deprecations}, $args{-ignore} ); # spent 42µs making 3 calls to Package::DeprecationManager::_build_warn, avg 14µs/call | ||
| 26 | |||||
| 27 | my $caller = caller(); | ||||
| 28 | |||||
| 29 | 3 | 232µs | Sub::Install::install_sub( # spent 232µs making 3 calls to Sub::Install::__ANON__[Sub/Install.pm:132], avg 77µs/call | ||
| 30 | { | ||||
| 31 | code => $import, | ||||
| 32 | into => $caller, | ||||
| 33 | as => 'import', | ||||
| 34 | } | ||||
| 35 | ); | ||||
| 36 | |||||
| 37 | 3 | 114µs | Sub::Install::install_sub( # spent 114µs making 3 calls to Sub::Install::__ANON__[Sub/Install.pm:132], avg 38µs/call | ||
| 38 | { | ||||
| 39 | code => $warn, | ||||
| 40 | into => $caller, | ||||
| 41 | as => 'deprecated', | ||||
| 42 | } | ||||
| 43 | ); | ||||
| 44 | |||||
| 45 | return; | ||||
| 46 | } | ||||
| 47 | |||||
| 48 | # spent 20µs within Package::DeprecationManager::_build_import which was called 3 times, avg 7µs/call:
# 3 times (20µs+0s) by Package::DeprecationManager::import at line 24, avg 7µs/call | ||||
| 49 | 6 | 25µs | my $registry = shift; | ||
| 50 | |||||
| 51 | # spent 58µs within Package::DeprecationManager::__ANON__[/Users/ap13/perl5/lib/perl5/Package/DeprecationManager.pm:61] which was called 6 times, avg 10µs/call:
# once (12µs+0s) by Moose::Util::MetaRole::BEGIN@9 at line 9 of Moose/Util/MetaRole.pm
# once (12µs+0s) by Devel::OverloadInfo::BEGIN@19 at line 19 of Devel/OverloadInfo.pm
# once (12µs+0s) by Class::MOP::Package::BEGIN@10 at line 10 of Class/MOP/Package.pm
# once (9µs+0s) by Moose::BEGIN@14 at line 14 of Moose.pm
# once (8µs+0s) by Moose::Meta::Attribute::BEGIN@12 at line 12 of Moose/Meta/Attribute.pm
# once (5µs+0s) by Moose::Util::TypeConstraints::BEGIN@7 at line 7 of Moose/Util/TypeConstraints.pm | ||||
| 52 | 30 | 72µs | my $class = shift; | ||
| 53 | my %args = @_; | ||||
| 54 | |||||
| 55 | $args{-api_version} ||= delete $args{-compatible}; | ||||
| 56 | |||||
| 57 | $registry->{ caller() } = $args{-api_version} | ||||
| 58 | if $args{-api_version}; | ||||
| 59 | |||||
| 60 | return; | ||||
| 61 | }; | ||||
| 62 | } | ||||
| 63 | |||||
| 64 | # spent 42µs within Package::DeprecationManager::_build_warn which was called 3 times, avg 14µs/call:
# 3 times (42µs+0s) by Package::DeprecationManager::import at line 25, avg 14µs/call | ||||
| 65 | 21 | 46µs | my $registry = shift; | ||
| 66 | my $deprecated_at = shift; | ||||
| 67 | my $ignore = shift; | ||||
| 68 | |||||
| 69 | my %ignore = map { $_ => 1 } grep { !ref } @{ $ignore || [] }; | ||||
| 70 | my @ignore_res = grep {ref} @{ $ignore || [] }; | ||||
| 71 | |||||
| 72 | my %warned; | ||||
| 73 | |||||
| 74 | return sub { | ||||
| 75 | my %args = @_ < 2 ? ( message => shift ) : @_; | ||||
| 76 | |||||
| 77 | my ( $package, undef, undef, $sub ) = caller(1); | ||||
| 78 | |||||
| 79 | my $skipped = 1; | ||||
| 80 | |||||
| 81 | if ( @ignore_res || keys %ignore ) { | ||||
| 82 | while ( defined $package | ||||
| 83 | && ( $ignore{$package} || any { $package =~ $_ } @ignore_res ) | ||||
| 84 | ) { | ||||
| 85 | $package = caller( $skipped++ ); | ||||
| 86 | } | ||||
| 87 | } | ||||
| 88 | |||||
| 89 | $package = 'unknown package' unless defined $package; | ||||
| 90 | |||||
| 91 | unless ( defined $args{feature} ) { | ||||
| 92 | $args{feature} = $sub; | ||||
| 93 | } | ||||
| 94 | |||||
| 95 | my $compat_version = $registry->{$package}; | ||||
| 96 | |||||
| 97 | my $deprecated_at = $deprecated_at->{ $args{feature} }; | ||||
| 98 | |||||
| 99 | return | ||||
| 100 | if defined $compat_version | ||||
| 101 | && defined $deprecated_at | ||||
| 102 | && $compat_version lt $deprecated_at; | ||||
| 103 | |||||
| 104 | my $msg; | ||||
| 105 | if ( defined $args{message} ) { | ||||
| 106 | $msg = $args{message}; | ||||
| 107 | } | ||||
| 108 | else { | ||||
| 109 | $msg = "$args{feature} has been deprecated"; | ||||
| 110 | $msg .= " since version $deprecated_at" | ||||
| 111 | if defined $deprecated_at; | ||||
| 112 | } | ||||
| 113 | |||||
| 114 | return if $warned{$package}{ $args{feature} }{$msg}; | ||||
| 115 | |||||
| 116 | $warned{$package}{ $args{feature} }{$msg} = 1; | ||||
| 117 | |||||
| 118 | # We skip at least two levels. One for this anon sub, and one for the | ||||
| 119 | # sub calling it. | ||||
| 120 | local $Carp::CarpLevel = $Carp::CarpLevel + $skipped; | ||||
| 121 | |||||
| 122 | Carp::cluck($msg); | ||||
| 123 | }; | ||||
| 124 | } | ||||
| 125 | |||||
| 126 | 1 | 5µs | 1; | ||
| 127 | |||||
| 128 | # ABSTRACT: Manage deprecation warnings for your distribution | ||||
| 129 | |||||
| - - | |||||
| 132 | =pod | ||||
| 133 | |||||
| 134 | =head1 NAME | ||||
| 135 | |||||
| 136 | Package::DeprecationManager - Manage deprecation warnings for your distribution | ||||
| 137 | |||||
| 138 | =head1 VERSION | ||||
| 139 | |||||
| 140 | version 0.13 | ||||
| 141 | |||||
| 142 | =head1 SYNOPSIS | ||||
| 143 | |||||
| 144 | package My::Class; | ||||
| 145 | |||||
| 146 | use Package::DeprecationManager -deprecations => { | ||||
| 147 | 'My::Class::foo' => '0.02', | ||||
| 148 | 'My::Class::bar' => '0.05', | ||||
| 149 | 'feature-X' => '0.07', | ||||
| 150 | }; | ||||
| 151 | |||||
| 152 | sub foo { | ||||
| 153 | deprecated( 'Do not call foo!' ); | ||||
| 154 | |||||
| 155 | ... | ||||
| 156 | } | ||||
| 157 | |||||
| 158 | sub bar { | ||||
| 159 | deprecated(); | ||||
| 160 | |||||
| 161 | ... | ||||
| 162 | } | ||||
| 163 | |||||
| 164 | sub baz { | ||||
| 165 | my %args = @_; | ||||
| 166 | |||||
| 167 | if ( $args{foo} ) { | ||||
| 168 | deprecated( | ||||
| 169 | message => ..., | ||||
| 170 | feature => 'feature-X', | ||||
| 171 | ); | ||||
| 172 | } | ||||
| 173 | } | ||||
| 174 | |||||
| 175 | package Other::Class; | ||||
| 176 | |||||
| 177 | use My::Class -api_version => '0.04'; | ||||
| 178 | |||||
| 179 | My::Class->new()->foo(); # warns | ||||
| 180 | My::Class->new()->bar(); # does not warn | ||||
| 181 | My::Class->new()->bar(); # does not warn again | ||||
| 182 | |||||
| 183 | =head1 DESCRIPTION | ||||
| 184 | |||||
| 185 | This module allows you to manage a set of deprecations for one or more modules. | ||||
| 186 | |||||
| 187 | When you import C<Package::DeprecationManager>, you must provide a set of | ||||
| 188 | C<-deprecations> as a hash ref. The keys are "feature" names, and the values | ||||
| 189 | are the version when that feature was deprecated. | ||||
| 190 | |||||
| 191 | In many cases, you can simply use the fully qualified name of a subroutine or | ||||
| 192 | method as the feature name. This works for cases where the whole subroutine is | ||||
| 193 | deprecated. However, the feature names can be any string. This is useful if | ||||
| 194 | you don't want to deprecate an entire subroutine, just a certain usage. | ||||
| 195 | |||||
| 196 | You can also provide an optional array reference in the C<-ignore> | ||||
| 197 | parameter. | ||||
| 198 | |||||
| 199 | The values to be ignored can be package names or regular expressions (made | ||||
| 200 | with C<qr//>). Use this to ignore packages in your distribution that can | ||||
| 201 | appear on the call stack when a deprecated feature is used. | ||||
| 202 | |||||
| 203 | As part of the import process, C<Package::DeprecationManager> will export two | ||||
| 204 | subroutines into its caller. It provides an C<import()> sub for the caller and a | ||||
| 205 | C<deprecated()> sub. | ||||
| 206 | |||||
| 207 | The C<import()> sub allows callers of I<your> class to specify an C<-api_version> | ||||
| 208 | parameter. If this is supplied, then deprecation warnings are only issued for | ||||
| 209 | deprecations for api versions earlier than the one specified. | ||||
| 210 | |||||
| 211 | You must call the C<deprecated()> sub in each deprecated subroutine. When | ||||
| 212 | called, it will issue a warning using C<Carp::cluck()>. | ||||
| 213 | |||||
| 214 | The C<deprecated()> sub can be called in several ways. If you do not pass any | ||||
| 215 | arguments, it will generate an appropriate warning message. If you pass a | ||||
| 216 | single argument, this is used as the warning message. | ||||
| 217 | |||||
| 218 | Finally, you can call it with named arguments. Currently, the only allowed | ||||
| 219 | names are C<message> and C<feature>. The C<feature> argument should correspond | ||||
| 220 | to the feature name passed in the C<-deprecations> hash. | ||||
| 221 | |||||
| 222 | If you don't explicitly specify a feature, the C<deprecated()> sub uses | ||||
| 223 | C<caller()> to identify its caller, using its fully qualified subroutine name. | ||||
| 224 | |||||
| 225 | A given deprecation warning is only issued once for a given package. This | ||||
| 226 | module tracks this based on both the feature name I<and> the error message | ||||
| 227 | itself. This means that if you provide several different error messages for | ||||
| 228 | the same feature, all of those errors will appear. | ||||
| 229 | |||||
| 230 | =head1 BUGS | ||||
| 231 | |||||
| 232 | Please report any bugs or feature requests to | ||||
| 233 | C<bug-package-deprecationmanager@rt.cpan.org>, or through the web interface at | ||||
| 234 | L<http://rt.cpan.org>. I will be notified, and then you'll automatically be | ||||
| 235 | notified of progress on your bug as I make changes. | ||||
| 236 | |||||
| 237 | =head1 DONATIONS | ||||
| 238 | |||||
| 239 | If you'd like to thank me for the work I've done on this module, please | ||||
| 240 | consider making a "donation" to me via PayPal. I spend a lot of free time | ||||
| 241 | creating free software, and would appreciate any support you'd care to offer. | ||||
| 242 | |||||
| 243 | Please note that B<I am not suggesting that you must do this> in order | ||||
| 244 | for me to continue working on this particular software. I will | ||||
| 245 | continue to do so, inasmuch as I have in the past, for as long as it | ||||
| 246 | interests me. | ||||
| 247 | |||||
| 248 | Similarly, a donation made in this way will probably not make me work on this | ||||
| 249 | software much more, unless I get so many donations that I can consider working | ||||
| 250 | on free software full time, which seems unlikely at best. | ||||
| 251 | |||||
| 252 | To donate, log into PayPal and send money to autarch@urth.org or use the | ||||
| 253 | button on this page: L<http://www.urth.org/~autarch/fs-donation.html> | ||||
| 254 | |||||
| 255 | =head1 CREDITS | ||||
| 256 | |||||
| 257 | The idea for this functionality and some of its implementation was originally | ||||
| 258 | created as L<Class::MOP::Deprecated> by Goro Fuji. | ||||
| 259 | |||||
| 260 | =head1 AUTHOR | ||||
| 261 | |||||
| 262 | Dave Rolsky <autarch@urth.org> | ||||
| 263 | |||||
| 264 | =head1 COPYRIGHT AND LICENSE | ||||
| 265 | |||||
| 266 | This software is Copyright (c) 2012 by Dave Rolsky. | ||||
| 267 | |||||
| 268 | This is free software, licensed under: | ||||
| 269 | |||||
| 270 | The Artistic License 2.0 (GPL Compatible) | ||||
| 271 | |||||
| 272 | =cut | ||||
| 273 | |||||
| 274 | |||||
| 275 | __END__ |