File Coverage

blib/lib/Type/Library/Compiler.pm.mite.pm
Criterion Covered Total %
statement 31 138 22.4
branch 0 88 0.0
condition 0 51 0.0
subroutine 7 15 46.6
pod 3 6 50.0
total 41 298 13.7


line stmt bran cond sub pod time code
1             {
2              
3             package Type::Library::Compiler;
4 1     1   6 use strict;
  1         1  
  1         24  
5 1     1   4 use warnings;
  1         2  
  1         161  
6              
7             our $USES_MITE = "Mite::Class";
8             our $MITE_SHIM = "Type::Library::Compiler::Mite";
9             our $MITE_VERSION = "0.006012";
10              
11             BEGIN {
12 1     1   6 require Scalar::Util;
13 1         3 *bare = \&Type::Library::Compiler::Mite::bare;
14 1         2 *blessed = \&Scalar::Util::blessed;
15 1         2 *carp = \&Type::Library::Compiler::Mite::carp;
16 1         2 *confess = \&Type::Library::Compiler::Mite::confess;
17 1         1 *croak = \&Type::Library::Compiler::Mite::croak;
18 1         2 *false = \&Type::Library::Compiler::Mite::false;
19 1         1 *guard = \&Type::Library::Compiler::Mite::guard;
20 1         2 *lazy = \&Type::Library::Compiler::Mite::lazy;
21 1         1 *ro = \&Type::Library::Compiler::Mite::ro;
22 1         1 *rw = \&Type::Library::Compiler::Mite::rw;
23 1         2 *rwp = \&Type::Library::Compiler::Mite::rwp;
24 1         156 *true = \&Type::Library::Compiler::Mite::true;
25             }
26              
27             sub new {
28 0 0   0 1   my $class = ref( $_[0] ) ? ref(shift) : shift;
29 0   0       my $meta = ( $Mite::META{$class} ||= $class->__META__ );
30 0           my $self = bless {}, $class;
31             my $args =
32             $meta->{HAS_BUILDARGS}
33             ? $class->BUILDARGS(@_)
34 0 0         : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 0          
35 0           my $no_build = delete $args->{__no_BUILD__};
36              
37             # Attribute: types
38 0           do {
39             my $value =
40             exists( $args->{"types"} )
41 0 0         ? $args->{"types"}
42             : $self->_build_types;
43 0 0         do {
44              
45             package Type::Library::Compiler::Mite;
46 0 0         ( ref($value) eq 'HASH' ) and do {
47 0           my $ok = 1;
48 0           for my $v ( values %{$value} ) {
  0            
49             ( $ok = 0, last )
50             unless (
51 0 0         do {
52              
53             package Type::Library::Compiler::Mite;
54 1     1   6 use Scalar::Util ();
  1         2  
  1         724  
55 0           Scalar::Util::blessed($v);
56             }
57             );
58             };
59 0           for my $k ( keys %{$value} ) {
  0            
60             ( $ok = 0, last )
61             unless (
62             (
63 0 0 0       do {
64              
65             package Type::Library::Compiler::Mite;
66 0 0         defined($k) and do {
67 0 0         ref( \$k ) eq 'SCALAR'
68             or ref( \( my $val = $k ) ) eq
69             'SCALAR';
70             }
71             }
72             )
73             && ( length($k) > 0 )
74             );
75             };
76 0           $ok;
77             }
78             }
79             or croak "Type check failed in constructor: %s should be %s",
80             "types", "Map[NonEmptyStr,Object]";
81 0           $self->{"types"} = $value;
82             };
83              
84             # Attribute: pod
85 0           do {
86 0 0         my $value = exists( $args->{"pod"} ) ? $args->{"pod"} : "1";
87 0           do {
88 0           my $coerced_value = do {
89 0           my $to_coerce = $value;
90             (
91             (
92             !ref $to_coerce
93             and (!defined $to_coerce
94             or $to_coerce eq q()
95             or $to_coerce eq '0'
96             or $to_coerce eq '1' )
97             )
98             ) ? $to_coerce
99             : ( ( !!1 ) )
100 0 0 0       ? scalar( do { local $_ = $to_coerce; !!$_ } )
  0            
  0            
101             : $to_coerce;
102             };
103             (
104 0 0 0       !ref $coerced_value
      0        
105             and (!defined $coerced_value
106             or $coerced_value eq q()
107             or $coerced_value eq '0'
108             or $coerced_value eq '1' )
109             )
110             or croak "Type check failed in constructor: %s should be %s",
111             "pod", "Bool";
112 0           $self->{"pod"} = $coerced_value;
113             };
114             };
115              
116             # Attribute: destination_module
117             croak "Missing key in constructor: destination_module"
118 0 0         unless exists $args->{"destination_module"};
119             (
120             (
121             do {
122              
123             package Type::Library::Compiler::Mite;
124 0 0         defined( $args->{"destination_module"} ) and do {
125             ref( \$args->{"destination_module"} ) eq 'SCALAR'
126 0 0         or ref( \( my $val = $args->{"destination_module"} ) )
127             eq 'SCALAR';
128             }
129             }
130             )
131 0 0 0       && do {
132              
133             package Type::Library::Compiler::Mite;
134 0           length( $args->{"destination_module"} ) > 0;
135             }
136             )
137             or croak "Type check failed in constructor: %s should be %s",
138             "destination_module", "NonEmptyStr";
139 0           $self->{"destination_module"} = $args->{"destination_module"};
140              
141             # Attribute: constraint_module
142 0           do {
143             my $value =
144             exists( $args->{"constraint_module"} )
145 0 0         ? $args->{"constraint_module"}
146             : $self->_build_constraint_module;
147             (
148             (
149 0 0 0       do {
150              
151             package Type::Library::Compiler::Mite;
152 0 0         defined($value) and do {
153 0 0         ref( \$value ) eq 'SCALAR'
154             or ref( \( my $val = $value ) ) eq 'SCALAR';
155             }
156             }
157             )
158             && ( length($value) > 0 )
159             )
160             or croak "Type check failed in constructor: %s should be %s",
161             "constraint_module", "NonEmptyStr";
162 0           $self->{"constraint_module"} = $value;
163             };
164              
165             # Attribute: destination_filename
166 0 0         if ( exists $args->{"destination_filename"} ) {
167             (
168             (
169             do {
170              
171             package Type::Library::Compiler::Mite;
172 0 0         defined( $args->{"destination_filename"} ) and do {
173             ref( \$args->{"destination_filename"} ) eq 'SCALAR'
174             or ref(
175 0 0         \( my $val = $args->{"destination_filename"} ) )
176             eq 'SCALAR';
177             }
178             }
179             )
180 0 0 0       && do {
181              
182             package Type::Library::Compiler::Mite;
183 0           length( $args->{"destination_filename"} ) > 0;
184             }
185             )
186             or croak "Type check failed in constructor: %s should be %s",
187             "destination_filename", "NonEmptyStr";
188 0           $self->{"destination_filename"} = $args->{"destination_filename"};
189             }
190              
191             # Enforce strict constructor
192             my @unknown = grep not(
193             /\A(?:constraint_module|destination_(?:filename|module)|pod|types)\z/
194 0           ), keys %{$args};
  0            
195             @unknown
196 0 0         and croak(
197             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
198              
199             # Call BUILD methods
200 0 0 0       $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  0 0          
201              
202 0           return $self;
203             }
204              
205             sub BUILDALL {
206 0     0 0   my $class = ref( $_[0] );
207 0   0       my $meta = ( $Mite::META{$class} ||= $class->__META__ );
208 0 0         $_->(@_) for @{ $meta->{BUILD} || [] };
  0            
209             }
210              
211             sub DESTROY {
212 0     0     my $self = shift;
213 0   0       my $class = ref($self) || $self;
214 0   0       my $meta = ( $Mite::META{$class} ||= $class->__META__ );
215 0 0         my $in_global_destruction =
216             defined ${^GLOBAL_PHASE}
217             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
218             : Devel::GlobalDestruction::in_global_destruction();
219 0 0         for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  0            
220 0           my $e = do {
221 0           local ( $?, $@ );
222 0           eval { $demolisher->( $self, $in_global_destruction ) };
  0            
223 0           $@;
224             };
225 1     1   6 no warnings 'misc'; # avoid (in cleanup) warnings
  1         2  
  1         116  
226 0 0         die $e if $e; # rethrow
227             }
228 0           return;
229             }
230              
231             sub __META__ {
232 1     1   6 no strict 'refs';
  1         2  
  1         36  
233 1     1   6 no warnings 'once';
  1         2  
  1         781  
234 0     0     my $class = shift;
235 0   0       $class = ref($class) || $class;
236 0           my $linear_isa = mro::get_linear_isa($class);
237             return {
238             BUILD => [
239 0 0         map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0            
  0            
240 0           map { "$_\::BUILD" } reverse @$linear_isa
241             ],
242             DEMOLISH => [
243 0 0         map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  0            
  0            
244 0           map { "$_\::DEMOLISH" } @$linear_isa
  0            
245             ],
246             HAS_BUILDARGS => $class->can('BUILDARGS'),
247             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
248             };
249             }
250              
251             sub DOES {
252 0     0 0   my ( $self, $role ) = @_;
253 0           our %DOES;
254 0 0         return $DOES{$role} if exists $DOES{$role};
255 0 0         return 1 if $role eq __PACKAGE__;
256 0           return $self->SUPER::DOES($role);
257             }
258              
259             sub does {
260 0     0 0   shift->DOES(@_);
261             }
262              
263             my $__XS = !$ENV{MITE_PURE_PERL}
264             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
265              
266             # Accessors for constraint_module
267             if ($__XS) {
268             Class::XSAccessor->import(
269             chained => 1,
270             "getters" => { "constraint_module" => "constraint_module" },
271             );
272             }
273             else {
274             *constraint_module = sub {
275             @_ > 1
276             ? croak(
277             "constraint_module is a read-only attribute of @{[ref $_[0]]}")
278             : $_[0]{"constraint_module"};
279             };
280             }
281              
282             # Accessors for destination_filename
283             sub destination_filename {
284             @_ > 1
285             ? croak(
286 0           "destination_filename is a read-only attribute of @{[ref $_[0]]}")
287             : (
288             exists( $_[0]{"destination_filename"} )
289             ? $_[0]{"destination_filename"}
290             : (
291 0 0   0 1   $_[0]{"destination_filename"} = do {
    0          
292 0           my $default_value = $_[0]->_build_destination_filename;
293             (
294             (
295 0 0 0       do {
296              
297             package Type::Library::Compiler::Mite;
298 0 0         defined($default_value) and do {
299 0 0         ref( \$default_value ) eq 'SCALAR'
300             or ref( \( my $val = $default_value ) )
301             eq 'SCALAR';
302             }
303             }
304             )
305             && ( length($default_value) > 0 )
306             )
307             or croak(
308             "Type check failed in default: %s should be %s",
309             "destination_filename",
310             "NonEmptyStr"
311             );
312 0           $default_value;
313             }
314             )
315             );
316             }
317              
318             # Accessors for destination_module
319             if ($__XS) {
320             Class::XSAccessor->import(
321             chained => 1,
322             "getters" => { "destination_module" => "destination_module" },
323             );
324             }
325             else {
326             *destination_module = sub {
327             @_ > 1
328             ? croak(
329             "destination_module is a read-only attribute of @{[ref $_[0]]}")
330             : $_[0]{"destination_module"};
331             };
332             }
333              
334             # Accessors for pod
335             sub pod {
336             @_ > 1
337             ? do {
338 0           my $value = do {
339 0           my $to_coerce = $_[1];
340             (
341             (
342             !ref $to_coerce
343             and (!defined $to_coerce
344             or $to_coerce eq q()
345             or $to_coerce eq '0'
346             or $to_coerce eq '1' )
347             )
348             ) ? $to_coerce
349 0 0 0       : ( ( !!1 ) ) ? scalar( do { local $_ = $to_coerce; !!$_ } )
  0            
  0            
350             : $to_coerce;
351             };
352             (
353 0 0 0       !ref $value
      0        
354             and (!defined $value
355             or $value eq q()
356             or $value eq '0'
357             or $value eq '1' )
358             )
359             or croak( "Type check failed in %s: value should be %s",
360             "accessor", "Bool" );
361 0           $_[0]{"pod"} = $value;
362 0           $_[0];
363             }
364 0 0   0 1   : ( $_[0]{"pod"} );
365             }
366              
367             # Accessors for types
368             if ($__XS) {
369             Class::XSAccessor->import(
370             chained => 1,
371             "getters" => { "types" => "types" },
372             );
373             }
374             else {
375             *types = sub {
376             @_ > 1
377             ? croak("types is a read-only attribute of @{[ref $_[0]]}")
378             : $_[0]{"types"};
379             };
380             }
381              
382             1;
383             }