File Coverage

blib/lib/Class/Accessor/Inherited/XS/Compat.pm
Criterion Covered Total %
statement 28 28 100.0
branch 4 4 100.0
condition 4 5 80.0
subroutine 9 9 100.0
pod 0 5 0.0
total 45 51 88.2


line stmt bran cond sub pod time code
1             package Class::Accessor::Inherited::XS::Compat;
2 38     38   641957 use 5.010001;
  38         246  
3 38     38   208 use strict;
  38         77  
  38         807  
4 38     38   206 use warnings;
  38         101  
  38         1163  
5              
6 38     38   11983 use parent 'Exporter';
  38         8266  
  38         252  
7             our @EXPORT_OK = qw/mk_type_accessors mk_inherited_accessors mk_class_accessors mk_varclass_accessors mk_object_accessors/;
8              
9             require Class::Accessor::Inherited::XS;
10              
11             sub mk_type_accessors {
12 17     17 0 2048 my ($class, $type) = (shift, shift);
13              
14             {
15 17         37 require mro;
  17         99  
16 17         61 state $seen = {};
17 17         67 state $message = <
18             Inheriting from 'Class::Accessor::Inherited::XS' is deprecated, this behavior will be removed in the next version! To use __PACKAGE__->mk_${type}_accessors form inherit from 'Class::Accessor::Inherited::XS::Compat' instead.
19             EOF
20 17 100 100     100 warn $message if !$seen->{$class}++ && scalar grep { $_ eq 'Class::Accessor::Inherited::XS' } @{ mro::get_linear_isa($class) };
  40         186  
  13         91  
21             }
22              
23 17         572 my ($installer, $clone_arg) = Class::Accessor::Inherited::XS->_type_installer($type);
24              
25 17         59 for my $entry (@_) {
26 24 100       134 if (ref($entry) eq 'ARRAY') {
27 9         29 $installer->($class, @$entry);
28              
29             } else {
30 15   66     85 $installer->($class, $entry, $clone_arg && $entry);
31             }
32             }
33             }
34              
35             sub mk_inherited_accessors {
36 7     7 0 22447 mk_type_accessors(shift, 'inherited', @_);
37             }
38              
39             sub mk_class_accessors {
40 6     6 0 343 mk_type_accessors(shift, 'class', @_);
41             }
42              
43             sub mk_varclass_accessors {
44 2     2 0 193 mk_type_accessors(shift, 'varclass', @_);
45             }
46              
47             sub mk_object_accessors {
48 1     1 0 91 mk_type_accessors(shift, 'object', @_);
49             }
50              
51             1;