Coverage Summary

# File Coverage

lib/List/Objects/WithUtils/Role/Hash/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::Hash::Immutable;
2 | 14 |  |  | 14 | use strictures 1;
| 14 |  |  |  |
| 14 |  |  |  |
3 | 14 |  |  | 14 | use Carp ();
| 14 |  |  |  |
| 14 |  |  |  |
4 | 14 |  |  | 14 | use Tie::Hash ();
| 14 |  |  |  |
| 14 |  |  |  |
5 |  |  |  |  |
6 |  |  |  |  | sub _make_unimp {
7 | 42 |  |  | 42 | my ($method) = @_;
8 |  |  |  |  | sub {
9 | 6 |  |  | 6 | local $Carp::CarpLevel = 1;
10 | 6 |  |  |  | Carp::croak "Method '$method' not implemented on immutable hashes"
11 |  |  |  |  | }
12 | 42 |  |  |  | }
13 |  |  |  |  |
14 |  |  |  |  | our @ImmutableMethods = qw/
15 |  |  |  |  | clear
16 |  |  |  |  | set
17 |  |  |  |  | delete
18 |  |  |  |  | /;
19 |  |  |  |  |
20 | 14 |  |  | 14 | use Role::Tiny;
| 14 |  |  |  |
| 14 |  |  |  |
21 |  |  |  |  | requires 'new', @ImmutableMethods;
22 |  |  |  |  |
23 |  |  |  |  | around is_mutable => sub { () };
24 |  |  |  |  |
25 |  |  |  |  | around new => sub {
26 |  |  |  |  | my ($orig, $class) = splice @_, 0, 2;
27 |  |  |  |  | my $self = $class->$orig(@_);
28 |  |  |  |  |
29 |  |  |  |  |
30 |  |  |  |  | # This behavior changed in c. 45f59a73 --
31 |  |  |  |  | # we can revert back if Hash::Util gains the flexibility discussed on p5p
32 |  |  |  |  | # (lock_keys without an exception on unknown key retrieval)
33 |  |  |  |  | # For now, take the tie performance hit :(
34 |  |  |  |  |
35 |  |  |  |  | unless (tied %$self) {
36 |  |  |  |  | tie %$self, 'Tie::StdHash';
37 |  |  |  |  | %$self = @_;
38 |  |  |  |  | }
39 |  |  |  |  |
40 |  |  |  |  | Role::Tiny->apply_roles_to_object( tied(%$self),
41 |  |  |  |  | 'List::Objects::WithUtils::Role::Hash::TiedRO'
42 |  |  |  |  | );
43 |  |  |  |  |
44 |  |  |  |  | $self
45 |  |  |  |  | };
46 |  |  |  |  |
47 |  |  |  |  | around $_ => _make_unimp($_) for @ImmutableMethods;
48 |  |  |  |  |
49 |  |  |  |  | 1;
50 |  |  |  |  |
51 |  |  |  |  | =pod
52 |  |  |  |  |
53 |  |  |  |  | =head1 NAME
54 |  |  |  |  |
55 |  |  |  |  | List::Objects::WithUtils::Role::Hash::Immutable - Immutable hash behavior
56 |  |  |  |  |
57 |  |  |  |  | =head1 SYNOPSIS
58 |  |  |  |  |
59 |  |  |  |  | # Via List::Objects::WithUtils::Hash::Immutable ->
60 |  |  |  |  | use List::Objects::WithUtils 'immhash';
61 |  |  |  |  | my $hash = immhash( foo => 1, bar => 2 );
62 |  |  |  |  | $hash->set(foo => 3); # dies
63 |  |  |  |  |
64 |  |  |  |  | =head1 DESCRIPTION
65 |  |  |  |  |
66 |  |  |  |  | This role adds immutable behavior to L<List::Objects::WithUtils::Role::Hash>
67 |  |  |  |  | consumers.
68 |  |  |  |  |
69 |  |  |  |  | The following methods are not available and will throw an exception:
70 |  |  |  |  |
71 |  |  |  |  | clear
72 |  |  |  |  | set
73 |  |  |  |  | delete
74 |  |  |  |  |
75 |  |  |  |  | (The backing hash is also marked read-only.)
76 |  |  |  |  |
77 |  |  |  |  | See L<List::Objects::WithUtils::Hash::Immutable> for a consumer
78 |  |  |  |  | implementation.
79 |  |  |  |  |
80 |  |  |  |  | =head1 AUTHOR
81 |  |  |  |  |
82 |  |  |  |  | Jon Portnoy <avenj@cobaltirc.org>
83 |  |  |  |  |
84 |  |  |  |  | =cut
85 |  |  |  |  |