package strict::can;

use warnings;
use strict;
use vars qw( $VERSION );
use B qw/svref_2object/;
use base 'Exporter';
our @EXPORT = qw(can);

my $package_for = sub {
    my $package;
    eval {
        my $stash = svref_2object(shift)->STASH;
        if ( $stash && $stash->can('NAME') ) {
            $package = $stash->NAME;
        }
        else {
            $package = '';
        }
    };
    if ($@) {
        warn "Could not determine calling package: $@";
    }
    return $package;
};

sub can {
    my ( $proto, $method ) = @_;

    return if '_' eq substr $method, 0, 1;
    my $class = ref $proto || $proto;
    if ( my $code = $proto->SUPER::can($method) ) {
        my $code_package = $package_for->($code);
        if ( $code_package eq $class || $class->isa($code_package) ) {
            return $code;
        }
        else {
            return;
        }
    }
    return;
}

1;