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 | __ANON__[:61] | Package::DeprecationManager::
2 | 2 | 2 | 62µs | 448µs | import | Package::DeprecationManager::
2 | 1 | 1 | 55µs | 55µs | _build_warn | Package::DeprecationManager::
2 | 1 | 1 | 23µs | 23µs | _build_import | Package::DeprecationManager::
0 | 0 | 0 | 0s | 0s | BEGIN | Package::DeprecationManager::
0 | 0 | 0 | 0s | 0s | __ANON__[:123] | Package::DeprecationManager::
0 | 0 | 0 | 0s | 0s | __ANON__[:83] | Package::DeprecationManager::
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 | 2 | 1µs | 700ns | shift; |
16 | 2 | 7µs | 3µs | my %args = @_; |
17 | ||||
18 | 2 | 19µs | 9µs | 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 | 2 | 800ns | 400ns | my %registry; |
23 | ||||
24 | 2 | 10µs | 5µs | my $import = _build_import( \%registry ); # spent 23µs making 2 calls to Package::DeprecationManager::_build_import, avg 11µs/call |
25 | 2 | 15µs | 8µs | 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 | 2 | 2µs | 1µs | my $caller = caller(); |
28 | ||||
29 | 2 | 20µs | 10µs | 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 | 2 | 14µs | 7µs | 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 | 2 | 3µs | 2µs | 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 | 2 | 1µs | 650ns | 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 | 6 | 6µs | 983ns | my $class = shift; |
53 | 6 | 33µs | 6µs | my %args = @_; |
54 | ||||
55 | 6 | 21µs | 3µs | $args{-api_version} ||= delete $args{-compatible}; |
56 | ||||
57 | 6 | 5µs | 867ns | $registry->{ caller() } = $args{-api_version} |
58 | if $args{-api_version}; | |||
59 | ||||
60 | 6 | 10µs | 2µs | return; |
61 | 2 | 14µs | 7µs | }; |
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 | 2 | 1µs | 650ns | my $registry = shift; |
66 | 2 | 1µs | 550ns | my $deprecated_at = shift; |
67 | 2 | 2µs | 950ns | my $ignore = shift; |
68 | ||||
69 | 2 | 17µs | 8µs | my %ignore = map { $_ => 1 } grep { !ref } @{ $ignore || [] }; |
70 | 2 | 4µs | 2µs | my @ignore_res = grep {ref} @{ $ignore || [] }; |
71 | ||||
72 | 2 | 600ns | 300ns | 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 | 22µs | 11µs | }; |
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 |