File Coverage

blib/lib/UNIVERSAL/Object/Immutable.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	15	16	93.7
condition	12	12	100.0
subroutine	11	11	100.0
pod	1	1	100.0
total	80	81	98.7

package UNIVERSAL::Object::Immutable;
# ABSTRACT: Another useful base class
use 5.008;
use strict;
use warnings;

use Carp         ();
use overload     ();
use Hash::Util   ();
use Scalar::Util ();

use UNIVERSAL::Object;

our $VERSION   = '0.17';
our $AUTHORITY = 'cpan:STEVAN';

our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object') }

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new( @_ );
    my $repr  = overload::StrVal($self);

    if ( $repr =~ /\=HASH\(0x/ ) {
        Hash::Util::lock_hash( %$self );
    }
    elsif ( $repr =~ /\=ARRAY\(0x/ ) {
        Internals::SvREADONLY( @$self, 1 );
    }
    elsif ( $repr =~ /\=SCALAR\(0x/ or $repr =~ /\=REF\(0x/ or $repr =~ /\=REGEXP\(0x/ ) {
        Internals::SvREADONLY( $$self, 1 );
    }
    elsif ( $repr =~ /\=CODE\(0x/ ) {
        # NOTE: do nothing here, because – ignoring
        # closures – CODE refs are immutable anyway
    }
    else {
        Carp::confess('Invalid BLESS args for '.Scalar::Util::blessed($self).', unsupported REPR type ('.Scalar::Util::reftype($self).')');
    }

    return $self;
}

sub DESTROY {
    my $self = $_[0];
    my $repr = overload::StrVal($self);

    # reverse the locks for all types ...
    if ( $repr =~ /\=HASH\(0x/ ) {
        Hash::Util::unlock_hash( %$self );
    }
    elsif ( $repr =~ /\=ARRAY\(0x/ ) {
        Internals::SvREADONLY( @$self, 0 );
    }
    elsif ( $repr =~ /\=SCALAR\(0x/ or $repr =~ /\=REF\(0x/ or $repr =~ /\=REGEXP\(0x/ ) {
        Internals::SvREADONLY( $$self, 0 );
    }
    else {
        # nothing here ...
    }

    $self->can('DEMOLISH') && UNIVERSAL::Object::Util::DEMOLISHALL( $self );
    return;
}

1;

__END__