Commit | Line | Data |
dc4fc8c7 |
1 | package Package::DeprecationManager; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Carp qw( croak ); |
7 | use Params::Util qw( _HASH ); |
8 | use Sub::Install; |
9 | |
10 | sub import { |
11 | shift; |
12 | my %args = @_; |
13 | |
14 | croak |
15 | 'You must provide a hash reference -deprecations parameter when importing Package::DeprecationManager' |
16 | unless $args{-deprecations} && _HASH( $args{-deprecations} ); |
17 | |
18 | my %registry; |
19 | |
20 | my $import = _build_import( \%registry ); |
21 | my $warn = _build_warn( \%registry, $args{-deprecations} ); |
22 | |
23 | my $caller = caller(); |
24 | |
25 | Sub::Install::install_sub( |
26 | { |
27 | code => $import, |
28 | into => $caller, |
29 | as => 'import', |
30 | } |
31 | ); |
32 | |
33 | Sub::Install::install_sub( |
34 | { |
35 | code => $warn, |
36 | into => $caller, |
37 | as => 'deprecated', |
38 | } |
39 | ); |
40 | |
41 | return; |
42 | } |
43 | |
44 | sub _build_import { |
45 | my $registry = shift; |
46 | |
47 | return sub { |
48 | my $class = shift; |
49 | my %args = @_; |
50 | |
dee597ea |
51 | $args{-api_version} ||= delete $args{-compatible}; |
52 | |
dc4fc8c7 |
53 | $registry->{ caller() } = $args{-api_version} |
54 | if $args{-api_version}; |
55 | |
56 | return; |
57 | }; |
58 | } |
59 | |
60 | sub _build_warn { |
61 | my $registry = shift; |
62 | my $deprecated_at = shift; |
63 | |
64 | my %warned; |
65 | |
66 | return sub { |
bce3492c |
67 | my %args = @_ < 2 ? ( message => shift ) : @_; |
68 | |
dc4fc8c7 |
69 | my ( $package, undef, undef, $sub ) = caller(1); |
70 | |
bce3492c |
71 | unless ( defined $args{feature} ) { |
72 | $args{feature} = $sub; |
73 | } |
74 | |
dc4fc8c7 |
75 | my $compat_version = $registry->{$package}; |
76 | |
bce3492c |
77 | my $deprecated_at = $deprecated_at->{ $args{feature} }; |
dc4fc8c7 |
78 | |
79 | return |
80 | if defined $compat_version |
81 | && defined $deprecated_at |
82 | && $compat_version lt $deprecated_at; |
83 | |
bce3492c |
84 | return if $warned{$package}{ $args{feature} }; |
dc4fc8c7 |
85 | |
bce3492c |
86 | if ( defined $args{message} ) { |
87 | @_ = $args{message}; |
88 | } |
89 | else { |
90 | my $msg = "$args{feature} has been deprecated"; |
dc4fc8c7 |
91 | $msg .= " since version $deprecated_at" |
92 | if defined $deprecated_at; |
93 | |
94 | @_ = $msg; |
95 | } |
96 | |
bce3492c |
97 | $warned{$package}{ $args{feature} } = 1; |
dc4fc8c7 |
98 | |
99 | goto &Carp::cluck; |
100 | }; |
101 | } |
102 | |
103 | 1; |
104 | |
105 | # ABSTRACT: Manage deprecation warnings for your distribution |
106 | |
107 | __END__ |
108 | |
109 | =pod |
110 | |
111 | =head1 SYNOPSIS |
112 | |
dee597ea |
113 | package My::Class; |
114 | |
bce3492c |
115 | use Package::DeprecationManager -deprecations => { |
116 | 'My::Class::foo' => '0.02', |
117 | 'My::Class::bar' => '0.05', |
118 | 'feature-X' => '0.07', |
119 | }; |
dee597ea |
120 | |
121 | sub foo { |
122 | deprecated( 'Do not call foo!' ); |
123 | |
124 | ... |
125 | } |
126 | |
127 | sub bar { |
128 | deprecated(); |
129 | |
130 | ... |
131 | } |
132 | |
bce3492c |
133 | sub baz { |
134 | my %args = @_; |
135 | |
136 | if ( $args{foo} ) { |
137 | deprecated( |
138 | message => ..., |
139 | feature => 'feature-X', |
140 | ); |
141 | } |
142 | } |
143 | |
dee597ea |
144 | package Other::Class; |
145 | |
146 | use My::Class -api_version => '0.04'; |
147 | |
148 | My::Class->new()->foo(); # warns |
149 | My::Class->new()->bar(); # does not warn |
150 | My::Class->new()->far(); # does not warn again |
dc4fc8c7 |
151 | |
152 | =head1 DESCRIPTION |
153 | |
dee597ea |
154 | This module allows you to manage a set of deprecations for one or more modules. |
155 | |
156 | When you import C<Package::DeprecationManager>, you must provide a set of |
bce3492c |
157 | C<-deprecations> as a hash ref. The keys are "feature" names, and the values |
158 | are the version when that feature was deprecated. |
159 | |
160 | In many cases, you can simply use the fully qualified name of a subroutine or |
161 | method as the feature name. This works for cases where the whole subroutine is |
162 | deprecated. However, the feature names can be any string. This is useful if |
163 | you don't want to deprecate an entire subroutine, just a certain usage. |
dee597ea |
164 | |
165 | As part of the import process, C<Package::DeprecationManager> will export two |
166 | subroutines into its caller. It proves an C<import()> sub for the caller and a |
167 | C<deprecated()> sub. |
168 | |
169 | The C<import()> sub allows callers of I<your> class to specify an C<-api_version> |
170 | parameter. If this is supplied, then deprecation warnings are only issued for |
171 | deprecations for api versions earlier than the one specified. |
172 | |
173 | You must call C<deprecated()> sub in each deprecated subroutine. When called, |
bce3492c |
174 | it will issue a warning using C<Carp::cluck()>. |
175 | |
176 | The C<deprecated()> sub can be called in several ways. If you do not pass any |
177 | arguments, it will generate an appropriate warning message. If you pass a |
178 | single argument, this is used as the warning message. |
179 | |
180 | Finally, you can call it with named arguments. Currently, the only allowed |
181 | names are C<message> and C<feature>. The C<feature> argument should correspond |
182 | to the feature name passed in the C<-deprecations> hash. |
183 | |
184 | If you don't explicitly specify a feature, the C<deprecated()> sub uses |
185 | C<caller()> to identify its caller, using its fully qualified subroutine name. |
dee597ea |
186 | |
187 | Deprecation warnings are only issued once for a given package, regardless of |
188 | how many times the deprecated sub/method is called. |
189 | |
e1d24eef |
190 | =head1 BUGS |
191 | |
192 | Please report any bugs or feature requests to |
193 | C<bug-package-deprecationmanager@rt.cpan.org>, or through the web interface at |
194 | L<http://rt.cpan.org>. I will be notified, and then you'll automatically be |
195 | notified of progress on your bug as I make changes. |
196 | |
197 | =head1 DONATIONS |
198 | |
199 | If you'd like to thank me for the work I've done on this module, please |
200 | consider making a "donation" to me via PayPal. I spend a lot of free time |
201 | creating free software, and would appreciate any support you'd care to offer. |
202 | |
203 | Please note that B<I am not suggesting that you must do this> in order |
204 | for me to continue working on this particular software. I will |
205 | continue to do so, inasmuch as I have in the past, for as long as it |
206 | interests me. |
207 | |
208 | Similarly, a donation made in this way will probably not make me work on this |
209 | software much more, unless I get so many donations that I can consider working |
210 | on free software full time, which seems unlikely at best. |
211 | |
212 | To donate, log into PayPal and send money to autarch@urth.org or use the |
213 | button on this page: L<http://www.urth.org/~autarch/fs-donation.html> |
214 | |
215 | =head1 CREDITS |
216 | |
217 | The idea for this functionality and some of its implementation was originally |
218 | created as L<Class::MOP::Deprecated> by Goro Fuji. |
219 | |
dc4fc8c7 |
220 | =cut |