File Coverage

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
total 22 22 100.0


line stmt bran cond sub code
1         package List::Objects::WithUtils::Role::Array::Immutable;
2 15     15 use strictures 1;
  15        
  15        
3 15     15 use Carp ();
  15        
  15        
4 15     15 use Tie::Array ();
  15        
  15        
5          
6         sub _make_unimp {
7 150     150   my ($method) = @_;
8           sub {
9 20     20     local $Carp::CarpLevel = 1;
10 20           Carp::croak "Method '$method' not implemented on immutable arrays"
11           }
12 150       }
13          
14         our @ImmutableMethods = qw/
15         clear
16         set
17         pop push
18         shift unshift
19         delete delete_when
20         insert
21         splice
22         /;
23          
24 15     15 use Role::Tiny;
  15        
  15        
25         requires 'new', @ImmutableMethods;
26          
27         around is_mutable => sub { () };
28          
29         around new => sub {
30           my ($orig, $class) = splice @_, 0, 2;
31           my $self = $class->$orig(@_);
32          
33         # SvREADONLY behavior is not very reliable.
34         # Remove mutable behavior from our backing tied array instead:
35          
36           unless (tied @$self) {
37         # If we're already tied, something else is going on,
38         # like we're a typed array.
39         # Otherwise, tie a StdArray & push items.
40             tie @$self, 'Tie::StdArray';
41             push @$self, @_
42           }
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[<LeoNerd> Coroutines are not magic pixiedust\n],
55          qq[<DrForr> LeoNerd: Any sufficiently advanced technology.\n],
56          qq[<LeoNerd> 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<List::Objects::WithUtils::Role::Array>
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         splice
87        
88         (The backing array is also marked read-only.)
89        
90         See L<List::Objects::WithUtils::Array::Immutable> for a consumer
91         implementation that also pulls in L<List::Objects::WithUtils::Role::Array> &
92         L<List::Objects::WithUtils::Role::Array::WithJunctions>.
93        
94         =head1 AUTHOR
95        
96         Jon Portnoy <avenj@cobaltirc.org>
97        
98         Licensed under the same terms as Perl.
99        
100         =cut
101