Re^4: OO - best way to have protected methods

[jdporter]

The problem, of course, is in the

my $PACKAGE = caller(0);

happening at package level.

Below is an implementation of your approach which is entirely scalable. It doesn't "remember" anything from 'import' time; it simply compares the package of the caller to the package of the callee, and requires that they be the same.

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;

Here's a little test rig.

{
  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 $@;