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 | |
51 | $registry->{ caller() } = $args{-api_version} |
52 | if $args{-api_version}; |
53 | |
54 | return; |
55 | }; |
56 | } |
57 | |
58 | sub _build_warn { |
59 | my $registry = shift; |
60 | my $deprecated_at = shift; |
61 | |
62 | my %warned; |
63 | |
64 | return sub { |
65 | my ( $package, undef, undef, $sub ) = caller(1); |
66 | |
67 | my $compat_version = $registry->{$package}; |
68 | |
69 | my $deprecated_at = $deprecated_at->{$sub}; |
70 | |
71 | return |
72 | if defined $compat_version |
73 | && defined $deprecated_at |
74 | && $compat_version lt $deprecated_at; |
75 | |
76 | return if $warned{$package}{$sub}; |
77 | |
78 | if ( ! @_ ) { |
79 | my $msg = "$sub has been deprecated"; |
80 | $msg .= " since version $deprecated_at" |
81 | if defined $deprecated_at; |
82 | |
83 | @_ = $msg; |
84 | } |
85 | |
86 | $warned{$package}{$sub} = 1; |
87 | |
88 | goto &Carp::cluck; |
89 | }; |
90 | } |
91 | |
92 | 1; |
93 | |
94 | # ABSTRACT: Manage deprecation warnings for your distribution |
95 | |
96 | __END__ |
97 | |
98 | =pod |
99 | |
100 | =head1 SYNOPSIS |
101 | |
102 | ... |
103 | |
104 | =head1 DESCRIPTION |
105 | |
106 | =cut |