| File | /usr/local/share/perl/5.10.0/Package/DeprecationManager.pm |
| Statements Executed | 89 |
| Total Time | 0.0011323 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 6 | 6 | 6 | 123µs | 123µs | Package::DeprecationManager::__ANON__[:61] |
| 2 | 2 | 2 | 62µs | 448µs | Package::DeprecationManager::import |
| 2 | 1 | 1 | 55µs | 55µs | Package::DeprecationManager::_build_warn |
| 2 | 1 | 1 | 23µs | 23µs | Package::DeprecationManager::_build_import |
| 0 | 0 | 0 | 0s | 0s | Package::DeprecationManager::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Package::DeprecationManager::__ANON__[:123] |
| 0 | 0 | 0 | 0s | 0s | Package::DeprecationManager::__ANON__[:83] |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Package::DeprecationManager; | |||
| 2 | BEGIN { | |||
| 3 | 1 | 1µs | 1µs | $Package::DeprecationManager::VERSION = '0.09'; |
| 4 | 1 | 24µs | 24µs | } |
| 5 | ||||
| 6 | 3 | 33µs | 11µs | use strict; # spent 12µs making 1 call to strict::import |
| 7 | 3 | 35µs | 12µs | use warnings; # spent 29µs making 1 call to warnings::import |
| 8 | ||||
| 9 | 3 | 33µs | 11µs | use Carp qw( croak ); # spent 51µs making 1 call to Exporter::import |
| 10 | 3 | 28µs | 9µs | use List::MoreUtils qw( any ); # spent 41µs making 1 call to Exporter::import |
| 11 | 3 | 36µs | 12µs | use Params::Util qw( _HASH ); # spent 80µs making 1 call to Exporter::import |
| 12 | 3 | 705µs | 235µs | use Sub::Install; # spent 10µs making 1 call to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:284] |
| 13 | ||||
| 14 | # spent 448µs (62+386) within Package::DeprecationManager::import which was called 2 times, avg 224µs/call:
# once (30µs+196µs) by Class::MOP::Deprecated::BEGIN at line 10 of /usr/local/lib/perl/5.10.0/Class/MOP/Deprecated.pm
# once (32µs+190µs) by Moose::Deprecated::BEGIN at line 10 of /usr/local/lib/perl/5.10.0/Moose/Deprecated.pm | |||
| 15 | 20 | 93µs | 5µs | shift; |
| 16 | my %args = @_; | |||
| 17 | ||||
| 18 | croak # spent 13µs making 2 calls to Params::Util::_HASH, avg 7µs/call | |||
| 19 | 'You must provide a hash reference -deprecations parameter when importing Package::DeprecationManager' | |||
| 20 | unless $args{-deprecations} && _HASH( $args{-deprecations} ); | |||
| 21 | ||||
| 22 | my %registry; | |||
| 23 | ||||
| 24 | my $import = _build_import( \%registry ); # spent 23µs making 2 calls to Package::DeprecationManager::_build_import, avg 11µs/call | |||
| 25 | my $warn = _build_warn( \%registry, $args{-deprecations}, $args{-ignore} ); # spent 55µs making 2 calls to Package::DeprecationManager::_build_warn, avg 28µs/call | |||
| 26 | ||||
| 27 | my $caller = caller(); | |||
| 28 | ||||
| 29 | Sub::Install::install_sub( # spent 158µs making 2 calls to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:132], avg 79µs/call | |||
| 30 | { | |||
| 31 | code => $import, | |||
| 32 | into => $caller, | |||
| 33 | as => 'import', | |||
| 34 | } | |||
| 35 | ); | |||
| 36 | ||||
| 37 | Sub::Install::install_sub( # spent 137µs making 2 calls to Sub::Install::__ANON__[/usr/local/share/perl/5.10.0/Sub/Install.pm:132], avg 69µs/call | |||
| 38 | { | |||
| 39 | code => $warn, | |||
| 40 | into => $caller, | |||
| 41 | as => 'deprecated', | |||
| 42 | } | |||
| 43 | ); | |||
| 44 | ||||
| 45 | return; | |||
| 46 | } | |||
| 47 | ||||
| 48 | # spent 23µs within Package::DeprecationManager::_build_import which was called 2 times, avg 11µs/call:
# 2 times (23µs+0s) by Package::DeprecationManager::import at line 24, avg 11µs/call | |||
| 49 | 4 | 16µs | 4µs | my $registry = shift; |
| 50 | ||||
| 51 | # spent 123µs within Package::DeprecationManager::__ANON__[/usr/local/share/perl/5.10.0/Package/DeprecationManager.pm:61] which was called 6 times, avg 21µs/call:
# once (44µs+0s) at line 28 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints.pm
# once (19µs+0s) at line 14 of /usr/local/lib/perl/5.10.0/Moose.pm
# once (17µs+0s) by Moose::Util::MetaRole::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Util/MetaRole.pm
# once (16µs+0s) at line 7 of /usr/local/lib/perl/5.10.0/Moose/Util/TypeConstraints/OptimizedConstraints.pm
# once (15µs+0s) at line 15 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm
# once (13µs+0s) at line 13 of /usr/local/lib/perl/5.10.0/Moose/Exporter.pm | |||
| 52 | 30 | 76µs | 3µ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 55µs within Package::DeprecationManager::_build_warn which was called 2 times, avg 28µs/call:
# 2 times (55µs+0s) by Package::DeprecationManager::import at line 25, avg 28µs/call | |||
| 65 | 14 | 48µs | 3µ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 | 4µs | 4µs | 1; |
| 127 | ||||
| 128 | # ABSTRACT: Manage deprecation warnings for your distribution | |||
| 129 | ||||
| 130 | ||||
| 131 | ||||
| 132 | =pod | |||
| 133 | ||||
| 134 | =head1 NAME | |||
| 135 | ||||
| 136 | Package::DeprecationManager - Manage deprecation warnings for your distribution | |||
| 137 | ||||
| 138 | =head1 VERSION | |||
| 139 | ||||
| 140 | version 0.09 | |||
| 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()->far(); # 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 severaldifferent error messages for the | |||
| 228 | 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) 2010 by Dave Rolsky. | |||
| 267 | ||||
| 268 | This is free software, licensed under: | |||
| 269 | ||||
| 270 | The Artistic License 2.0 | |||
| 271 | ||||
| 272 | =cut | |||
| 273 | ||||
| 274 | ||||
| 275 | __END__ | |||
| 276 |