view release on metacpan or  search on metacpan

lib/App/perlimports/ExportInspector.pm  view on Meta::CPAN

        return [ @{ shift->_pkg_for_implicit . '::ISA' } ];
    },
);

has _pkg_for_implicit => (
    is      => 'ro',
    isa     => Str,
    lazy    => 1,
    default => sub { return shift()->_random_pkg_name },
);

has success_counter => (
    traits  => ['Counter'],
    is      => 'ro',
    isa     => Int,
    default => 0,
    handles => {
        _increment_success_counter => 'inc',
    },
);

has uses_moose => (
    is      => 'ro',
    isa     => Bool,
    lazy    => 1,
    builder => '_build_uses_moose',
);

sub evals_ok {
    my $self = shift;

    $self->explicit_exports;
    $self->implicit_exports;
    return $self->success_counter;
}

sub _build_explicit_exports {
    my $self = shift;

    # If this is Exporter, then the exportable symbols will be listed in either
    # @EXPORT or @EXPORT_OK. Maybe in both?
    if ( $self->has_at_export_ok || $self->has_at_export ) {
        return $self->_list_to_hash(
            $self->_pkg_for_implicit,    # reuse package name
            [ @{ $self->at_export }, @{ $self->at_export_ok } ]
        );
    }

    # If this is Sub::Exporter, we can cheat and see what's in the :all tag
    my $pkg           = $self->_random_pkg_name;
    my $use_statement = sprintf( 'use %s qw(:all);', $self->_module_name );
    my ( $exports, $fatal_error )
        = $self->_exports_for_include( $pkg, $use_statement );
    if ($fatal_error) {
        return { fatal_error => $fatal_error };
    }

    return $self->_list_to_hash( $pkg, $exports );

    # If this module uses something other than Exporter or Sub::Exporter, we
    # probably returned an empty hash above.  We could guess and say it's the
    # default exports + possibly something else.  It's probably less confusing
    # to leave it up to the code which uses this object to decide how to handle
    # it.
}

sub _build_import_flags {
    my $self = shift;

    my %modules = (
        Carp    => ['verbose'],
        English => ['-no_match_vars'],
    );

    return
        exists $modules{ $self->_module_name }
        ? $modules{ $self->_module_name }
        : [];
}

sub _build_is_exporter {
    my $self = shift;

    return 1 if any { $_ eq 'Exporter' } @{ $self->class_isa };
    return $self->has_at_export || $self->has_at_export_ok ? 1 : 0;
}

sub _build_is_oo_class {
    my $self = shift;

    return 0 if $self->has_implicit_exports || $self->has_explicit_exports;

    my $methods
        = Class::Inspector->methods( $self->_module_name, 'full', 'public' );

    return any {
        $_ eq 'Moose::Object::BUILDALL' || $_ eq 'Moo::Object::BUILDALL'
    } @{$methods};
}

sub _build_isa_test_builder {
    my $self = shift;
    if ( any { $_ eq 'Test::Builder::Module' }
        @{ $self->_implicit->{class_isa} } ) {
        return 1;
    }

    return 0 if $self->_module_name !~ m{\ATest};

    my $err = App::perlimports::Sandbox::eval_pkg(
        $self->_module_name,
        sprintf( 'use %s qw( some_function );', $self->_module_name )
    );

    # Catch cases like Test::HTML::Lint, where, which doesn't subclass
    # Test::Builder, but essentially calls Tester::Builder->new->plan(@_); in
    # its import(). The error will be something like "plan() doesn't understand
    # some_function at"
    if ( $err =~ m{plan} ) {
        return 1;
    }