lib/Package/DeprecationManager.pm

   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
  51         $args{-api_version} ||= delete $args{-compatible};
  52
  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 {
  67         my %args = @_ < 2 ? ( message => shift ) : @_;
  68
  69         my ( $package, undef, undef, $sub ) = caller(1);
  70
  71         unless ( defined $args{feature} ) {
  72             $args{feature} = $sub;
  73         }
  74
  75         my $compat_version = $registry->{$package};
  76
  77         my $deprecated_at = $deprecated_at->{ $args{feature} };
  78
  79         return
  80             if defined $compat_version
  81                 && defined $deprecated_at
  82                 && $compat_version lt $deprecated_at;
  83
  84         return if $warned{$package}{ $args{feature} };
  85
  86         if ( defined $args{message} ) {
  87             @_ = $args{message};
  88         }
  89         else {
  90             my $msg = "$args{feature} has been deprecated";
  91             $msg .= " since version $deprecated_at"
  92                 if defined $deprecated_at;
  93
  94             @_ = $msg;
  95         }
  96
  97         $warned{$package}{ $args{feature} } = 1;
  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
 113   package My::Class;
 114
 115   use Package::DeprecationManager -deprecations => {
 116       'My::Class::foo' => '0.02',
 117       'My::Class::bar' => '0.05',
 118       'feature-X'      => '0.07',
 119   };
 120
 121   sub foo {
 122       deprecated( 'Do not call foo!' );
 123
 124       ...
 125   }
 126
 127   sub bar {
 128       deprecated();
 129
 130       ...
 131   }
 132
 133   sub baz {
 134       my %args = @_;
 135
 136       if ( $args{foo} ) {
 137           deprecated(
 138               message => ...,
 139               feature => 'feature-X',
 140           );
 141       }
 142   }
 143
 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
 151
 152 =head1 DESCRIPTION
 153
 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
 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.
 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,
 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.
 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
 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
 220 =cut