Commit | Line | Data |
df4cbc4e |
1 | ### !!!ACHTUNG!!! |
2 | # |
3 | # This module is to be loaded at configure time straight from the Makefile.PL |
4 | # in order to get access to some of the constants / utils |
5 | # None of the dependencies will be available yet at this point, so make |
6 | # sure to never use anything beyond what the minimum supported perl came with |
7 | # (no, relying on configure_requires is not ok) |
8 | |
9 | package # hide from the pauses |
10 | namespace::clean::_Util; |
11 | |
12 | use warnings; |
13 | use strict; |
14 | |
15 | use base 'Exporter'; |
16 | our @EXPORT_OK = qw( DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT ); |
17 | |
006e9cb4 |
18 | use constant DEBUGGER_NEEDS_CV_RENAME => ( ( "$]" > 5.008_008 ) and ( "$]" < 5.013_006 ) ); |
19 | use constant DEBUGGER_NEEDS_CV_PIVOT => ( ( ! DEBUGGER_NEEDS_CV_RENAME ) and ( "$]" < 5.015_005 ) ); |
df4cbc4e |
20 | |
21 | # FIXME - ideally this needs to be provided by some abstraction lib |
22 | # but we don't have that yet |
23 | BEGIN { |
24 | # |
25 | # Note - both get_subname and set_subname are only called by one block |
26 | # which is compiled away unless CV_RENAME is true ( the 5.8.9 ~ 5.12 range ). |
27 | # Hence we compile/provide the definitions here only when needed |
28 | # |
29 | DEBUGGER_NEEDS_CV_RENAME and ( eval <<'EOS' or die $@ ); |
30 | { |
31 | my( $sub_name_loaded, $sub_util_loaded ); |
32 | |
33 | sub _namer_load_error { |
c0de1125 |
34 | return '' if $sub_util_loaded or $sub_name_loaded; |
df4cbc4e |
35 | |
c0de1125 |
36 | # if S::N is loaded first *and* so is B - then go with that, otherwise |
37 | # prefer Sub::Util as S::U will provide a faster get_subname and will |
38 | # not need further require() calls |
39 | # this is rather arbitrary but remember this code exists only perls |
40 | # between 5.8.9 ~ 5.13.5 |
df4cbc4e |
41 | |
42 | # when changing version also change in Makefile.PL |
43 | my $sn_ver = 0.04; |
44 | |
c0de1125 |
45 | local $@; |
46 | my $err = ''; |
47 | |
48 | ( |
49 | ! ( |
50 | $INC{"B.pm"} |
51 | and |
52 | $INC{"Sub/Name.pm"} |
53 | and |
54 | eval { Sub::Name->VERSION($sn_ver) } |
55 | ) |
56 | and |
57 | eval { require Sub::Util } |
58 | and |
59 | # see https://github.com/moose/Moo/commit/dafa5118 |
60 | defined &Sub::Util::set_subname |
61 | and |
62 | $sub_util_loaded = 1 |
63 | ) |
df4cbc4e |
64 | or |
c0de1125 |
65 | ( |
66 | eval { require Sub::Name and Sub::Name->VERSION($sn_ver) } |
67 | and |
68 | $sub_name_loaded = 1 |
69 | ) |
df4cbc4e |
70 | or |
71 | $err = "When running under -d on this perl $], namespace::clean requires either Sub::Name $sn_ver or Sub::Util to be installed" |
72 | ; |
73 | |
74 | $err; |
75 | } |
76 | |
77 | sub set_subname { |
78 | if( my $err = _namer_load_error() ) { |
79 | die $err; |
80 | } |
81 | elsif( $sub_name_loaded ) { |
82 | &Sub::Name::subname; |
83 | } |
84 | elsif( $sub_util_loaded ) { |
85 | &Sub::Util::set_subname; |
86 | } |
87 | else { |
88 | die "How the fuck did we get here? Read source and debug please!"; |
89 | } |
90 | } |
91 | |
92 | sub get_subname { |
93 | if( |
94 | _namer_load_error() |
95 | or |
96 | ! $sub_util_loaded |
97 | ) { |
98 | require B; |
99 | my $gv = B::svref_2object( $_[0] )->GV; |
100 | join '::', $gv->STASH->NAME, $gv->NAME; |
101 | } |
102 | else { |
103 | &Sub::Util::subname; |
104 | } |
105 | } |
106 | } |
107 | 1; |
108 | EOS |
109 | |
110 | } |
111 | |
112 | 1; |