File Coverage

blib/lib/List/AssignRef.pm
Criterion Covered Total %
statement 36 37 97.3
branch 7 14 50.0
condition n/a
subroutine 13 14 92.8
pod 1 1 100.0
total 57 66 86.3


line stmt bran cond sub pod time code
1             package List::AssignRef;
2              
3 1     1   25061 use 5.006;
  1         4  
  1         43  
4 1     1   6 use strict;
  1         2  
  1         35  
5 1     1   5 use warnings;
  1         6  
  1         28  
6 1     1   978 use lvalue;
  1         2702  
  1         6  
7 1     1   55 use Carp qw( confess );
  1         3  
  1         50  
8 1     1   7 use Scalar::Util qw( reftype );
  1         2  
  1         137  
9              
10             use constant {
11 1         124 SCALAR => 'SCALAR',
12             ARRAY => 'ARRAY',
13             HASH => 'HASH',
14 1     1   8 };
  1         3  
15              
16             use constant {
17 1         145 ERR_UNSUPPORTED => "Unsupported reference type: %s",
18             ERR_MISMATCH => "Reference type mismatch: %s vs %s",
19 1     1   6 };
  1         2  
20              
21             BEGIN {
22 1     1   3 $List::AssignRef::AUTHORITY = 'cpan:TOBYINK';
23 1         53 $List::AssignRef::VERSION = '0.003';
24             }
25              
26 1         13 use Sub::Exporter -setup => {
27             exports => [qw( deref )],
28             groups => {
29             default => [qw( deref )],
30             },
31 1     1   245825 };
  1         36682  
32              
33             sub _confessf
34             {
35 1     1   3 my $fmt = shift;
36 1         288 confess sprintf $fmt, @_;
37             }
38              
39             sub deref (\[$@%]) :lvalue
40             {
41 6     6 1 3113 my $given = shift;
42             get {
43 0 0   0   0 reftype($given) eq SCALAR ? $$given :
    0          
    0          
44             reftype($given) eq ARRAY ? @$given :
45             reftype($given) eq HASH ? %$given :
46             _confessf(ERR_UNSUPPORTED, reftype($given));
47             }
48             set {
49 6     6   234 my $assign = shift;
50 6 100       37 reftype($given) eq reftype($assign)
51             or _confessf(ERR_MISMATCH, reftype($given), reftype($assign));
52 5 50       45 reftype($given) eq SCALAR ? ($$given = $$assign):
    100          
    100          
53             reftype($given) eq ARRAY ? (@$given = @$assign):
54             reftype($given) eq HASH ? (%$given = %$assign):
55             _confessf(ERR_UNSUPPORTED, reftype($given));
56             }
57 6         52 }
58              
59             1;
60              
61             __END__