| Filename | /usr/local/share/perl/5.18.2/Package/DeprecationManager.pm |
| Statements | Executed 78 statements in 896µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 416µs | 804µs | Package::DeprecationManager::BEGIN@10 |
| 2 | 2 | 2 | 206µs | 385µs | Package::DeprecationManager::import |
| 5 | 5 | 5 | 25µs | 25µs | Package::DeprecationManager::__ANON__[:61] |
| 1 | 1 | 1 | 15µs | 18µs | Package::DeprecationManager::BEGIN@7 |
| 2 | 1 | 1 | 15µs | 15µs | Package::DeprecationManager::_build_warn |
| 1 | 1 | 1 | 10µs | 14µs | Package::DeprecationManager::BEGIN@12 |
| 1 | 1 | 1 | 10µs | 19µs | Package::DeprecationManager::BEGIN@6 |
| 1 | 1 | 1 | 10µs | 74µs | Package::DeprecationManager::BEGIN@11 |
| 2 | 1 | 1 | 8µs | 8µs | Package::DeprecationManager::_build_import |
| 1 | 1 | 1 | 6µs | 26µ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 | 1µs | $Package::DeprecationManager::VERSION = '0.13'; | ||
| 4 | } | ||||
| 5 | |||||
| 6 | 2 | 18µs | 2 | 28µs | # spent 19µs (10+9) within Package::DeprecationManager::BEGIN@6 which was called:
# once (10µs+9µs) by Moose::Deprecated::BEGIN@7 at line 6 # spent 19µs making 1 call to Package::DeprecationManager::BEGIN@6
# spent 9µs making 1 call to strict::import |
| 7 | 2 | 21µs | 2 | 20µs | # spent 18µs (15+3) within Package::DeprecationManager::BEGIN@7 which was called:
# once (15µs+3µs) by Moose::Deprecated::BEGIN@7 at line 7 # spent 18µs making 1 call to Package::DeprecationManager::BEGIN@7
# spent 3µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 2 | 25µs | 2 | 47µs | # spent 26µs (6+21) within Package::DeprecationManager::BEGIN@9 which was called:
# once (6µs+21µs) by Moose::Deprecated::BEGIN@7 at line 9 # spent 26µs making 1 call to Package::DeprecationManager::BEGIN@9
# spent 21µs making 1 call to Exporter::import |
| 10 | 2 | 81µs | 2 | 869µs | # spent 804µs (416+387) within Package::DeprecationManager::BEGIN@10 which was called:
# once (416µs+387µs) by Moose::Deprecated::BEGIN@7 at line 10 # spent 804µs making 1 call to Package::DeprecationManager::BEGIN@10
# spent 66µs making 1 call to Exporter::import |
| 11 | 2 | 24µs | 2 | 138µs | # spent 74µs (10+64) within Package::DeprecationManager::BEGIN@11 which was called:
# once (10µs+64µs) by Moose::Deprecated::BEGIN@7 at line 11 # spent 74µs making 1 call to Package::DeprecationManager::BEGIN@11
# spent 64µs making 1 call to Exporter::import |
| 12 | 2 | 455µs | 2 | 19µs | # spent 14µs (10+4) within Package::DeprecationManager::BEGIN@12 which was called:
# once (10µs+4µs) by Moose::Deprecated::BEGIN@7 at line 12 # spent 14µs making 1 call to Package::DeprecationManager::BEGIN@12
# spent 4µs making 1 call to Sub::Install::__ANON__[Sub/Install.pm:270] |
| 13 | |||||
| 14 | # spent 385µs (206+179) within Package::DeprecationManager::import which was called 2 times, avg 193µs/call:
# once (181µs+87µs) by Moose::Deprecated::BEGIN@7 at line 7 of Moose/Deprecated.pm
# once (25µs+92µs) by Class::MOP::Deprecated::BEGIN@7 at line 7 of Class/MOP/Deprecated.pm | ||||
| 15 | 2 | 400ns | shift; | ||
| 16 | 2 | 3µs | my %args = @_; | ||
| 17 | |||||
| 18 | 2 | 170µs | 2 | 4µs | croak # spent 4µs making 2 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 | 2 | 600ns | my %registry; | ||
| 23 | |||||
| 24 | 2 | 3µs | 2 | 8µs | my $import = _build_import( \%registry ); # spent 8µs making 2 calls to Package::DeprecationManager::_build_import, avg 4µs/call |
| 25 | 2 | 6µs | 2 | 15µs | my $warn = _build_warn( \%registry, $args{-deprecations}, $args{-ignore} ); # spent 15µs making 2 calls to Package::DeprecationManager::_build_warn, avg 7µs/call |
| 26 | |||||
| 27 | 2 | 2µs | my $caller = caller(); | ||
| 28 | |||||
| 29 | 2 | 8µs | 2 | 102µs | Sub::Install::install_sub( # spent 102µs making 2 calls to Sub::Install::__ANON__[Sub/Install.pm:118], avg 51µs/call |
| 30 | { | ||||
| 31 | code => $import, | ||||
| 32 | into => $caller, | ||||
| 33 | as => 'import', | ||||
| 34 | } | ||||
| 35 | ); | ||||
| 36 | |||||
| 37 | 2 | 5µs | 2 | 49µs | Sub::Install::install_sub( # spent 49µs making 2 calls to Sub::Install::__ANON__[Sub/Install.pm:118], avg 24µs/call |
| 38 | { | ||||
| 39 | code => $warn, | ||||
| 40 | into => $caller, | ||||
| 41 | as => 'deprecated', | ||||
| 42 | } | ||||
| 43 | ); | ||||
| 44 | |||||
| 45 | 2 | 6µs | return; | ||
| 46 | } | ||||
| 47 | |||||
| 48 | # spent 8µs within Package::DeprecationManager::_build_import which was called 2 times, avg 4µs/call:
# 2 times (8µs+0s) by Package::DeprecationManager::import at line 24, avg 4µs/call | ||||
| 49 | 2 | 700ns | my $registry = shift; | ||
| 50 | |||||
| 51 | # spent 25µs within Package::DeprecationManager::__ANON__[/usr/local/share/perl/5.18.2/Package/DeprecationManager.pm:61] which was called 5 times, avg 5µs/call:
# once (6µs+0s) by Moose::Meta::Attribute::BEGIN@12 at line 12 of Moose/Meta/Attribute.pm
# once (6µs+0s) by Moose::Util::MetaRole::BEGIN@9 at line 9 of Moose/Util/MetaRole.pm
# once (5µs+0s) by Moose::Meta::Attribute::Native::Trait::BEGIN@6 at line 6 of Moose/Meta/Attribute/Native/Trait.pm
# once (5µs+0s) by Moose::BEGIN@14 at line 14 of Moose.pm
# once (4µs+0s) by Moose::Util::TypeConstraints::BEGIN@7 at line 7 of Moose/Util/TypeConstraints.pm | ||||
| 52 | 5 | 2µs | my $class = shift; | ||
| 53 | 5 | 4µs | my %args = @_; | ||
| 54 | |||||
| 55 | 5 | 9µs | $args{-api_version} ||= delete $args{-compatible}; | ||
| 56 | |||||
| 57 | 5 | 2µs | $registry->{ caller() } = $args{-api_version} | ||
| 58 | if $args{-api_version}; | ||||
| 59 | |||||
| 60 | 5 | 19µs | return; | ||
| 61 | 2 | 11µs | }; | ||
| 62 | } | ||||
| 63 | |||||
| 64 | # spent 15µs within Package::DeprecationManager::_build_warn which was called 2 times, avg 7µs/call:
# 2 times (15µs+0s) by Package::DeprecationManager::import at line 25, avg 7µs/call | ||||
| 65 | 2 | 500ns | my $registry = shift; | ||
| 66 | 2 | 200ns | my $deprecated_at = shift; | ||
| 67 | 2 | 800ns | my $ignore = shift; | ||
| 68 | |||||
| 69 | 2 | 3µs | my %ignore = map { $_ => 1 } grep { !ref } @{ $ignore || [] }; | ||
| 70 | 2 | 2µs | my @ignore_res = grep {ref} @{ $ignore || [] }; | ||
| 71 | |||||
| 72 | 2 | 200ns | 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 | 2 | 11µs | }; | ||
| 124 | } | ||||
| 125 | |||||
| 126 | 1 | 2µ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__ |