Decide if a sub calling from current package

When you're writing a Perl module, this subroutine can test if your sub is called from current package:

sub __in_current_package__ {
    my $level = 0;
    my @c = caller(++$level);
    while ( @c > 0 ) {
        return 1 if defined $c[0] && $c[0] eq __PACKAGE__;
        @c = caller(++$level);
    }
    return 0;
}

How you use it:

sub do_something {
    if (__in_current_package__) {
        return &do_this;
    }
    return &do_that;
}

Labels: perl