Object::Deadly::_unsafe - Implementation for the deadly object

Object-Deadly documentation Contained in the Object-Deadly distribution.

Index

Code Index:

NAME

Top

Object::Deadly::_unsafe - Implementation for the deadly object

METHODS

Top

$obj->DESTROY

The DESTROY method doesn't die. This is defined so it won't be AUTOLOADed or fetched from UNIVERSAL.

$obj->isa
$obj->can
$obj->version
$obj->DOES
$obj->import
$obj->require
$obj->use
$obj->blessed
$obj->dump
$obj->peek
$obj->refaddr
$obj->exports
$obj->moniker
$obj->plural_moniker
$obj->which
$obj->AUTOLOAD

Each of AUTOLOAD, a named list of known UNIVERSAL functions and then a query for everything currently known are all implemented with Object::Deadly->get_death to prevent anything from sneaking through to a successful call against something in UNIVERSAL.

That list of functions are what core perl uses plus a bunch from CPAN modules including UNIVERSAL, UNIVERSAL::require, UNIVERSAL::dump, UNIVERSAL::exports, UNIVERSAL::moniker, UNIVERSAL::which. That's just the list as it exists today. If someone else creates a new one and you load it, be sure to do it *prior* to loading this module so I can have at least a chance at noticing anything it's loaded.

SEE ALSO

Top

Object::Deadly, Object::Deadly::_safe

Object-Deadly documentation Contained in the Object-Deadly distribution. 
## no critic (Version,PodSections,Warnings,Rcs)
package Object::Deadly::_unsafe;

use strict;

use overload ();
my $death = Object::Deadly->get_death;
overload->import(
    map {
        my $bad_operation = $_;

        # returns a pair.
        $bad_operation => sub {

            ## no critic Local
            local *__ANON__ = __PACKAGE__ . "::$bad_operation";
            $death->( $_[0], "Overloaded $bad_operation" );
            }
        }
        map { split ' ' }    ## no critic EmptyQuotes
        values %overload::ops    ## no critic PackageVars
);

# Kill off all UNIVERSAL things and try it at several points during
# execution just in case someone added something along the way.
use Object::Deadly ();
Object::Deadly->kill_UNIVERSAL;

# Eval CHECK and INIT blocks into existance but only if we haven't
# reached the main program yet. This is just to avoid the warning.
use B ();
use English '$EVAL_ERROR';       ## no critic

BEGIN {
    if ( not ${ B::main_start() } ) {
        eval <<"CODE";           ## no critic
#line @{[__LINE__]} "@{[__FILE__]}"
            CHECK { Object::Deadly->kill_UNIVERSAL; }
            INIT  { Object::Deadly->kill_UNIVERSAL; }
CODE
        croak $EVAL_ERROR if $EVAL_ERROR;
    }
}

END { Object::Deadly->kill_UNIVERSAL; }

Object::Deadly->kill_function('AUTOLOAD');

use vars '%SIMPLE_OBJECTS';

# DESTROY is the only legal method for these objects. It has to be.
sub DESTROY {
    delete $Object::Deadly::SIMPLE_OBJECTS{ Object::Deadly::refaddr $_[0] };
    return;
}

sub death {    ## no critic RequireFinalReturn
               # The common death
    my ( $self, $bad_operation ) = @_;

    my $unsafe_implementation_class = Object::Deadly::blessed $self;
    my $addr                        = Object::Deadly::refaddr $self;
    my $name = sprintf '%s=(0x%07x)', $unsafe_implementation_class, $addr;
    my $message;
    if ( exists $SIMPLE_OBJECTS{$addr} ) {

        # Fetch the message in the object by switching the object into
        # something that's safe.
        my $safe_implementation_class = $unsafe_implementation_class;
        $safe_implementation_class =~ s/\::_unsafe\z/::_safe/mx;

        bless $self, $safe_implementation_class;
        $message = $$self;    ## no critic DoubleSigils
        bless $self, $unsafe_implementation_class;

        Object::Deadly::confess
            "Attempt to call $bad_operation on $name: $message";
    }
    else {
        Object::Deadly::confess "Attempt to call $bad_operation on $name";
    }
}

1;

__END__


1;