line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Type::Tiny::Duck; |
2
|
|
|
|
|
|
|
|
3
|
25
|
|
|
25
|
|
71084
|
use 5.008001; |
|
25
|
|
|
|
|
97
|
|
4
|
25
|
|
|
25
|
|
131
|
use strict; |
|
25
|
|
|
|
|
47
|
|
|
25
|
|
|
|
|
569
|
|
5
|
25
|
|
|
25
|
|
110
|
use warnings; |
|
25
|
|
|
|
|
53
|
|
|
25
|
|
|
|
|
1208
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
25
|
|
|
25
|
|
73
|
$Type::Tiny::Duck::AUTHORITY = 'cpan:TOBYINK'; |
9
|
25
|
|
|
|
|
1022
|
$Type::Tiny::Duck::VERSION = '2.004000'; |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$Type::Tiny::Duck::VERSION =~ tr/_//d; |
13
|
|
|
|
|
|
|
|
14
|
25
|
|
|
25
|
|
156
|
use Scalar::Util qw< blessed >; |
|
25
|
|
|
|
|
49
|
|
|
25
|
|
|
|
|
2407
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
6
|
sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } |
|
1
|
|
|
|
|
5
|
|
17
|
|
|
|
|
|
|
|
18
|
25
|
|
|
25
|
|
685
|
use Exporter::Tiny 1.004001 (); |
|
25
|
|
|
|
|
4878
|
|
|
25
|
|
|
|
|
593
|
|
19
|
25
|
|
|
25
|
|
2230
|
use Type::Tiny::ConstrainedObject (); |
|
25
|
|
|
|
|
50
|
|
|
25
|
|
|
|
|
32773
|
|
20
|
|
|
|
|
|
|
our @ISA = qw( Type::Tiny::ConstrainedObject Exporter::Tiny ); |
21
|
|
|
|
|
|
|
|
22
|
3
|
|
|
3
|
|
10
|
sub _short_name { 'Duck' } |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _exporter_fail { |
25
|
1
|
|
|
1
|
|
177
|
my ( $class, $type_name, $methods, $globals ) = @_; |
26
|
1
|
|
|
|
|
2
|
my $caller = $globals->{into}; |
27
|
1
|
|
|
|
|
4
|
my $type = $class->new( |
28
|
|
|
|
|
|
|
name => $type_name, |
29
|
|
|
|
|
|
|
methods => [ @$methods ], |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
$INC{'Type/Registry.pm'} |
32
|
|
|
|
|
|
|
? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) |
33
|
|
|
|
|
|
|
: ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) |
34
|
1
|
50
|
33
|
|
|
12
|
unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); |
|
|
50
|
33
|
|
|
|
|
35
|
1
|
|
|
|
|
2
|
return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; |
|
1
|
|
|
|
|
10
|
|
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub new { |
39
|
51
|
|
|
51
|
1
|
188
|
my $proto = shift; |
40
|
|
|
|
|
|
|
|
41
|
51
|
50
|
|
|
|
259
|
my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; |
|
0
|
|
|
|
|
0
|
|
42
|
51
|
100
|
|
|
|
215
|
_croak "Need to supply list of methods" unless exists $opts{methods}; |
43
|
|
|
|
|
|
|
|
44
|
50
|
50
|
|
|
|
185
|
$opts{methods} = [ $opts{methods} ] unless ref $opts{methods}; |
45
|
|
|
|
|
|
|
|
46
|
50
|
|
|
|
|
83
|
if ( Type::Tiny::_USE_XS ) { |
47
|
50
|
|
|
|
|
76
|
my $methods = join ",", sort( @{ $opts{methods} } ); |
|
50
|
|
|
|
|
230
|
|
48
|
50
|
|
|
|
|
249
|
my $xsub = Type::Tiny::XS::get_coderef_for( "HasMethods[$methods]" ); |
49
|
50
|
100
|
|
|
|
3146
|
$opts{compiled_type_constraint} = $xsub if $xsub; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
elsif ( Type::Tiny::_USE_MOUSE ) { |
52
|
|
|
|
|
|
|
require Mouse::Util::TypeConstraints; |
53
|
|
|
|
|
|
|
my $maker = "Mouse::Util::TypeConstraints"->can( "generate_can_predicate_for" ); |
54
|
|
|
|
|
|
|
$opts{compiled_type_constraint} = $maker->( $opts{methods} ) if $maker; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
50
|
|
|
|
|
358
|
return $proto->SUPER::new( %opts ); |
58
|
|
|
|
|
|
|
} #/ sub new |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _lockdown { |
61
|
47
|
|
|
47
|
|
116
|
my ( $self, $callback ) = @_; |
62
|
47
|
|
|
|
|
155
|
$callback->( $self->{methods} ); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
115
|
|
|
115
|
1
|
425
|
sub methods { $_[0]{methods} } |
66
|
205
|
|
66
|
205
|
1
|
1306
|
sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } |
67
|
|
|
|
|
|
|
|
68
|
396
|
|
|
396
|
1
|
1307
|
sub has_inlined { !!1 } |
69
|
|
|
|
|
|
|
|
70
|
658
|
|
|
658
|
|
1677
|
sub _is_null_constraint { 0 } |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub _build_constraint { |
73
|
7
|
|
|
7
|
|
14
|
my $self = shift; |
74
|
7
|
|
|
|
|
12
|
my @methods = @{ $self->methods }; |
|
7
|
|
|
|
|
37
|
|
75
|
|
|
|
|
|
|
return sub { |
76
|
21
|
50
|
|
21
|
|
161
|
blessed( $_[0] ) |
77
|
|
|
|
|
|
|
and not grep( !$_[0]->can( $_ ), @methods ); |
78
|
7
|
|
|
|
|
54
|
}; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _build_inlined { |
82
|
45
|
|
|
45
|
|
487
|
my $self = shift; |
83
|
45
|
|
|
|
|
67
|
my @methods = @{ $self->methods }; |
|
45
|
|
|
|
|
101
|
|
84
|
|
|
|
|
|
|
|
85
|
45
|
|
|
|
|
79
|
my $xsub; |
86
|
45
|
|
|
|
|
72
|
if ( Type::Tiny::_USE_XS ) { |
87
|
45
|
|
|
|
|
69
|
my $methods = join ",", sort( @{ $self->methods } ); |
|
45
|
|
|
|
|
96
|
|
88
|
45
|
|
|
|
|
194
|
$xsub = Type::Tiny::XS::get_subname_for( "HasMethods[$methods]" ); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub { |
92
|
205
|
|
|
205
|
|
298
|
my $var = $_[1]; |
93
|
205
|
|
|
|
|
302
|
local $" = q{ }; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# If $var is $_ or $_->{foo} or $foo{$_} or somesuch, then we |
96
|
|
|
|
|
|
|
# can't use it within the grep expression, so we need to save |
97
|
|
|
|
|
|
|
# it into a temporary variable ($tmp). |
98
|
205
|
100
|
|
|
|
968
|
my $code = |
99
|
|
|
|
|
|
|
( $var =~ /\$_/ ) |
100
|
|
|
|
|
|
|
? qq{ Scalar::Util::blessed($var) and not do { my \$tmp = $var; grep(!\$tmp->can(\$_), qw/@methods/) } } |
101
|
|
|
|
|
|
|
: qq{ Scalar::Util::blessed($var) and not grep(!$var->can(\$_), qw/@methods/) }; |
102
|
|
|
|
|
|
|
|
103
|
205
|
100
|
|
|
|
510
|
return qq{do { $Type::Tiny::SafePackage use Scalar::Util (); $code }} |
104
|
|
|
|
|
|
|
if $Type::Tiny::AvoidCallbacks; |
105
|
180
|
50
|
|
|
|
739
|
return "$xsub\($var\)" |
106
|
|
|
|
|
|
|
if $xsub; |
107
|
0
|
|
|
|
|
0
|
$code; |
108
|
45
|
|
|
|
|
604
|
}; |
109
|
|
|
|
|
|
|
} #/ sub _build_inlined |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub _instantiate_moose_type { |
112
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
113
|
0
|
|
|
|
|
0
|
my %opts = @_; |
114
|
0
|
|
|
|
|
0
|
delete $opts{parent}; |
115
|
0
|
|
|
|
|
0
|
delete $opts{constraint}; |
116
|
0
|
|
|
|
|
0
|
delete $opts{inlined}; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
0
|
require Moose::Meta::TypeConstraint::DuckType; |
119
|
0
|
|
|
|
|
0
|
return "Moose::Meta::TypeConstraint::DuckType" |
120
|
|
|
|
|
|
|
->new( %opts, methods => $self->methods ); |
121
|
|
|
|
|
|
|
} #/ sub _instantiate_moose_type |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub validate_explain { |
124
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
125
|
1
|
|
|
|
|
3
|
my ( $value, $varname ) = @_; |
126
|
1
|
50
|
|
|
|
4
|
$varname = '$_' unless defined $varname; |
127
|
|
|
|
|
|
|
|
128
|
1
|
50
|
|
|
|
9
|
return undef if $self->check( $value ); |
129
|
1
|
50
|
|
|
|
8
|
return ["Not a blessed reference"] unless blessed( $value ); |
130
|
|
|
|
|
|
|
|
131
|
1
|
|
|
|
|
540
|
require Type::Utils; |
132
|
|
|
|
|
|
|
return [ |
133
|
|
|
|
|
|
|
sprintf( |
134
|
|
|
|
|
|
|
'"%s" requires that the reference can %s', |
135
|
|
|
|
|
|
|
$self, |
136
|
1
|
|
|
|
|
5
|
Type::Utils::english_list( map qq["$_"], @{ $self->methods } ), |
137
|
|
|
|
|
|
|
), |
138
|
|
|
|
|
|
|
map sprintf( 'The reference cannot "%s"', $_ ), |
139
|
|
|
|
|
|
|
grep !$value->can( $_ ), |
140
|
1
|
|
|
|
|
5
|
@{ $self->methods } |
|
1
|
|
|
|
|
4
|
|
141
|
|
|
|
|
|
|
]; |
142
|
|
|
|
|
|
|
} #/ sub validate_explain |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
push @Type::Tiny::CMP, sub { |
145
|
|
|
|
|
|
|
my $A = shift->find_constraining_type; |
146
|
|
|
|
|
|
|
my $B = shift->find_constraining_type; |
147
|
|
|
|
|
|
|
return Type::Tiny::CMP_UNKNOWN |
148
|
|
|
|
|
|
|
unless $A->isa( __PACKAGE__ ) && $B->isa( __PACKAGE__ ); |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my %seen; |
151
|
|
|
|
|
|
|
for my $word ( @{ $A->methods } ) { |
152
|
|
|
|
|
|
|
$seen{$word} += 1; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
for my $word ( @{ $B->methods } ) { |
155
|
|
|
|
|
|
|
$seen{$word} += 2; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
my $values = join( '', CORE::values %seen ); |
159
|
|
|
|
|
|
|
if ( $values =~ /^3*$/ ) { |
160
|
|
|
|
|
|
|
return Type::Tiny::CMP_EQUIVALENT; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
elsif ( $values !~ /2/ ) { |
163
|
|
|
|
|
|
|
return Type::Tiny::CMP_SUBTYPE; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
elsif ( $values !~ /1/ ) { |
166
|
|
|
|
|
|
|
return Type::Tiny::CMP_SUPERTYPE; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
return Type::Tiny::CMP_UNKNOWN; |
170
|
|
|
|
|
|
|
}; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
1; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
__END__ |