http://www.perlmonks.org?node_id=361054

Public Scratchpad

Download, Select Code To D/L

---

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;

}
[download]

Perl Monks Approved HTML tags