File Coverage

blib/lib/MooX/XSConstructor.pm
Criterion Covered Total %
statement 53 58 91.3
branch 12 22 54.5
condition 5 12 41.6
subroutine 10 10 100.0
pod 0 2 0.0
total 80 104 76.9


line stmt bran cond sub pod time code
1 1     1   68957 use 5.008001;
  1         5  
2 1     1   7 use strict;
  1         4  
  1         26  
3 1     1   5 use warnings;
  1         3  
  1         64  
4              
5             package MooX::XSConstructor;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.001';
9              
10 1     1   5 use Moo 1.006000 ();
  1         18  
  1         41  
11 1     1   6 use Scalar::Util qw(blessed);
  1         1  
  1         60  
12 1     1   404 use Hook::AfterRuntime;
  1         2560  
  1         494  
13              
14             my $safe_spec = qr/\A(index|required|is|isa|builder|default|lazy|predicate|clearer|reader|writer)\z/;
15              
16             sub is_suitable_class {
17 1     1 0 2 my $self = shift;
18 1         3 my ($klass, $maybe_spec) = @_;
19            
20 1         5 my $ba = $klass->can('BUILDARGS');
21 1 50       5 return if $ba != \&Moo::Object::BUILDARGS;
22 1 50       17 return if $klass->can('FOREIGNBUILDARGS');
23            
24 1 50       3 my %spec = %{ $maybe_spec or Moo->_constructor_maker_for($klass)->all_attribute_specs };
  1         4  
25 1         7 my @attributes = sort { $spec{$a}{index} <=> $spec{$b}{index} } keys %spec;
  1         7  
26            
27 1         3 for my $attr (@attributes) {
28 2 50 33     6 if ($spec{$attr}{isa} and !blessed($spec{$attr}{isa})) {
29 0         0 return;
30             }
31 2 50 33     21 if ($spec{$attr}{isa} and !$spec{$attr}{isa}->can('compiled_check')) {
32 0         0 return;
33             }
34 2 50 33     7 if ($spec{$attr}{default} and not $spec{$attr}{lazy}) {
35 0         0 return;
36             }
37 2 50 66     10 if ($spec{$attr}{builder} and not $spec{$attr}{lazy}) {
38 0         0 return;
39             }
40 2 50       4 if (my @unsafe = grep { $_ !~ $safe_spec } keys %{ $spec{$attr} }) {
  9         35  
  2         9  
41             # print Dumper \@unsafe;
42 0         0 return;
43             }
44             }
45            
46 1         4 return "yay!";
47             }
48              
49             sub setup_for {
50 1     1 0 4 my $self = shift;
51 1         2 my ($klass) = @_;
52            
53 1         2 my %spec = %{ Moo->_constructor_maker_for($klass)->all_attribute_specs };
  1         4  
54 1 50       13 return unless $self->is_suitable_class($klass, \%spec);
55            
56             my @optlist =
57             map {
58 2         4 my $attrbang = my $attr = $_;
59 2 100       5 $attrbang .= '!' if $spec{$attr}{required};
60 2 50       6 $spec{$attr}{isa} ? ($attrbang, $spec{$attr}{isa}) : ($attrbang);
61             }
62 1         3 sort { $spec{$a}{index} <=> $spec{$b}{index} }
  1         4  
63             keys %spec;
64            
65 1         456 require Class::XSConstructor;
66 1         5910 local $Class::XSConstructor::SETUP_FOR = $klass;
67 1         3 local $Class::XSConstructor::REDEFINE = !!1;
68 1         4 Class::XSConstructor->import(@optlist);
69             }
70              
71             sub import {
72 1     1   7 my $self = shift;
73 1         6 my $caller = caller;
74             after_runtime {
75 1     1   16474 $self->setup_for($caller);
76 1         6 };
77             }
78              
79             1;
80              
81             __END__