f2579a05c35f36c9f2164c17af8a64d8537306db
[p5sagit/namespace-clean.git] / lib / namespace / clean / _Util.pm
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
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 ) );
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 {
34     return '' if $sub_util_loaded or $sub_name_loaded;
35
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
41
42     # when changing version also change in Makefile.PL
43     my $sn_ver = 0.04;
44
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     )
64       or
65     (
66       eval { require Sub::Name and Sub::Name->VERSION($sn_ver) }
67         and
68       $sub_name_loaded = 1
69     )
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;