package One;

use strict;
use warnings;

use constant FOO => 1;

sub bar { 1 };

foreach ( qw/ FOO One::FOO Two::FOO bar / ) {
    if ( Two::is_constant( $_ ) ) {
        print "Yes\n";
    } else {
        print "No\n";
    }
}


package Two;

=pod

is_constant($sub_name) - returns true if subroutine is a
constant, false if not.  $sub_name must be the fully
qualified name (Package::name) of a subroutine.

=cut

sub is_constant {
    no strict 'refs';
    my $name = shift;

    if ( $name !~ /::/ ) {
        $name = (caller)[0]."::$name";
    }
    my $code = *{$name}{CODE};

    # must have any empty prototype to be a constant
    my $proto;
    #print "->$code<-\n";
    if ( ref $code ) {
        $proto = prototype($code);
    }

    return 0 if defined $proto and length $proto;

    # attempt to redefine to itself - this will cause a
    # warning for a real constant that starts with "Constant"
    my $is_const;
    {
        local $SIG{__WARN__} = sub { $is_const = 1 if $_[0] =~ /^Constant/ };
        eval { *{$name} = sub () { "TEST" } };
    }

    # set it back
    {
        no warnings;
        eval { *{$name} = $code; };
    }

    # all done
    return $is_const;
}