package Class::HideMethods;
use strict;
use warnings;
use Attribute::Handlers;
sub import
{
my ($self,$ref) = @_;
my $package = caller();
$prefixes{ $package } = $ref;
}
sub gen_prefix
{
my $invalid_chars = "\0\r\n\f\b";
my $prefix;
for (1..5){
my $chars_pos = int (rand(length($invalid_chars)));
$prefix .= substr ($invalid_chars, $char_pos, 1);
}
return $prefix;
}
package UNIVERSAL;
sub Private :ATTR
{
my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
my $name = *{ $symbol }{NAME};
my $newname = Class::HideMethods::gen_prefix ($package) . $name;
my @refs = map { *$symbol{$_}} qw (HASH SCALAR ARRAY GLOB);
*$symbol = do {local *symbol};
no strict 'refs';
*{ $package . '::' . $newname } = $referent;
*{ $package . '::' . $name } = $_ for @refs;
$prefixes{ $package }{$name} = $newname;
}
1;
To use this module:
package SecretClass;
my %methods;
use Class::HideMethods \%methods;
sub new { bless {}, shift }
sub hello :Private { return 'hello' }
sub goodbye { return 'goodbye' }
sub public_hello
{
my $self = shift;
my $hello = $methods{hello}
$self -> $hello();
}
1;
To prove that it works:
use Test::More tests => 6;
my $sc = SecretClass->new();
isa_ok ($sc, 'SecretClass' );
ok (! $sc->can ('hello'), 'hello() should be hidden' );
ok ($sc->can('public_hello'), 'public_hello() should be available');
is ($sc->public_hello(),'hello', '... and should be able to call hello
+()' );
ok ($sc->can('goodbye'), 'goodbye() should be available');
is ($sc->goodbye(), 'goodbye', '... and should be callable');