File Coverage

blib/lib/List/Objects/WithUtils/Role/Array/Immutable.pm
Criterion Covered Total %
statement 16 16 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 22 100.0


line stmt bran cond sub pod time code
1             package List::Objects::WithUtils::Role::Array::Immutable;
2             $List::Objects::WithUtils::Role::Array::Immutable::VERSION = '2.028002';
3 99     99   40656 use strictures 2;
  99         458  
  99         3213  
4 99     99   13142 use Carp ();
  99         132  
  99         1052  
5 99     99   5696 use Tie::Array ();
  99         12281  
  99         8618  
6              
7             sub _make_unimp {
8 1089     1089   4828 my ($method) = @_;
9             sub {
10 22     22   5501 local $Carp::CarpLevel = 1;
11 22         1739 Carp::croak "Method '$method' not implemented on immutable arrays"
12             }
13 1089         2640 }
14              
15             our @ImmutableMethods = qw/
16             clear
17             delete delete_when
18             insert
19             pop push
20             rotate_in_place
21             set
22             shift unshift
23             splice
24             /;
25              
26 99     99   371 use Role::Tiny;
  99         143  
  99         439  
27             requires 'new', @ImmutableMethods;
28              
29             around is_mutable => sub { () };
30              
31             around new => sub {
32             my ($orig, $class) = splice @_, 0, 2;
33             my $self = $class->$orig(@_);
34              
35             # SvREADONLY behavior is not very reliable.
36             # Remove mutable behavior from our backing tied array instead:
37              
38             # If we're already tied, something else is going on,
39             # like we're a typed array.
40             # Otherwise, tie a StdArray & push items.
41             tie @$self, 'Tie::StdArray' and push @$self, @_
42             unless tied @$self;
43              
44             Role::Tiny->apply_roles_to_object( tied(@$self),
45             'List::Objects::WithUtils::Role::Array::TiedRO'
46             );
47              
48             $self
49             };
50              
51             around $_ => _make_unimp($_) for @ImmutableMethods;
52              
53             print
54             qq[ Coroutines are not magic pixiedust\n],
55             qq[ LeoNerd: Any sufficiently advanced technology.\n],
56             qq[ DrForr: ... probably corrupts the C stack during XS calls? ;)\n],
57             unless caller;
58             1;
59              
60             =pod
61              
62             =head1 NAME
63              
64             List::Objects::WithUtils::Role::Array::Immutable - Immutable array behavior
65              
66             =head1 SYNOPSIS
67              
68             # Via List::Objects::WithUtils::Array::Immutable ->
69             use List::Objects::WithUtils 'immarray';
70             my $array = immarray(qw/ a b c /);
71             $array->push('d'); # dies
72              
73             =head1 DESCRIPTION
74              
75             This role adds immutable behavior to L
76             consumers.
77              
78             The following methods are not available and will throw an exception:
79              
80             clear
81             set
82             pop push
83             shift unshift
84             delete delete_when
85             insert
86             rotate_in_place
87             splice
88              
89             (The backing array is also marked read-only.)
90              
91             See L for a consumer
92             implementation that also pulls in L &
93             L.
94              
95             =head1 AUTHOR
96              
97             Jon Portnoy
98              
99             Licensed under the same terms as Perl.
100              
101             =cut