File Coverage

blib/lib/Mite/Package.pm.mite.pm
Criterion Covered Total %
statement 79 168 47.0
branch 20 110 18.1
condition 8 48 16.6
subroutine 14 25 56.0
pod 0 6 0.0
total 121 357 33.8


line stmt bran cond sub pod time code
1             {
2              
3             use strict;
4 108     108   709 use warnings;
  108         267  
  108         3557  
5 108     108   716 no warnings qw( once void );
  108         581  
  108         3324  
6 108     108   466  
  108         226  
  108         12522  
7             our $USES_MITE = "Mite::Class";
8             our $MITE_SHIM = "Mite::Shim";
9             our $MITE_VERSION = "0.010007";
10              
11             # Mite keywords
12             BEGIN {
13             my ( $SHIM, $CALLER ) = ( "Mite::Shim", "Mite::Package" );
14 108     108   504 (
15             *after, *around, *before, *extends, *field,
16             *has, *param, *signature_for, *with
17             )
18             = do {
19 108         239  
20             no warnings 'redefine';
21             (
22 108     108   1461 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
  108         284  
  108         22097  
23             sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
24 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
25 0     0   0 sub { },
26 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
27       0     sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
28 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
29 648     648   94400 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
30 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
31 0     0   0 );
32 0     0   0 }
33 108         16607  
34             # Mite imports
35             BEGIN {
36             require Scalar::Util;
37             *STRICT = \&Mite::Shim::STRICT;
38             *bare = \&Mite::Shim::bare;
39 108     108   734 *blessed = \&Scalar::Util::blessed;
40 108         377 *carp = \&Mite::Shim::carp;
41 108         203 *confess = \&Mite::Shim::confess;
42 108         226 *croak = \&Mite::Shim::croak;
43 108         205 *false = \&Mite::Shim::false;
44 108         236 *guard = \&Mite::Shim::guard;
45 108         229 *lazy = \&Mite::Shim::lazy;
46 108         309 *ro = \&Mite::Shim::ro;
47 108         256 *rw = \&Mite::Shim::rw;
48 108         222 *rwp = \&Mite::Shim::rwp;
49 108         214 *true = \&Mite::Shim::true;
50 108         10481 }
51 108         210  
52 108         4022 # Gather metadata for constructor and destructor
53             no strict 'refs';
54             my $class = shift;
55             $class = ref($class) || $class;
56             my $linear_isa = mro::get_linear_isa($class);
57 108     108   652 return {
  108         242  
  108         181108  
58 100     100   244 BUILD => [
59 100   33     602 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
60 100         517 map { "$_\::BUILD" } reverse @$linear_isa
61             ],
62             DEMOLISH => [
63 202 100       302 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  202         1250  
  100         525  
64 202         598 map { "$_\::DEMOLISH" } @$linear_isa
65             ],
66             HAS_BUILDARGS => $class->can('BUILDARGS'),
67 202 50       320 HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
  202         2414  
  0         0  
68 100         356 };
  202         1557  
69             }
70              
71             # Standard Moose/Moo-style constructor
72             my $class = ref( $_[0] ) ? ref(shift) : shift;
73             my $meta = ( $Mite::META{$class} ||= $class->__META__ );
74             my $self = bless {}, $class;
75             my $args =
76             $meta->{HAS_BUILDARGS}
77 0 0   0 0 0 ? $class->BUILDARGS(@_)
78 0   0     0 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
79 0         0 my $no_build = delete $args->{__no_BUILD__};
80              
81             # Attribute name (type: ValidClassName)
82             # has declaration, file lib/Mite/Package.pm, line 11
83 0 0       0 croak "Missing key in constructor: name" unless exists $args->{"name"};
  0 0       0  
84 0         0 (
85             (
86             do {
87              
88 0 0       0 defined( $args->{"name"} ) and do {
89             ref( \$args->{"name"} ) eq 'SCALAR'
90             or ref( \( my $val = $args->{"name"} ) ) eq 'SCALAR';
91             }
92             )
93             && (
94 0 0       0 do {
95             local $_ = $args->{"name"};
96 0 0       0 /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/;
97             }
98             )
99             )
100             or croak "Type check failed in constructor: %s should be %s", "name",
101 0 0 0     0 "ValidClassName";
102 0         0 $self->{"name"} = $args->{"name"};
103 0         0  
104             # Attribute shim_name (type: ValidClassName)
105             # has declaration, file lib/Mite/Package.pm, line 23
106             if ( exists $args->{"shim_name"} ) {
107             (
108             (
109 0         0 do {
110              
111             defined( $args->{"shim_name"} ) and do {
112             ref( \$args->{"shim_name"} ) eq 'SCALAR'
113 0 0       0 or ref( \( my $val = $args->{"shim_name"} ) ) eq
114             'SCALAR';
115             }
116             )
117             && (
118             do {
119 0 0       0 local $_ = $args->{"shim_name"};
120             /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/;
121 0 0       0 }
122             )
123             )
124             or croak "Type check failed in constructor: %s should be %s",
125             "shim_name", "ValidClassName";
126             $self->{"shim_name"} = $args->{"shim_name"};
127 0 0 0     0 }
128 0         0  
129 0         0 # Attribute source (type: Mite::Source)
130             # has declaration, file lib/Mite/Package.pm, line 25
131             if ( exists $args->{"source"} ) {
132             blessed( $args->{"source"} )
133             && $args->{"source"}->isa("Mite::Source")
134             or croak "Type check failed in constructor: %s should be %s",
135 0         0 "source", "Mite::Source";
136             $self->{"source"} = $args->{"source"};
137             }
138             require Scalar::Util && Scalar::Util::weaken( $self->{"source"} )
139             if ref $self->{"source"};
140 0 0       0  
141             # Attribute imported_functions (type: Map[MethodName,Str])
142 0 0 0     0 # has declaration, file lib/Mite/Package.pm, line 34
143             do {
144             my $value =
145 0         0 exists( $args->{"imported_functions"} )
146             ? $args->{"imported_functions"}
147             : $self->_build_imported_functions;
148 0 0 0     0 do {
149              
150             ( ref($value) eq 'HASH' ) and do {
151             my $ok = 1;
152 0         0 for my $v ( values %{$value} ) {
153             ( $ok = 0, last ) unless do {
154              
155 0 0       0 defined($v) and do {
156             ref( \$v ) eq 'SCALAR'
157 0 0       0 or ref( \( my $val = $v ) ) eq 'SCALAR';
158             }
159             }
160 0 0       0 };
161 0         0 for my $k ( keys %{$value} ) {
162 0         0 ( $ok = 0, last )
  0         0  
163 0 0       0 unless (
164             (
165             do {
166 0 0       0  
167 0 0       0 defined($k) and do {
168             ref( \$k ) eq 'SCALAR'
169             or ref( \( my $val = $k ) ) eq
170             'SCALAR';
171             }
172 0         0 }
  0         0  
173             )
174             && ( do { local $_ = $k; /\A[^\W0-9]\w*\z/ } )
175             );
176             };
177             $ok;
178             }
179 0 0       0 or croak "Type check failed in constructor: %s should be %s",
180 0 0       0 "imported_functions", "Map[MethodName,Str]";
181             $self->{"imported_functions"} = $value;
182             };
183              
184             # Attribute imported_keywords (type: Map[MethodName,Str])
185             # has declaration, file lib/Mite/Package.pm, line 39
186 0 0 0     0 do {
  0         0  
  0         0  
187             my $value =
188             exists( $args->{"imported_keywords"} )
189 0         0 ? $args->{"imported_keywords"}
190             : $self->_build_imported_keywords;
191             do {
192              
193             ( ref($value) eq 'HASH' ) and do {
194 0         0 my $ok = 1;
195             for my $v ( values %{$value} ) {
196             ( $ok = 0, last ) unless do {
197              
198             defined($v) and do {
199 0         0 ref( \$v ) eq 'SCALAR'
200             or ref( \( my $val = $v ) ) eq 'SCALAR';
201             }
202 0 0       0 }
203             };
204 0 0       0 for my $k ( keys %{$value} ) {
205             ( $ok = 0, last )
206             unless (
207 0 0       0 (
208 0         0 do {
209 0         0  
  0         0  
210 0 0       0 defined($k) and do {
211             ref( \$k ) eq 'SCALAR'
212             or ref( \( my $val = $k ) ) eq
213 0 0       0 'SCALAR';
214 0 0       0 }
215             }
216             )
217             && ( do { local $_ = $k; /\A[^\W0-9]\w*\z/ } )
218             );
219 0         0 };
  0         0  
220             $ok;
221             }
222             or croak "Type check failed in constructor: %s should be %s",
223             "imported_keywords", "Map[MethodName,Str]";
224             $self->{"imported_keywords"} = $value;
225             };
226 0 0       0  
227 0 0       0 # Attribute arg
228             # has declaration, file lib/Mite/Package.pm, line 41
229             $self->{"arg"} = ( exists( $args->{"arg"} ) ? $args->{"arg"} : {} );
230              
231             # Call BUILD methods
232             $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
233 0 0 0     0  
  0         0  
  0         0  
234             # Unrecognized parameters
235             my @unknown = grep not(
236 0         0 /\A(?:arg|imported_(?:functions|keywords)|name|s(?:him_name|ource))\z/
237             ), keys %{$args};
238             @unknown
239             and croak(
240             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
241 0         0  
242             return $self;
243             }
244              
245             # Used by constructor to call BUILD methods
246 0 0       0 my $class = ref( $_[0] );
247             my $meta = ( $Mite::META{$class} ||= $class->__META__ );
248             $_->(@_) for @{ $meta->{BUILD} || [] };
249 0 0 0     0 }
  0 0       0  
250              
251             # Destructor should call DEMOLISH methods
252             my $self = shift;
253             my $class = ref($self) || $self;
254 0         0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
  0         0  
255             my $in_global_destruction =
256 0 0       0 defined ${^GLOBAL_PHASE}
257             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
258             : Devel::GlobalDestruction::in_global_destruction();
259 0         0 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
260             my $e = do {
261             local ( $?, $@ );
262             eval { $demolisher->( $self, $in_global_destruction ) };
263             $@;
264 162     162 0 499 };
265 162   33     659 no warnings 'misc'; # avoid (in cleanup) warnings
266 162 50       559 die $e if $e; # rethrow
  162         1368  
267             }
268             return;
269             }
270              
271 4     4   23 my $__XS = !$ENV{PERL_ONLY}
272 4   33     19 && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
273 4   33     19  
274 4 50       19 # Accessors for arg
275             # has declaration, file lib/Mite/Package.pm, line 41
276             if ($__XS) {
277             Class::XSAccessor->import(
278 4 50       7 chained => 1,
  4         19  
279 0         0 "accessors" => { "arg" => "arg" },
280 0         0 );
281 0         0 }
  0         0  
282 0         0 else {
283             *arg = sub {
284 108     108   944 @_ > 1 ? do { $_[0]{"arg"} = $_[1]; $_[0]; } : ( $_[0]{"arg"} );
  108         269  
  108         93956  
285 0 0       0 };
286             }
287 4         36  
288             # Accessors for imported_functions
289             # has declaration, file lib/Mite/Package.pm, line 34
290             if ($__XS) {
291             Class::XSAccessor->import(
292             chained => 1,
293             "getters" => { "imported_functions" => "imported_functions" },
294             );
295             }
296             else {
297             *imported_functions = sub {
298             @_ == 1
299             or croak(
300             'Reader "imported_functions" usage: $self->imported_functions()'
301             );
302             $_[0]{"imported_functions"};
303             };
304             }
305              
306             # Accessors for imported_keywords
307             # has declaration, file lib/Mite/Package.pm, line 39
308             if ($__XS) {
309             Class::XSAccessor->import(
310             chained => 1,
311             "getters" => { "imported_keywords" => "imported_keywords" },
312             );
313             }
314             else {
315             *imported_keywords = sub {
316             @_ == 1
317             or croak(
318             'Reader "imported_keywords" usage: $self->imported_keywords()');
319             $_[0]{"imported_keywords"};
320             };
321             }
322              
323             # Accessors for name
324             # has declaration, file lib/Mite/Package.pm, line 11
325             if ($__XS) {
326             Class::XSAccessor->import(
327             chained => 1,
328             "getters" => { "name" => "name" },
329             );
330             }
331             else {
332             *name = sub {
333             @_ == 1 or croak('Reader "name" usage: $self->name()');
334             $_[0]{"name"};
335             };
336             }
337              
338             # Accessors for shim_name
339             # has declaration, file lib/Mite/Package.pm, line 23
340             @_ > 1
341             ? do {
342             (
343             (
344             do {
345              
346             defined( $_[1] ) and do {
347             ref( \$_[1] ) eq 'SCALAR'
348             or ref( \( my $val = $_[1] ) ) eq 'SCALAR';
349             }
350             )
351             && (
352             do { local $_ = $_[1]; /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/ }
353             )
354             )
355             or croak(
356             "Type check failed in %s: value should be %s",
357             "accessor",
358             "ValidClassName"
359             );
360             $_[0]{"shim_name"} = $_[1];
361             $_[0];
362             }
363             : do {
364             (
365             exists( $_[0]{"shim_name"} ) ? $_[0]{"shim_name"} : (
366             $_[0]{"shim_name"} = do {
367 116 50       536 my $default_value = $_[0]->_build_shim_name;
368 116 50       1002 (
369             (
370             do {
371              
372             defined($default_value) and do {
373             ref( \$default_value ) eq 'SCALAR'
374 116 50 33     212 or
  116         270  
  116         919  
375             ref( \( my $val = $default_value ) )
376             eq 'SCALAR';
377             }
378             )
379             && (
380             do {
381             local $_ = $default_value;
382 116         392 /\A[^\W0-9]\w*(?:::[^\W0-9]\w*)*\z/;
383 116         278 }
384             )
385 1680 100   1680 0 3731 )
386             or croak(
387             "Type check failed in default: %s should be %s",
388 1564 100       8971 "shim_name",
389 15         54 "ValidClassName"
390             );
391             $default_value;
392             }
393             )
394             )
395 15 50       45 }
396 15 50       74 }
397              
398             # Accessors for source
399             # has declaration, file lib/Mite/Package.pm, line 25
400             @_ > 1
401             ? do {
402             blessed( $_[1] ) && $_[1]->isa("Mite::Source")
403             or croak( "Type check failed in %s: value should be %s",
404 15 50 33     414 "accessor", "Mite::Source" );
405 15         26 $_[0]{"source"} = $_[1];
406 15         122 require Scalar::Util && Scalar::Util::weaken( $_[0]{"source"} )
407             if ref $_[0]{"source"};
408             $_[0];
409             }
410             : ( $_[0]{"source"} );
411             }
412              
413             # See UNIVERSAL
414             my ( $self, $role ) = @_;
415 15         63 our %DOES;
416             return $DOES{$role} if exists $DOES{$role};
417             return 1 if $role eq __PACKAGE__;
418             return $self->SUPER::DOES($role);
419             }
420              
421             # Alias for Moose/Moo-compatibility
422             shift->DOES(@_);
423             }
424              
425             1;
426