← Back to branch summary

~ubuntu-branches/ubuntu/saucy/libnamespace-clean-perl/saucy

« back to all changes in this revision

Viewing changes to lib/namespace/clean.pm

  • Committer: Package Import Robot
  • Author(s): Alessandro Ghedini
  • Date: 2011-12-26 18:51:59 UTC
  • mfrom: (1.1.10)
  • Revision ID: package-import@ubuntu.com-20111226185159-no8faz18imali30r
Tags: 0.22-1
* Team upload
* New upstream release
* Update upstream copyright holders
* Drop pod-whatis.diff patch (fixed upstream)
* Update DEP-5 formatting a bit

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/namespace/clean.pm
1
1
package namespace::clean;
2
 
# ABSTRACT: Keep imports and functions out of your namespace
3
2
 
4
3
use warnings;
5
4
use strict;
7
6
use vars qw( $STORAGE_VAR );
8
7
use Package::Stash;
9
8
 
10
 
our $VERSION = '0.21';
 
9
our $VERSION = '0.22';
11
10
 
12
11
$STORAGE_VAR = '__NAMESPACE_CLEAN_STORAGE';
13
12
 
 
13
# FIXME - all of this buggery will migrate to B::H::EOS soon
14
14
BEGIN {
15
 
 
16
 
  use warnings;
17
 
  use strict;
18
 
 
19
15
  # when changing also change in Makefile.PL
20
16
  my $b_h_eos_req = '0.07';
21
17
 
22
 
  if (eval {
 
18
  if (! $ENV{NAMESPACE_CLEAN_USE_PP} and eval {
23
19
    require B::Hooks::EndOfScope;
24
20
    B::Hooks::EndOfScope->VERSION($b_h_eos_req);
25
21
    1
26
22
  } ) {
27
23
    B::Hooks::EndOfScope->import('on_scope_end');
28
24
  }
 
25
  elsif ($] < 5.009_003_1) {
 
26
    require namespace::clean::_PP_OSE_5_8;
 
27
    *on_scope_end = \&namespace::clean::_PP_OSE_5_8::on_scope_end;
 
28
  }
29
29
  else {
30
 
    eval <<'PP' or die $@;
31
 
 
32
 
  use Tie::Hash ();
33
 
 
34
 
  {
35
 
    package namespace::clean::_TieHintHash;
36
 
 
37
 
    use warnings;
38
 
    use strict;
39
 
 
40
 
    use base 'Tie::ExtraHash';
41
 
  }
42
 
 
43
 
  {
44
 
    package namespace::clean::_ScopeGuard;
45
 
 
46
 
    use warnings;
47
 
    use strict;
48
 
 
49
 
    sub arm { bless [ $_[1] ] }
50
 
 
51
 
    sub DESTROY { $_[0]->[0]->() }
52
 
  }
53
 
 
54
 
 
55
 
  sub on_scope_end (&) {
56
 
    $^H |= 0x020000;
57
 
 
58
 
    if( my $stack = tied( %^H ) ) {
59
 
      if ( (my $c = ref $stack) ne 'namespace::clean::_TieHintHash') {
60
 
        die <<EOE;
61
 
========================================================================
62
 
               !!!   F A T A L   E R R O R   !!!
63
 
 
64
 
                 foreign tie() of %^H detected
65
 
========================================================================
66
 
 
67
 
namespace::clean is currently operating in pure-perl fallback mode, because
68
 
your system is lacking the necessary dependency B::Hooks::EndOfScope $b_h_eos_req.
69
 
In this mode namespace::clean expects to be able to tie() the hinthash %^H,
70
 
however it is apparently already tied by means unknown to the tie-class
71
 
$c
72
 
 
73
 
Since this is a no-win situation execution will abort here and now. Please
74
 
try to find out which other module is relying on hinthash tie() ability,
75
 
and file a bug for both the perpetrator and namespace::clean, so that the
76
 
authors can figure out an acceptable way of moving forward.
77
 
 
78
 
EOE
79
 
      }
80
 
      push @$stack, namespace::clean::_ScopeGuard->arm(shift);
81
 
    }
82
 
    else {
83
 
      tie( %^H, 'namespace::clean::_TieHintHash', namespace::clean::_ScopeGuard->arm(shift) );
84
 
    }
85
 
  }
86
 
 
87
 
  1;
88
 
 
89
 
PP
90
 
 
 
30
    require namespace::clean::_PP_OSE;
 
31
    *on_scope_end = \&namespace::clean::_PP_OSE::on_scope_end;
91
32
  }
92
33
}
93
34
 
94
35
=head1 NAME
95
36
 
96
 
namespace::clean - keep imports and functions out of your namespace
 
37
namespace::clean - Keep imports and functions out of your namespace
97
38
 
98
39
=head1 SYNOPSIS
99
40
 
223
164
 
224
165
=cut
225
166
 
 
167
# Constant to optimise away the unused code branches
 
168
use constant FIXUP_NEEDED => $] < 5.015_005_1;
 
