my $PACKAGE = caller(0);

##</code><code>##

package Private;

use Exporter;
@ISA = 'Exporter';
@EXPORT = 'is_private';

use strict;
use warnings;

use Carp;

sub is_private()
{
    my %c0; @c0{qw( pkg fn l sub )} = caller 0;
    my %c1; @c1{qw( pkg fn l sub )} = caller 1;

    if ( $c0{'pkg'} ne $c1{'pkg'} ) # throw an exception:
    {
        my %c2; @c2{qw( pkg fn l sub )} = caller 2;
        my $caller = $c2{'sub'} || $c2{'pkg'} || 'main';
        croak "$caller cannot call $c1{'sub'} (private to $c0{'pkg'})";
    }
}

1;


##</code><code>##


{
  package Parent;
  use Private;
  sub private_method { is_private; print "Private method calleed OK.\n" }
  sub public_method { $_[0]->private_method }
}

{
  package Child;
  use base 'Parent';
  sub child_calling_private { $_[0]->private_method }
  sub child_calling_public { $_[0]->public_method }
}

package main;

print "\nBase class: call private method directly:\n";
eval {  Parent->private_method }; $@ and print $@;

print "\nBase class: call public method that calls private method:\n";
eval {  Parent->public_method; }; $@ and print $@;

print "\nDerived class: call parent's private method directly:\n";
eval {  Child->private_method }; $@ and print $@;

print "\nDerived class: call parent's public method that calls private method:\n";
eval {  Child->public_method; }; $@ and print $@;

print "\nDerived class: call method that calls parent's private method:\n";
eval { Child->child_calling_private; }; $@ and print $@;

print "\nDerived class: call method that calls parent's public method:\n";
eval { Child->child_calling_public; }; $@ and print $@;