One could implement something using the caller builtin, i.e. :-

use strict;

&foo;
&badfoo;

sub foo {
    &bar;
}

sub badfoo {
    &bar;
}

sub bar {
    if ((caller(1))[3] ne 'main::foo') {
        die((caller(0))[3], 
            ": can not be called from ", 
            (caller(1))[3], 
            " due to restrictions");
    }
    print "called sub ",(caller(0))[3], "\n";
}
[download]

Update: changed "print STDERR" to "die"