File Coverage

blib/lib/Mite/Package.pm.mite.pm
Criterion Covered Total %
statement 81 172 47.0
branch 20 114 17.5
condition 8 57 14.0
subroutine 14 25 56.0
pod 0 6 0.0
total 123 374 32.8


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