169
use constant FIXUP_RENAME_SUB => $] > 5.008_008_9 && $] < 5.013_006_1;
 
170
{
 
171
  no strict;
 
172
  delete ${__PACKAGE__."::"}{FIXUP_NEEDED};
 
173
  delete ${__PACKAGE__."::"}{FIXUP_RENAME_SUB};
 
174
}
 
175
 
 
176
# Debugger fixup necessary before perl 5.15.5
 
177
#
 
178
# In perl 5.8.9-5.12, it assumes that sub_fullname($sub) can
 
179
# always be used to find the CV again.
 
180
# In perl 5.8.8 and 5.14, it assumes that the name of the glob
 
181
# passed to entersub can be used to find the CV.
 
182
# since we are deleting the glob where the subroutine was originally
 
183
# defined, those assumptions no longer hold.
 
184
#
 
185
# So in 5.8.9-5.12 we need to move it elsewhere and point the
 
186
# CV's name to the new glob.
 
187
#
 
188
# In 5.8.8 and 5.14 we move it elsewhere and rename the
 
189
# original glob by assigning the new glob back to it.
226
190
my $sub_utils_loaded;
227
 
my $DebuggerRename = sub {
 
191
my $DebuggerFixup = sub {
228
192
  my ($f, $sub, $cleanee_stash, $deleted_stash) = @_;
229
193
 
230
 
  if (! defined $sub_utils_loaded ) {
231
 
    $sub_utils_loaded = do {
232
 
      my $sn_ver = 0.04;
233
 
      eval { require Sub::Name; Sub::Name->VERSION($sn_ver) }
234
 
        or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
235
 
 
236
 
      my $si_ver = 0.04;
237
 
      eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) }
238
 
        or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
239
 
 
240
 
      1;
241
 
    } ? 1 : 0;
 
194
  if (FIXUP_RENAME_SUB) {
 
195
    if (! defined $sub_utils_loaded ) {
 
196
      $sub_utils_loaded = do {
 
197
 
 
198
        # when changing version also change in Makefile.PL
 
199
        my $sn_ver = 0.04;
 
200
        eval { require Sub::Name; Sub::Name->VERSION($sn_ver) }
 
201
          or die "Sub::Name $sn_ver required when running under -d or equivalent: $@";
 
202
 
 
203
        # when changing version also change in Makefile.PL
 
204
        my $si_ver = 0.04;
 
205
        eval { require Sub::Identify; Sub::Identify->VERSION($si_ver) }
 
206
          or die "Sub::Identify $si_ver required when running under -d or equivalent: $@";
 
207
 
 
208
        1;
 
209
      } ? 1 : 0;
 
210
    }
 
211
 
 
212
    if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
 
213
      my $new_fq = $deleted_stash->name . "::$f";
 
214
      Sub::Name::subname($new_fq, $sub);
 
215
      $deleted_stash->add_symbol("&$f", $sub);
 
216
    }
242
217
  }
