File Coverage

blib/lib/Mite/App.pm.mite.pm
Criterion Covered Total %
statement 105 140 75.0
branch 28 72 38.8
condition 7 36 19.4
subroutine 20 30 66.6
pod 0 7 0.0
total 160 285 56.1


line stmt bran cond sub pod time code
1             {
2              
3             package Mite::App;
4 16     16   176 use strict;
  16         127  
  16         744  
5 16     16   149 use warnings;
  16         105  
  16         783  
6 16     16   163 no warnings qw( once void );
  16         109  
  16         3929  
7              
8             our $USES_MITE = "Mite::Class";
9             our $MITE_SHIM = "Mite::Shim";
10             our $MITE_VERSION = "0.011000";
11              
12             # Mite keywords
13             BEGIN {
14 16     16   167 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "Mite::App" );
15             (
16             *after, *around, *before, *extends, *field,
17             *has, *param, *signature_for, *with
18             )
19 16         78 = do {
20              
21             package Mite::Shim;
22 16     16   199 no warnings 'redefine';
  16         52  
  16         4102  
23             (
24 0     0   0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
25 0     0   0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
26 0     0   0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
27       0     sub { },
28 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, field => @_ ) },
29 48     48   43663 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
30 0     0   0 sub { $SHIM->HANDLE_has( $CALLER, param => @_ ) },
31 0     0   0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
32 0     0   0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
33 16         3554 );
34             };
35             }
36              
37             # Mite imports
38             BEGIN {
39 16     16   159 require Scalar::Util;
40 16         112 *STRICT = \&Mite::Shim::STRICT;
41 16         97 *bare = \&Mite::Shim::bare;
42 16         110 *blessed = \&Scalar::Util::blessed;
43 16         134 *carp = \&Mite::Shim::carp;
44 16         96 *confess = \&Mite::Shim::confess;
45 16         63 *croak = \&Mite::Shim::croak;
46 16         53 *false = \&Mite::Shim::false;
47 16         123 *guard = \&Mite::Shim::guard;
48 16         80 *lazy = \&Mite::Shim::lazy;
49 16         76 *lock = \&Mite::Shim::lock;
50 16         142 *ro = \&Mite::Shim::ro;
51 16         103 *rw = \&Mite::Shim::rw;
52 16         88 *rwp = \&Mite::Shim::rwp;
53 16         51 *true = \&Mite::Shim::true;
54 16         496 *unlock = \&Mite::Shim::unlock;
55             }
56              
57             # Gather metadata for constructor and destructor
58             sub __META__ {
59 16     16   194 no strict 'refs';
  16         107  
  16         6271  
60 16     16   66 my $class = shift;
61 16   33     143 $class = ref($class) || $class;
62 16         416 my $linear_isa = mro::get_linear_isa($class);
63             return {
64             BUILD => [
65 16 50       59 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  16         147  
  16         101  
66 16         101 map { "$_\::BUILD" } reverse @$linear_isa
67             ],
68             DEMOLISH => [
69 16 50       52 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  16         681  
  0         0  
70 16         101 map { "$_\::DEMOLISH" } @$linear_isa
  16         98  
71             ],
72             HAS_BUILDARGS => $class->can('BUILDARGS'),
73             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
74             };
75             }
76              
77             # Standard Moose/Moo-style constructor
78             sub new {
79 16 50   16 0 96 my $class = ref( $_[0] ) ? ref(shift) : shift;
80 16   33     257 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
81 16         61 my $self = bless {}, $class;
82             my $args =
83             $meta->{HAS_BUILDARGS}
84             ? $class->BUILDARGS(@_)
85 16 50       159 : { ( @_ == 1 ) ? %{ $_[0] } : @_ };
  0 50       0  
86 16         60 my $no_build = delete $args->{__no_BUILD__};
87              
88             # Attribute commands (type: HashRef[Object])
89             # has declaration, file lib/Mite/App.pm, line 22
90 16         46 do {
91             my $value =
92 16 50       96 exists( $args->{"commands"} ) ? $args->{"commands"} : {};
93 16 50       50 do {
94              
95             package Mite::Shim;
96 16 50       144 ( ref($value) eq 'HASH' ) and do {
97 16         50 my $ok = 1;
98 16         42 for my $i ( values %{$value} ) {
  16         82  
99             ( $ok = 0, last )
100             unless (
101 0 0       0 do {
102              
103             package Mite::Shim;
104 16     16   188 use Scalar::Util ();
  16         83  
  16         10299  
105 0         0 Scalar::Util::blessed($i);
106             }
107             );
108             };
109 16         109 $ok;
110             }
111             }
112             or croak "Type check failed in constructor: %s should be %s",
113             "commands", "HashRef[Object]";
114 16         133 $self->{"commands"} = $value;
115             };
116              
117             # Attribute kingpin (type: Object)
118             # has declaration, file lib/Mite/App.pm, line 28
119 16 50       87 if ( exists $args->{"kingpin"} ) {
120 0 0       0 blessed( $args->{"kingpin"} )
121             or croak "Type check failed in constructor: %s should be %s",
122             "kingpin", "Object";
123 0         0 $self->{"kingpin"} = $args->{"kingpin"};
124             }
125              
126             # Attribute project (type: Mite::Project)
127             # has declaration, file lib/Mite/App.pm, line 36
128 16 50       308 if ( exists $args->{"project"} ) {
129             blessed( $args->{"project"} )
130 0 0 0     0 && $args->{"project"}->isa("Mite::Project")
131             or croak "Type check failed in constructor: %s should be %s",
132             "project", "Mite::Project";
133 0         0 $self->{"project"} = $args->{"project"};
134             }
135              
136             # Call BUILD methods
137 16 50 33     129 $self->BUILDALL($args) if ( !$no_build and @{ $meta->{BUILD} || [] } );
  16 50       194  
138              
139             # Unrecognized parameters
140             my @unknown = grep not(/\A(?:commands|kingpin|project)\z/),
141 16         50 keys %{$args};
  16         78  
142             @unknown
143 16 50       73 and croak(
144             "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
145              
146 16         99 return $self;
147             }
148              
149             # Used by constructor to call BUILD methods
150             sub BUILDALL {
151 16     16 0 62 my $class = ref( $_[0] );
152 16   33     147 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
153 16 50       183 $_->(@_) for @{ $meta->{BUILD} || [] };
  16         179  
154             }
155              
156             # Destructor should call DEMOLISH methods
157             sub DESTROY {
158 16     16   17068 my $self = shift;
159 16   33     99 my $class = ref($self) || $self;
160 16   33     100 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
161 16 50       198 my $in_global_destruction =
162             defined ${^GLOBAL_PHASE}
163             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
164             : Devel::GlobalDestruction::in_global_destruction();
165 16 50       47 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  16         142  
166 0         0 my $e = do {
167 0         0 local ( $?, $@ );
168 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
169 0         0 $@;
170             };
171 16     16   162 no warnings 'misc'; # avoid (in cleanup) warnings
  16         74  
  16         31415  
172 0 0       0 die $e if $e; # rethrow
173             }
174 16         222 return;
175             }
176              
177             my $__XS = !$ENV{PERL_ONLY}
178             && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
179              
180             # Accessors for commands
181             # has declaration, file lib/Mite/App.pm, line 22
182             if ($__XS) {
183             Class::XSAccessor->import(
184             chained => 1,
185             "getters" => { "commands" => "commands" },
186             );
187             }
188             else {
189             *commands = sub {
190             @_ == 1 or croak('Reader "commands" usage: $self->commands()');
191             $_[0]{"commands"};
192             };
193             }
194              
195             # Accessors for kingpin
196             # has declaration, file lib/Mite/App.pm, line 28
197             sub _assert_blessed_kingpin {
198 16     16   72 my $object = do {
199             (
200             exists( $_[0]{"kingpin"} ) ? $_[0]{"kingpin"} : (
201 16 50       107 $_[0]{"kingpin"} = do {
202 0         0 my $default_value = $_[0]->_build_kingpin;
203 0 0       0 blessed($default_value)
204             or croak(
205             "Type check failed in default: %s should be %s",
206             "kingpin", "Object" );
207 0         0 $default_value;
208             }
209             )
210             )
211             };
212 16 50       96 blessed($object) or croak("kingpin is not a blessed object");
213 16         87 $object;
214             }
215              
216             sub kingpin {
217 130 50   130 0 357 @_ == 1 or croak('Reader "kingpin" usage: $self->kingpin()');
218             (
219             exists( $_[0]{"kingpin"} ) ? $_[0]{"kingpin"} : (
220 130 100       1848 $_[0]{"kingpin"} = do {
221 16         95 my $default_value = $_[0]->_build_kingpin;
222 16 50       183 blessed($default_value)
223             or croak( "Type check failed in default: %s should be %s",
224             "kingpin", "Object" );
225 16         146 $default_value;
226             }
227             )
228             );
229             }
230              
231             # Delegated methods for kingpin
232             # has declaration, file lib/Mite/App.pm, line 28
233 16     16   90 sub _parse_argv { shift->_assert_blessed_kingpin->parse(@_) }
234              
235             # Accessors for project
236             # has declaration, file lib/Mite/App.pm, line 36
237             sub _assert_blessed_project {
238 31     31   55 my $object = do {
239             (
240             exists( $_[0]{"project"} ) ? $_[0]{"project"} : (
241 31 50       175 $_[0]{"project"} = do {
242 0         0 my $default_value = $_[0]->_build_project;
243 0 0 0     0 blessed($default_value)
244             && $default_value->isa("Mite::Project")
245             or croak(
246             "Type check failed in default: %s should be %s",
247             "project", "Mite::Project" );
248 0         0 $default_value;
249             }
250             )
251             )
252             };
253 31 50       207 blessed($object) or croak("project is not a blessed object");
254 31         224 $object;
255             }
256              
257             sub project {
258 26 50   26 0 141 @_ == 1 or croak('Reader "project" usage: $self->project()');
259             (
260             exists( $_[0]{"project"} ) ? $_[0]{"project"} : (
261 26 100       303 $_[0]{"project"} = do {
262 14         78 my $default_value = $_[0]->_build_project;
263 14 50 33     260 blessed($default_value)
264             && $default_value->isa("Mite::Project")
265             or croak( "Type check failed in default: %s should be %s",
266             "project", "Mite::Project" );
267 14         202 $default_value;
268             }
269             )
270             );
271             }
272              
273             # Delegated methods for project
274             # has declaration, file lib/Mite/App.pm, line 36
275 31     31 0 134 sub config { shift->_assert_blessed_project->config(@_) }
276              
277             # See UNIVERSAL
278             sub DOES {
279 0     0 0   my ( $self, $role ) = @_;
280 0           our %DOES;
281 0 0         return $DOES{$role} if exists $DOES{$role};
282 0 0         return 1 if $role eq __PACKAGE__;
283 0 0 0       if ( $INC{'Moose/Util.pm'}
      0        
284             and my $meta = Moose::Util::find_meta( ref $self or $self ) )
285             {
286 0 0 0       $meta->can('does_role') and $meta->does_role($role) and return 1;
287             }
288 0           return $self->SUPER::DOES($role);
289             }
290              
291             # Alias for Moose/Moo-compatibility
292             sub does {
293 0     0 0   shift->DOES(@_);
294             }
295              
296             1;
297             }