File Coverage

blib/lib/Object/InsideOut/attributes.pm
Criterion Covered Total %
statement 43 47 91.4
branch 7 10 70.0
condition 1 3 33.3
subroutine 12 15 80.0
pod n/a
total 63 75 84.0


line stmt bran cond sub pod time code
1             package Object::InsideOut; {
2              
3 1     1   4 use strict;
  1         1  
  1         24  
4 1     1   3 use warnings;
  1         1  
  1         23  
5 1     1   3 no warnings 'redefine';
  1         1  
  1         348  
6              
7             sub install_ATTRIBUTES
8             {
9             my ($GBL) = @_;
10              
11             *Object::InsideOut::MODIFY_SCALAR_ATTRIBUTES = sub
12             {
13 1     1   138 my ($pkg, $scalar, @attrs) = @_;
14              
15             # Call attribute handlers in the class tree
16 1 50       6 if (exists($$GBL{'attr'}{'MOD'}{'SCALAR'})) {
17 1         3 @attrs = CHECK_ATTRS('SCALAR', $pkg, $scalar, @attrs);
18             }
19              
20             # If using Attribute::Handlers, send it any unused attributes
21 1 50 33     6 if (@attrs &&
22             Attribute::Handlers::UNIVERSAL->can('MODIFY_SCALAR_ATTRIBUTES'))
23             {
24 0         0 return (Attribute::Handlers::UNIVERSAL::MODIFY_SCALAR_ATTRIBUTES($pkg, $scalar, @attrs));
25             }
26              
27             # Return any unused attributes
28 1         3 return (@attrs);
29             };
30              
31             *Object::InsideOut::CHECK_ATTRS = sub
32             {
33 3     3   5 my ($type, $pkg, $ref, @attrs) = @_;
34              
35             # Call attribute handlers in the class tree
36 3         3 foreach my $class (@{$$GBL{'tree'}{'bu'}{$pkg}}) {
  3         10  
37 7 100       17 if (my $handler = $$GBL{'attr'}{'MOD'}{$type}{$class}) {
38 4         14 local $SIG{'__DIE__'} = 'OIO::trap';
39 4         11 @attrs = $handler->($pkg, $ref, @attrs);
40 4 100       540 return if (! @attrs);
41             }
42             }
43              
44 2         5 return (@attrs); # Return remaining attributes
45             };
46              
47             *Object::InsideOut::FETCH_ATTRS = sub
48             {
49 1     1   2 my ($type, $stash, $ref) = @_;
50 1         1 my @attrs;
51              
52             # Call attribute handlers in the class tree
53 1 50       5 if (exists($$GBL{'attr'}{'FETCH'}{$type})) {
54 1         2 foreach my $handler (@{$$GBL{'attr'}{'FETCH'}{$type}}) {
  1         3  
55 1         4 local $SIG{'__DIE__'} = 'OIO::trap';
56 1         3 push(@attrs, $handler->($stash, $ref));
57             }
58             }
59              
60 1         12 return (@attrs);
61             };
62              
63             # Stub ourself out
64       3     *Object::InsideOut::install_ATTRIBUTES = sub { };
65             }
66              
67             add_meta('Object::InsideOut', {
68             'MODIFY_SCALAR_ATTRIBUTES' => {'hidden' => 1},
69             'CHECK_ATTRS' => {'hidden' => 1},
70             'FETCH_ATTRS' => {'hidden' => 1},
71             });
72              
73 1     1   9 sub FETCH_SCALAR_ATTRIBUTES :Sub { return (FETCH_ATTRS('SCALAR', @_)); }
  1     0   1  
  1         7  
  0         0  
74 1     1   91 sub FETCH_HASH_ATTRIBUTES :Sub { return (FETCH_ATTRS('HASH', @_)); }
  1     0   1  
  1         4  
  0         0  
75 1     1   108 sub FETCH_ARRAY_ATTRIBUTES :Sub { return (FETCH_ATTRS('ARRAY', @_)); }
  1     0   1  
  1         3  
  0         0  
76 1     1   84 sub FETCH_CODE_ATTRIBUTES :Sub { return (FETCH_ATTRS('CODE', @_)); }
  1     1   1  
  1         2  
  1         24  
77              
78             } # End of package's lexical scope
79              
80              
81             # Ensure correct versioning
82             ($Object::InsideOut::VERSION eq '4.04')
83             or die("Version mismatch\n");
84              
85             # EOF