243
 
 
244
 
  if ( Sub::Identify::sub_fullname($sub) eq ($cleanee_stash->name . "::$f") ) {
245
 
    my $new_fq = $deleted_stash->name . "::$f";
246
 
    Sub::Name::subname($new_fq, $sub);
 
218
  else {
247
219
    $deleted_stash->add_symbol("&$f", $sub);
248
220
  }
249
221
};
263
235
        my $sub = $cleanee_stash->get_symbol("&$f")
264
236
          or next SYMBOL;
265
237
 
266
 
        if ($^P and ref(\$cleanee_stash->namespace->{$f}) eq 'GLOB') {
267
 
            # convince the Perl debugger to work
268
 
            # it assumes that sub_fullname($sub) can always be used to find the CV again
269
 
            # since we are deleting the glob where the subroutine was originally
270
 
            # defined, that assumption no longer holds, so we need to move it
271
 
            # elsewhere and point the CV's name to the new glob.
272
 
            $DebuggerRename->(
273
 
              $f,
274
 
              $sub,
275
 
              $cleanee_stash,
276
 
              $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
277
 
            );
 
238
        my $need_debugger_fixup =
 
239
          FIXUP_NEEDED
 
240
            &&
 
241
          $^P
 
242
            &&
 
243
          ref(my $globref = \$cleanee_stash->namespace->{$f}) eq 'GLOB'
 
244
        ;
 
245
 
 
246
        if (FIXUP_NEEDED && $need_debugger_fixup) {
 
247
          # convince the Perl debugger to work
 
248
          # see the comment on top of $DebuggerFixup
 
249
          $DebuggerFixup->(
 
250
            $f,
 
251
            $sub,
 
252
            $cleanee_stash,
 
253
            $deleted_stash ||= Package::Stash->new("namespace::clean::deleted::$cleanee"),
 
254
          );
278
255
        }
279
256
 
280
257
        my @symbols = map {
285
262
 
286
263
        $cleanee_stash->remove_glob($f);
287
264
 
 
265
        # if this perl needs no renaming trick we need to
 
266
        # rename the original glob after the fact
 
267
        # (see commend of $DebuggerFixup
 
268
        if (FIXUP_NEEDED && !FIXUP_RENAME_SUB && $need_debugger_fixup) {
 
269
          *$globref = $deleted_stash->namespace->{$f};
 
270
        }
 
271
 
288
272
        $cleanee_stash->add_symbol(@$_) for @symbols;
289
273
    }
290
274
};
438
422
Just for completeness sake, if you want to remove the symbol completely,
439
423
use C<undef> instead.
440
424
 
441
 
=head1 CAVEATS
442
 
 
443
 
This module is fully functional in a pure-perl environment, where
444
 
L<B::Hooks::EndOfScope> (with the XS dependency L<Variable::Magic>), may
445
 
not be available. However in this case this module falls back to a
446
 
L<tie()|perlfunc/tie> of L<%^H|perlvar/%^H>  which may or may not interfere
447
 
with some crack you may be doing independently of namespace::clean.
448
 
 
449
 
If you want to ensure that your codebase is protected from this unlikely
450
 
clash, you need to explicitly depend on L<B::Hooks::EndOfScope>.
451
 
 
452
425
=head1 SEE ALSO
453
426
 
454
427
L<B::Hooks::EndOfScope>
477
450
 
478
451
Peter Rabbitson <ribasushi@cpan.org>
479
452
 
 
453
=item *
 
454
 
 
455
Father Chrysostomos <sprout@cpan.org>
 
456
 
480
457
=back
481
458
 
482
459
=head1 COPYRIGHT AND LICENSE
483
460
 
484
 
This software is copyright (c) 2011 by Robert 'phaylon' Sedlacek.
 
461
This software is copyright (c) 2011 by L</AUTHORS>
485
462
 
486
463
This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.
487
464