File Coverage

blib/lib/namespace/sweep.pm

Criterion	Covered	Total	%
statement	75	84	89.2
branch	26	32	81.2
condition	9	20	45.0
subroutine	16	17	94.1
pod			n/a
total	126	153	82.3

package namespace::sweep;
{
  $namespace::sweep::VERSION = '0.006';
}

# ABSTRACT: Sweep up imported subs in your classes

use strict;
use warnings;

use Scalar::Util 'blessed', 'reftype';
use List::Util 'first';
use Carp 'croak';
use Data::Dumper;

use Sub::Identify          0.04 'get_code_info';
use B::Hooks::EndOfScope   0.09 'on_scope_end';
use Package::Stash         0.33;

$namespace::sweep::AUTHORITY = 'cpan:FRIEDO';

sub import {
    my ( $class, %args ) = @_;

    my $cleanee = exists $args{-cleanee} ? $args{-cleanee} : scalar caller;
    my @alsos;

    if ( exists $args{-also} ) {
        if ( ref $args{-also} && ( reftype $args{-also} eq reftype [ ] ) ) {
            @alsos = @{ $args{-also} };
        } else {
            @alsos = ( $args{-also} );
        }
    }

    my @also_tests;
    foreach my $also( @alsos ) {
        my $test = !$also                           ? sub { 0 }
                 : !ref( $also )                    ? sub { $_[0] eq $also }
                 : reftype $also eq reftype sub { } ? sub { local $_ = $_[0]; $also->() }
                 : reftype $also eq reftype qr//    ? sub { $_[0] =~ $also }
                 : croak sprintf q{Don't know what to do with [%s] for -also}, $also;

        push @also_tests, $test;
    }

    my $run_test = sub {
        return 1 if first { $_->( $_[0] ) } @also_tests;
        return;
    };

    on_scope_end {
        no strict 'refs';
        my $st = $cleanee . '::';
        my $ps = Package::Stash->new( $cleanee );

        my $sweep = sub {
            # stolen from namespace::clean
            my @symbols = map {
                my $name = $_ . $_[0];
                my $def = $ps->get_symbol( $name );
                defined($def) ? [$name, $def] : ()
            } '$', '@', '%', '';

            $ps->remove_glob( $_[0] );
            $ps->add_symbol( @$_ ) for @symbols;
        };

        my %keep;
        my $class_of_cm = UNIVERSAL::can('Class::MOP', 'can')  && 'Class::MOP'->can('class_of');
        my $class_of_mu = UNIVERSAL::can('Mouse::Util', 'can') && 'Mouse::Util'->can('class_of');
        if ( $class_of_cm or $class_of_mu ) {
            # look for moose-ish composed methods
            my ($meta) =
                grep { !!$_ }
                map  { $cleanee->$_ }
                grep { defined $_ }
                ($class_of_cm, $class_of_mu);
            if ( blessed $meta && $meta->can( 'get_all_method_names' ) ) {
                %keep = map { $_ => 1 } $meta->get_all_method_names;
            }
        }

        foreach my $sym( keys %{ $st } ) {
            $sweep->( $sym ) and next if $run_test->( $sym );

            next unless exists &{ $st . $sym };
            next if $keep{$sym};

            my ( $pkg, $name ) = get_code_info \&{ $st . $sym };
            next if $pkg eq $cleanee;                       # defined in the cleanee pkg
            next if $pkg eq 'overload' and $name eq 'nil';  # magic overload method

            $sweep->( $sym );
        }
    };

}

1;

__END__