sub bless {
my ($object, $class) = @_;
my $ref;
$ref = CORE::ref $object
if CORE::ref ($object) =~
/^(ARRAY|CODE|SCALAR|HASH|REF|GLOB|LVALUE)$/;
unless ($ref) {
if (UNIVERSAL::isa($object, 'HASH')) {
$ref = 'HASH';
} elsif (UNIVERSAL::isa($object, 'ARRAY')) {
$ref = 'ARRAY';
} elsif (UNIVERSAL::isa($object, 'SCALAR')) {
$ref = 'SCALAR';
}
}
CORE::bless($object, $class);
my ($proxy, %proxy, @proxy);
my $methprox;
if ($ref eq 'HASH') {
tie %proxy, 'Class::Privacy::Proxy', $object;
$methprox = CORE::bless
(\%proxy, 'Class::Privacy::MethodProxy');
} elsif ($ref eq 'ARRAY') {
tie @proxy, 'Class::Privacy::Proxy', $object;
$methprox = CORE::bless
(\@proxy, 'Class::Privacy::MethodProxy');
} elsif ($ref eq 'SCALAR') {
tie $proxy, 'Class::Privacy::Proxy', $object;
$methprox = CORE::bless
(\$proxy, 'Class::Privacy::MethodProxy');
} else {
croak "Class::Privacy can't create tied proxy for object $obje
+ct";
}
# create a new proxy object with $object hidden behind it
# the proxy object is tied, and
# handles data accesses of every sort (scalar,
# hash, array). The reference to it is blessed
# and handles methods. This gets round the Perl
# "dereferencing bypasses tying" bug. Dereferencing
# will always go to the tied proxy.
$hiddens{$methprox} = $object;
return $methprox;
}
Perl Monks Approved HTML tags
|