Coverage Summary

# 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 |  |  |  |  |