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}, $args{-ignore} );
  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     my $ignore        = shift;
  64
  65     my %ignore = map { $_ => 1 } @{ $ignore || [] };
  66
  67     my %warned;
  68
  69     return sub {
  70         my %args = @_ < 2 ? ( message => shift ) : @_;
  71
  72         my ( $package, undef, undef, $sub ) = caller(1);
  73
  74         my $skipped = 0;
  75         if ( keys %ignore ) {
  76             while ( defined $package && $ignore{$package} ) {
  77                 # We want to start two levels back, since we already looked
  78                 # one level back and found an internal package.
  79                 $package = caller($skipped++ + 2);
  80                 $skipped++;
  81             }
  82         }
  83
  84         $package = 'unknown package' unless defined $package;
  85
  86         unless ( defined $args{feature} ) {
  87             $args{feature} = $sub;
  88         }
  89
  90         my $compat_version = $registry->{$package};
  91
  92         my $deprecated_at = $deprecated_at->{ $args{feature} };
  93
  94         return
  95             if defined $compat_version
  96                 && defined $deprecated_at
  97                 && $compat_version lt $deprecated_at;
  98
  99         my $msg;
 100         if ( defined $args{message} ) {
 101             $msg = $args{message};
 102         }
 103         else {
 104             $msg = "$args{feature} has been deprecated";
 105             $msg .= " since version $deprecated_at"
 106                 if defined $deprecated_at;
 107         }
 108
 109         return if $warned{$package}{ $args{feature} }{$msg};
 110
 111         $warned{$package}{ $args{feature} }{$msg} = 1;
 112
 113         local $Carp::CarpLevel = $Carp::CarpLevel + 1 + $skipped;
 114
 115         Carp::cluck($msg);
 116     };
 117 }
 118
 119 1;
 120
 121 # ABSTRACT: Manage deprecation warnings for your distribution
 122
 123 __END__
 124
 125 =pod
 126
 127 =head1 SYNOPSIS
 128
 129   package My::Class;
 130
 131   use Package::DeprecationManager -deprecations => {
 132       'My::Class::foo' => '0.02',
 133       'My::Class::bar' => '0.05',
 134       'feature-X'      => '0.07',
 135   };
 136
 137   sub foo {
 138       deprecated( 'Do not call foo!' );
 139
 140       ...
 141   }
 142
 143   sub bar {
 144       deprecated();
 145
 146       ...
 147   }
 148
 149   sub baz {
 150       my %args = @_;
 151
 152       if ( $args{foo} ) {
 153           deprecated(
 154               message => ...,
 155               feature => 'feature-X',
 156           );
 157       }
 158   }
 159
 160   package Other::Class;
 161
 162   use My::Class -api_version => '0.04';
 163
 164   My::Class->new()->foo(); # warns
 165   My::Class->new()->bar(); # does not warn
 166   My::Class->new()->far(); # does not warn again
 167
 168 =head1 DESCRIPTION
 169
 170 This module allows you to manage a set of deprecations for one or more modules.
 171
 172 When you import C<Package::DeprecationManager>, you must provide a set of
 173 C<-deprecations> as a hash ref. The keys are "feature" names, and the values
 174 are the version when that feature was deprecated.
 175
 176 In many cases, you can simply use the fully qualified name of a subroutine or
 177 method as the feature name. This works for cases where the whole subroutine is
 178 deprecated. However, the feature names can be any string. This is useful if
 179 you don't want to deprecate an entire subroutine, just a certain usage.
 180
 181 You can also provide an optional array reference in the C<-ignore>
 182 parameter. This is a list of package names to ignore when looking at the stack
 183 to figure out what code used the deprecated feature. This should be packages
 184 in your distribution that can appear on the call stack when a deprecated
 185 feature is used.
 186
 187 As part of the import process, C<Package::DeprecationManager> will export two
 188 subroutines into its caller. It proves an C<import()> sub for the caller and a
 189 C<deprecated()> sub.
 190
 191 The C<import()> sub allows callers of I<your> class to specify an C<-api_version>
 192 parameter. If this is supplied, then deprecation warnings are only issued for
 193 deprecations for api versions earlier than the one specified.
 194
 195 You must call C<deprecated()> sub in each deprecated subroutine. When called,
 196 it will issue a warning using C<Carp::cluck()>.
 197
 198 The C<deprecated()> sub can be called in several ways. If you do not pass any
 199 arguments, it will generate an appropriate warning message. If you pass a
 200 single argument, this is used as the warning message.
 201
 202 Finally, you can call it with named arguments. Currently, the only allowed
 203 names are C<message> and C<feature>. The C<feature> argument should correspond
 204 to the feature name passed in the C<-deprecations> hash.
 205
 206 If you don't explicitly specify a feature, the C<deprecated()> sub uses
 207 C<caller()> to identify its caller, using its fully qualified subroutine name.
 208
 209 A given deprecation warning is only issued once for a given package. This
 210 module tracks this based on both the feature name I<and> the error message
 211 itself. This means that if you provide severaldifferent error messages for the
 212 same feature, all of those errors will appear.
 213
 214 =head1 BUGS
 215
 216 Please report any bugs or feature requests to
 217 C<bug-package-deprecationmanager@rt.cpan.org>, or through the web interface at
 218 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
 219 notified of progress on your bug as I make changes.
 220
 221 =head1 DONATIONS
 222
 223 If you'd like to thank me for the work I've done on this module, please
 224 consider making a "donation" to me via PayPal. I spend a lot of free time
 225 creating free software, and would appreciate any support you'd care to offer.
 226
 227 Please note that B<I am not suggesting that you must do this> in order
 228 for me to continue working on this particular software. I will
 229 continue to do so, inasmuch as I have in the past, for as long as it
 230 interests me.
 231
 232 Similarly, a donation made in this way will probably not make me work on this
 233 software much more, unless I get so many donations that I can consider working
 234 on free software full time, which seems unlikely at best.
 235
 236 To donate, log into PayPal and send money to autarch@urth.org or use the
 237 button on this page: L<http://www.urth.org/~autarch/fs-donation.html>
 238
 239 =head1 CREDITS
 240
 241 The idea for this functionality and some of its implementation was originally
 242 created as L<Class::MOP::Deprecated> by Goro Fuji.
 243
 244 =cut