From: Dave Rolsky <autarch@urth.org>
Date: Mon, 12 Jul 2010 22:18:54 +0000 (-0500)
Subject: Make it easy to deprecate a feature, rather than just a whole sub/method
X-Git-Tag: v0.02~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bce3492c6adff8c9cd36571356012f8e1c109aee;p=gitmo%2FPackage-DeprecationManager.git

Make it easy to deprecate a feature, rather than just a whole sub/method
---

diff --git a/lib/Package/DeprecationManager.pm b/lib/Package/DeprecationManager.pm
index f8c9e81..a02887c 100644
--- a/lib/Package/DeprecationManager.pm
+++ b/lib/Package/DeprecationManager.pm
@@ -64,28 +64,37 @@ sub _build_warn {
     my %warned;
 
     return sub {
+        my %args = @_ < 2 ? ( message => shift ) : @_;
+
         my ( $package, undef, undef, $sub ) = caller(1);
 
+        unless ( defined $args{feature} ) {
+            $args{feature} = $sub;
+        }
+
         my $compat_version = $registry->{$package};
 
-        my $deprecated_at = $deprecated_at->{$sub};
+        my $deprecated_at = $deprecated_at->{ $args{feature} };
 
         return
             if defined $compat_version
                 && defined $deprecated_at
                 && $compat_version lt $deprecated_at;
 
-        return if $warned{$package}{$sub};
+        return if $warned{$package}{ $args{feature} };
 
-        if ( ! @_ ) {
-            my $msg = "$sub has been deprecated";
+        if ( defined $args{message} ) {
+            @_ = $args{message};
+        }
+        else {
+            my $msg = "$args{feature} has been deprecated";
             $msg .= " since version $deprecated_at"
                 if defined $deprecated_at;
 
             @_ = $msg;
         }
 
-        $warned{$package}{$sub} = 1;
+        $warned{$package}{ $args{feature} } = 1;
 
         goto &Carp::cluck;
     };
@@ -103,11 +112,11 @@ __END__
 
   package My::Class;
 
-  use Package::DeprecationManager
-      -deprecations => {
-          'My::Class::foo' => '0.02',
-          'My::Class::bar' => '0.05',
-      };
+  use Package::DeprecationManager -deprecations => {
+      'My::Class::foo' => '0.02',
+      'My::Class::bar' => '0.05',
+      'feature-X'      => '0.07',
+  };
 
   sub foo {
       deprecated( 'Do not call foo!' );
@@ -121,6 +130,17 @@ __END__
       ...
   }
 
+  sub baz {
+      my %args = @_;
+
+      if ( $args{foo} ) {
+          deprecated(
+              message => ...,
+              feature => 'feature-X',
+          );
+      }
+  }
+
   package Other::Class;
 
   use My::Class -api_version => '0.04';
@@ -134,8 +154,13 @@ __END__
 This module allows you to manage a set of deprecations for one or more modules.
 
 When you import C<Package::DeprecationManager>, you must provide a set of
-C<-deprecations> as a hash ref. The keys are fully qualified sub/method names,
-and the values are the version when that subroutine was deprecated.
+C<-deprecations> as a hash ref. The keys are "feature" names, and the values
+are the version when that feature was deprecated.
+
+In many cases, you can simply use the fully qualified name of a subroutine or
+method as the feature name. This works for cases where the whole subroutine is
+deprecated. However, the feature names can be any string. This is useful if
+you don't want to deprecate an entire subroutine, just a certain usage.
 
 As part of the import process, C<Package::DeprecationManager> will export two
 subroutines into its caller. It proves an C<import()> sub for the caller and a
@@ -146,8 +171,18 @@ parameter. If this is supplied, then deprecation warnings are only issued for
 deprecations for api versions earlier than the one specified.
 
 You must call C<deprecated()> sub in each deprecated subroutine. When called,
-it will issue a warning using C<Carp::cluck()>. If you do not pass an explicit
-warning message, one will be generated for you.
+it will issue a warning using C<Carp::cluck()>.
+
+The C<deprecated()> sub can be called in several ways. If you do not pass any
+arguments, it will generate an appropriate warning message. If you pass a
+single argument, this is used as the warning message.
+
+Finally, you can call it with named arguments. Currently, the only allowed
+names are C<message> and C<feature>. The C<feature> argument should correspond
+to the feature name passed in the C<-deprecations> hash.
+
+If you don't explicitly specify a feature, the C<deprecated()> sub uses
+C<caller()> to identify its caller, using its fully qualified subroutine name.
 
 Deprecation warnings are only issued once for a given package, regardless of
 how many times the deprecated sub/method is called.
diff --git a/t/basic.t b/t/basic.t
index 9fadb79..107020d 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -18,9 +18,10 @@ use Test::Warn;
     package Foo;
 
     use Package::DeprecationManager -deprecations => {
-        'Foo::foo' => '0.02',
-        'Foo::bar' => '0.03',
-        'Foo::baz' => '1.21',
+        'Foo::foo'  => '0.02',
+        'Foo::bar'  => '0.03',
+        'Foo::baz'  => '1.21',
+        'not a sub' => '1.23',
     };
 
     sub foo {
@@ -34,6 +35,15 @@ use Test::Warn;
     sub baz {
         deprecated();
     }
+
+    sub quux {
+        if ( $_[0] > 5 ) {
+            deprecated(
+                message => 'quux > 5 has been deprecated',
+                feature => 'not a sub',
+            );
+        }
+    }
 }
 
 {
@@ -78,7 +88,6 @@ use Test::Warn;
         'no warning for baz with api_version = 0.01';
 }
 
-
 {
     package Quux;
 
@@ -97,4 +106,18 @@ use Test::Warn;
         'no warning for baz with api_version = 1.17';
 }
 
+{
+    package Another;
+
+    Foo->import();
+
+    ::warning_is{ Foo::quux(1) }
+        q{},
+        'no warning for quux(1)';
+
+    ::warning_is{ Foo::quux(10) }
+        { carped => 'quux > 5 has been deprecated' },
+        'got a warning for quux(10)';
+}
+
 done_testing();