File Coverage

blib/lib/UNIVERSAL/Object/Immutable.pm
Criterion Covered Total %
statement 33 33 100.0
branch 8 8 100.0
condition 3 3 100.0
subroutine 10 10 100.0
pod 1 1 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1             package UNIVERSAL::Object::Immutable;
2             # ABSTRACT: Another useful base class
3 3     3   209726 use 5.008;
  3         34  
4 3     3   15 use strict;
  3         14  
  3         83  
5 3     3   17 use warnings;
  3         6  
  3         105  
6              
7 3     3   18 use Carp ();
  3         6  
  3         42  
8 3     3   3683 use overload ();
  3         2987  
  3         76  
9 3     3   1643 use Hash::Util ();
  3         8397  
  3         78  
10 3     3   20 use Scalar::Util ();
  3         6  
  3         54  
11              
12 3     3   1356 use UNIVERSAL::Object;
  3         9  
  3         193  
13              
14             our $VERSION = '0.15';
15             our $AUTHORITY = 'cpan:STEVAN';
16              
17 3     3   760 our @ISA; BEGIN { @ISA = ('UNIVERSAL::Object') }
18              
19             sub new {
20 9     9 1 486 my $class = shift;
21 9         50 my $self = $class->SUPER::new( @_ );
22 9         29 my $repr = overload::StrVal($self);
23              
24 9 100 100     99 if ( $repr =~ /\=HASH\(0x/ ) {
    100          
    100          
    100          
25 4         14 Hash::Util::lock_hash( %$self );
26             }
27             elsif ( $repr =~ /\=ARRAY\(0x/ ) {
28 1         6 Internals::SvREADONLY( @$self, 1 );
29             }
30             elsif ( $repr =~ /\=SCALAR\(0x/ or $repr =~ /\=REF\(0x/ ) {
31 2         10 Internals::SvREADONLY( $$self, 1 );
32             }
33             elsif ( $repr =~ /\=CODE\(0x/ ) {
34             # NOTE: do nothing here, because – ignoring
35             # closures – CODE refs are immutable anyway
36             }
37             else {
38 1         226 Carp::confess('Invalid BLESS args for '.Scalar::Util::blessed($self).', unsupported REPR type ('.Scalar::Util::reftype($self).')');
39             }
40              
41 8         107 return $self;
42             }
43              
44             1;
45              
46             __END__