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__ |