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 | BEGIN@10 | Package::DeprecationManager::
3 | 3 | 3 | 127µs | 540µs | import | Package::DeprecationManager::
6 | 6 | 6 | 58µs | 58µs | __ANON__[:61] | Package::DeprecationManager::
3 | 1 | 1 | 42µs | 42µs | _build_warn | Package::DeprecationManager::
3 | 1 | 1 | 20µs | 20µs | _build_import | Package::DeprecationManager::
1 | 1 | 1 | 19µs | 38µs | BEGIN@6 | Package::DeprecationManager::
1 | 1 | 1 | 17µs | 142µs | BEGIN@11 | Package::DeprecationManager::
1 | 1 | 1 | 15µs | 23µs | BEGIN@12 | Package::DeprecationManager::
1 | 1 | 1 | 12µs | 17µs | BEGIN@7 | Package::DeprecationManager::
1 | 1 | 1 | 11µs | 47µs | BEGIN@9 | Package::DeprecationManager::
0 | 0 | 0 | 0s | 0s | __ANON__[:123] | Package::DeprecationManager::
0 | 0 | 0 | 0s | 0s | __ANON__[:83] | Package::DeprecationManager::
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 | 3 | 800ns | shift; | ||
16 | 3 | 7µs | my %args = @_; | ||
17 | |||||
18 | 3 | 27µs | 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 | 3 | 800ns | my %registry; | ||
23 | |||||
24 | 3 | 9µs | 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 | 15µs | 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 | 3 | 4µs | my $caller = caller(); | ||
28 | |||||
29 | 3 | 20µs | 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 | 13µs | 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 | 3 | 16µs | 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 | 3 | 2µ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 | 6 | 6µs | my $class = shift; | ||
53 | 6 | 8µs | my %args = @_; | ||
54 | |||||
55 | 6 | 18µs | $args{-api_version} ||= delete $args{-compatible}; | ||
56 | |||||
57 | 6 | 5µs | $registry->{ caller() } = $args{-api_version} | ||
58 | if $args{-api_version}; | ||||
59 | |||||
60 | 6 | 36µs | return; | ||
61 | 3 | 24µs | }; | ||
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 | 3 | 2µs | my $registry = shift; | ||
66 | 3 | 1µs | my $deprecated_at = shift; | ||
67 | 3 | 3µs | my $ignore = shift; | ||
68 | |||||
69 | 3 | 9µs | my %ignore = map { $_ => 1 } grep { !ref } @{ $ignore || [] }; | ||
70 | 3 | 5µs | my @ignore_res = grep {ref} @{ $ignore || [] }; | ||
71 | |||||
72 | 3 | 700ns | 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 | 3 | 26µs | }; | ||
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__ |