← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:04 2021

Filename/usr/local/lib/perl5/site_perl/namespace/autoclean.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sDateTime::::BEGIN@1 DateTime::BEGIN@1
0000s0sDateTime::::BEGIN@2 DateTime::BEGIN@2
0000s0snamespace::autoclean::::BEGIN@10namespace::autoclean::BEGIN@10
0000s0snamespace::autoclean::::BEGIN@11namespace::autoclean::BEGIN@11
0000s0snamespace::autoclean::::BEGIN@12namespace::autoclean::BEGIN@12
0000s0snamespace::autoclean::::BEGIN@203namespace::autoclean::BEGIN@203
0000s0snamespace::autoclean::::CORE:matchnamespace::autoclean::CORE:match (opcode)
0000s0snamespace::autoclean::::__ANON__[:147]namespace::autoclean::__ANON__[:147]
0000s0snamespace::autoclean::::__ANON__[:148]namespace::autoclean::__ANON__[:148]
0000s0snamespace::autoclean::::__ANON__[:149]namespace::autoclean::__ANON__[:149]
0000s0snamespace::autoclean::::__ANON__[:155]namespace::autoclean::__ANON__[:155]
0000s0snamespace::autoclean::::__ANON__[:177]namespace::autoclean::__ANON__[:177]
0000s0snamespace::autoclean::::__ANON__[:179]namespace::autoclean::__ANON__[:179]
0000s0snamespace::autoclean::::__ANON__[:183]namespace::autoclean::__ANON__[:183]
0000s0snamespace::autoclean::::__ANON__[:194]namespace::autoclean::__ANON__[:194]
0000s0snamespace::autoclean::::__ANON__[:210]namespace::autoclean::__ANON__[:210]
0000s0snamespace::autoclean::::_method_checknamespace::autoclean::_method_check
0000s0snamespace::autoclean::::importnamespace::autoclean::import
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1use strict;
2use warnings;
3
4package namespace::autoclean; # git description: 0.28-24-g964adcf
5# ABSTRACT: Keep imports out of your namespace
6# KEYWORDS: namespaces clean dirty imports exports subroutines methods development
7
8our $VERSION = '0.29';
9
10use B::Hooks::EndOfScope 0.12;
11use List::Util qw( first );
12use namespace::clean 0.20;
13
14#pod =head1 SYNOPSIS
15#pod
16#pod package Foo;
17#pod use namespace::autoclean;
18#pod use Some::Package qw/imported_function/;
19#pod
20#pod sub bar { imported_function('stuff') }
21#pod
22#pod # later on:
23#pod Foo->bar; # works
24#pod Foo->imported_function; # will fail. imported_function got cleaned after compilation
25#pod
26#pod =head1 DESCRIPTION
27#pod
28#pod When you import a function into a Perl package, it will naturally also be
29#pod available as a method.
30#pod
31#pod The C<namespace::autoclean> pragma will remove all imported symbols at the end
32#pod of the current package's compile cycle. Functions called in the package itself
33#pod will still be bound by their name, but they won't show up as methods on your
34#pod class or instances.
35#pod
36#pod This module is very similar to L<namespace::clean|namespace::clean>, except it
37#pod will clean all imported functions, no matter if you imported them before or
38#pod after you C<use>d the pragma. It will also not touch anything that looks like a
39#pod method.
40#pod
41#pod If you're writing an exporter and you want to clean up after yourself (and your
42#pod peers), you can use the C<-cleanee> switch to specify what package to clean:
43#pod
44#pod package My::MooseX::namespace::autoclean;
45#pod use strict;
46#pod
47#pod use namespace::autoclean (); # no cleanup, just load
48#pod
49#pod sub import {
50#pod namespace::autoclean->import(
51#pod -cleanee => scalar(caller),
52#pod );
53#pod }
54#pod
55#pod =head1 WHAT IS AND ISN'T CLEANED
56#pod
57#pod C<namespace::autoclean> will leave behind anything that it deems a method. For
58#pod L<Moose> classes, this the based on the C<get_method_list> method
59#pod on from the L<Class::MOP::Class|metaclass>. For non-Moose classes, anything
60#pod defined within the package will be identified as a method. This should match
61#pod Moose's definition of a method. Additionally, the magic subs installed by
62#pod L<overload> will not be cleaned.
63#pod
64#pod =head1 PARAMETERS
65#pod
66#pod =head2 -also => [ ITEM | REGEX | SUB, .. ]
67#pod
68#pod =head2 -also => ITEM
69#pod
70#pod =head2 -also => REGEX
71#pod
72#pod =head2 -also => SUB
73#pod
74#pod Sometimes you don't want to clean imports only, but also helper functions
75#pod you're using in your methods. The C<-also> switch can be used to declare a list
76#pod of functions that should be removed additional to any imports:
77#pod
78#pod use namespace::autoclean -also => ['some_function', 'another_function'];
79#pod
80#pod If only one function needs to be additionally cleaned the C<-also> switch also
81#pod accepts a plain string:
82#pod
83#pod use namespace::autoclean -also => 'some_function';
84#pod
85#pod In some situations, you may wish for a more I<powerful> cleaning solution.
86#pod
87#pod The C<-also> switch can take a Regex or a CodeRef to match against local
88#pod function names to clean.
89#pod
90#pod use namespace::autoclean -also => qr/^_/
91#pod
92#pod use namespace::autoclean -also => sub { $_ =~ m{^_} };
93#pod
94#pod use namespace::autoclean -also => [qr/^_/ , qr/^hidden_/ ];
95#pod
96#pod use namespace::autoclean -also => [sub { $_ =~ m/^_/ or $_ =~ m/^hidden/ }, sub { uc($_) == $_ } ];
97#pod
98#pod =head2 -except => [ ITEM | REGEX | SUB, .. ]
99#pod
100#pod =head2 -except => ITEM
101#pod
102#pod =head2 -except => REGEX
103#pod
104#pod =head2 -except => SUB
105#pod
106#pod This takes exactly the same options as C<-also> except that anything this
107#pod matches will I<not> be cleaned.
108#pod
109#pod =head1 CAVEATS
110#pod
111#pod When used with L<Moo> classes, the heuristic used to check for methods won't
112#pod work correctly for methods from roles consumed at compile time.
113#pod
114#pod package My::Class;
115#pod use Moo;
116#pod use namespace::autoclean;
117#pod
118#pod # Bad, any consumed methods will be cleaned
119#pod BEGIN { with 'Some::Role' }
120#pod
121#pod # Good, methods from role will be maintained
122#pod with 'Some::Role';
123#pod
124#pod Additionally, method detection may not work properly in L<Mouse> classes in
125#pod perls earlier than 5.10.
126#pod
127#pod =head1 SEE ALSO
128#pod
129#pod =for :list
130#pod * L<namespace::clean>
131#pod * L<B::Hooks::EndOfScope>
132#pod * L<namespace::sweep>
133#pod * L<Sub::Exporter::ForMethods>
134#pod * L<Sub::Name>
135#pod * L<Sub::Install>
136#pod * L<Test::CleanNamespaces>
137#pod * L<Dist::Zilla::Plugin::Test::CleanNamespaces>
138#pod
139#pod =cut
140
141sub import {
142 my ($class, %args) = @_;
143
144 my $subcast = sub {
145 my $i = shift;
146 return $i if ref $i eq 'CODE';
147 return sub { $_ =~ $i } if ref $i eq 'Regexp';
148 return sub { $_ eq $i };
149 };
150
151 my $runtest = sub {
152 my ($code, $method_name) = @_;
153 local $_ = $method_name;
154 return $code->();
155 };
156
157 my $cleanee = exists $args{-cleanee} ? $args{-cleanee} : scalar caller;
158
159 my @also = map $subcast->($_), (
160 exists $args{-also}
161 ? (ref $args{-also} eq 'ARRAY' ? @{ $args{-also} } : $args{-also})
162 : ()
163 );
164
165 my @except = map $subcast->($_), (
166 exists $args{-except}
167 ? (ref $args{-except} eq 'ARRAY' ? @{ $args{-except} } : $args{-except})
168 : ()
169 );
170
171 on_scope_end {
172 my $subs = namespace::clean->get_functions($cleanee);
173 my $method_check = _method_check($cleanee);
174
175 my @clean = grep {
176 my $method = $_;
177 ! first { $runtest->($_, $method) } @except
178 and ( !$method_check->($method)
179 or first { $runtest->($_, $method) } @also)
180 } keys %$subs;
181
182 namespace::clean->clean_subroutines($cleanee, @clean);
183 };
184}
185
186sub _method_check {
187 my $package = shift;
188 if (
189 (defined &Class::MOP::class_of and my $meta = Class::MOP::class_of($package))
190 ) {
191 my %methods = map +($_ => 1), $meta->get_method_list;
192 $methods{meta} = 1
193 if $meta->isa('Moose::Meta::Role') && Moose->VERSION < 0.90;
194 return sub { $_[0] =~ /^\(/ || $methods{$_[0]} };
195 }
196 else {
197 my $does = $package->can('does') ? 'does'
198 : $package->can('DOES') ? 'DOES'
199 : undef;
200 require Sub::Identify;
201 return sub {
202 return 1 if $_[0] =~ /^\(/;
203 my $coderef = do { no strict 'refs'; \&{ $package . '::' . $_[0] } };
204 my $code_stash = Sub::Identify::stash_name($coderef);
205 return 1 if $code_stash eq $package;
206 return 1 if $code_stash eq 'constant';
207 # TODO: consider if we really need this eval
208 return 1 if $does && eval { $package->$does($code_stash) };
209 return 0;
210 };
211 }
212}
213
2141;
215
216__END__