File Coverage

blib/lib/Mite/Project.pm
Criterion Covered Total %
statement 127 170 74.7
branch 28 56 50.0
condition 11 21 52.3
subroutine 29 30 96.6
pod 0 17 0.0
total 195 294 66.3


line stmt bran cond sub pod time code
1 107     107   5387906 use 5.010001;
  107         1785  
2 107     107   1707 use strict;
  107         967  
  107         7757  
3 107     107   1552 use warnings;
  107         1359  
  107         16163  
4              
5             use Mite::Miteception -all;
6 107     107   44370  
  107         497  
  107         2043  
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.011000';
9              
10             has sources =>
11             is => ro,
12             isa => HashRef[MiteSource],
13             default => sub { {} };
14              
15             has config =>
16             is => ro,
17             isa => MiteConfig,
18             lazy => 1,
19             default => sub {
20             require Mite::Config;
21             state $config = Mite::Config->new;
22             return $config;
23             };
24              
25             has _module_fakeout_namespace =>
26             is => rw,
27             isa => Str | Undef;
28              
29             has debug =>
30             is => rw,
31             isa => Bool,
32             default => false;
33              
34             use Mite::Source;
35 107     107   45693 use Mite::Class;
  107         398  
  107         4726  
36 107     107   762  
  107         238  
  107         301314  
37             my $self = shift;
38              
39 291     291 0 411 my %classes = map { %{$_->classes} }
40             values %{$self->sources};
41 460         561 return \%classes;
  460         1588  
42 291         394 }
  291         809  
43 291         1323  
44             # Careful not to create a class.
45             my ( $self, $name ) = ( shift, @_ );
46              
47             return $self->classes->{$name};
48 290     290 0 1765 }
49              
50 290         614 # Careful not to create a source.
51             my ( $self, $file ) = ( shift, @_ );
52              
53             return $self->sources->{$file};
54             }
55 2     2 0 1139  
56             my ( $self, @sources ) = ( shift, @_ );
57 2         12  
58             for my $source (@sources) {
59             $self->sources->{$source->file} = $source;
60             }
61 2     2 0 18 }
62              
63 2         8 my ( $self, $file ) = ( shift, @_ );
64 3         24  
65             # Normalize the path.
66             $file = Path::Tiny::path($file)->realpath;
67              
68             return $self->sources->{$file} ||= Mite::Source->new(
69 153     153 0 5621 file => $file,
70             project => $self
71             );
72 153         546 }
73              
74 153   66     35202 # This is the shim Mite.pm uses when compiling.
75             signature_for inject_mite_functions => (
76             named => [
77             package => Any,
78             file => Any,
79             kind => Optional[Str],
80             arg => HashRef, { default => {} },
81             shim => Str,
82             x_source => Optional[Object],
83             x_pkg => Optional[Object],
84             ],
85             named_to_list => true,
86             );
87              
88             my ( $self, $package, $file, $kind, $arg, $shim, $source, $pkg ) = @_;
89             $kind //= ( $arg->{'-role'} ? 'role' : 'class' );
90              
91             my $fake_ns = $self->can('_module_fakeout_namespace') && $self->_module_fakeout_namespace;
92             if ( defined( $fake_ns ) and not $package =~ /^\Q$fake_ns/ ) {
93             $package = "$fake_ns\::$package";
94             }
95              
96             warn "Gather: $package\n" if $self->debug;
97              
98             $source //= $self->source_for(
99             Path::Tiny::path( $Mite::REAL_FILENAME // $file )
100             );
101             $pkg //= $source->class_for(
102             $package,
103             $kind eq 'role' ? 'Mite::Role' : 'Mite::Class',
104             );
105             $pkg->shim_name( $shim );
106             $pkg->arg( $arg );
107             $pkg->inject_mite_functions( $file, $arg );
108             }
109              
110             my $self = shift;
111              
112             for my $source (values %{$self->sources}) {
113             warn "Write mite: ${\ $source->compiled->file }\n" if $self->debug;
114             $source->compiled->write(
115             module_fakeout_namespace => $self->_module_fakeout_namespace,
116             );
117             }
118 82     82 0 1538  
119             return;
120 82         207 }
  82         668  
121 87 50       5669  
  0         0  
122 87         688 my $self = shift;
123              
124             my ( $mop_package, $mop_dir );
125             eval {
126             my $config = $self->config;
127 82         95428 $mop_package = $config->data->{mop};
128             $mop_dir = $config->data->{source_from};
129              
130             $mop_package and $mop_dir;
131 89     89   281 } or return;
132              
133 89         264 my $mop_file = $mop_package;
134 89 50       260 $mop_file =~ s{::}{/}g;
135 89         471 $mop_file .= ".pm";
136 89         651 return Path::Tiny::path($mop_dir, $mop_file);
137 11         32 }
138              
139 11 50       74 my $self = shift;
140              
141             my $mop_file = $self->_project_mopper_file or return;
142 0         0  
143 0         0 my $dir = Path::Tiny::path( $self->config->data->{source_from} );
144 0         0  
145 0         0 my $code = $self->_compile_mop_header;
146             for my $source ( sort { $a->file cmp $b->file } values %{ $self->sources } ) {
147             my $relative_name = $source->file->relative($dir);
148             $code .= $source->_compile_mop( $relative_name );
149 2     2 0 7 }
150             for my $class ( sort { $a->name cmp $b->name } values %{ $self->classes } ) {
151 2 50       8 $code .= $class->_compile_mop_postamble;
152             }
153 0         0  
154             if ( my $yuck = $self->_module_fakeout_namespace ) {
155 0         0 $code =~ s/$yuck\:://g;
156 0         0 }
  0         0  
  0         0  
157 0         0  
158 0         0 $code .= "\ntrue;\n\n";
159              
160 0         0 warn "Write MOP: $mop_file\n" if $self->debug;
  0         0  
  0         0  
161 0         0 $mop_file->spew( $code );
162              
163             return;
164 0 0       0 }
165 0         0  
166             my $self = shift;
167             return sprintf <<'CODE', ( $self->config->data->{mop} ) x 3;
168 0         0 package %s;
169              
170 0 0       0 use Moose ();
171 0         0 use Moose::Util ();
172             use Moose::Util::MetaRole ();
173 0         0 use Moose::Util::TypeConstraints ();
174             use constant { true => !!1, false => !!0 };
175              
176             my $META_CLASS = do {
177 0     0   0 package %s::Meta::Class;
178 0         0 use Moose;
179             extends 'Moose::Meta::Class';
180             around _immutable_options => sub {
181             my ( $next, $self, @args ) = ( shift, shift, @_ );
182             return $self->$next( replace_constructor => 1, @args );
183             };
184             __PACKAGE__->meta->make_immutable;
185              
186             __PACKAGE__;
187             };
188              
189             my $META_ROLE = do {
190             package %s::Meta::Role;
191             use Moose;
192             extends 'Moose::Meta::Role';
193             my $built_ins = qr/\A( DOES | does | __META__ | __FINALIZE_APPLICATION__ |
194             CREATE_CLASS | APPLY_TO )\z/x;
195             around get_method => sub {
196             my ( $next, $self, $method_name ) = ( shift, shift, @_ );
197             return if $method_name =~ $built_ins;
198             return $self->$next( @_ );
199             };
200             around get_method_list => sub {
201             my ( $next, $self ) = ( shift, shift );
202             return grep !/$built_ins/, $self->$next( @_ );
203             };
204             around _get_local_methods => sub {
205             my ( $next, $self ) = ( shift, shift );
206             my %%map = %%{ $self->_full_method_map };
207             return map $map{$_}, $self->get_method_list;
208             };
209             __PACKAGE__->meta->make_immutable;
210              
211             __PACKAGE__;
212             };
213              
214             CODE
215             }
216              
217             signature_for load_files => (
218             pos => [ ArrayRef, 0 ],
219             );
220              
221             my ( $self, $files, $inc_dir ) = @_;
222              
223             local $Mite::COMPILING = eval { $self->config->data->{shim} }
224             // $ENV{TEST_MITE_SHIM}
225             // do { warn 'Attempting to compile, but no shim in config'; exit 1; };
226             local @INC = @INC;
227             unshift @INC, $inc_dir if defined $inc_dir;
228             for my $file (@$files) {
229             $self->_load_file( $file, $inc_dir );
230             }
231              
232             return;
233             }
234              
235             my ( $self, $file, $inc_dir ) = @_;
236              
237             if ( $self->{_already}{$file}++ ) {
238             warn "Skipping $file: already loaded\n" if $self->debug;
239             return;
240             }
241              
242             if ( defined $self->_project_mopper_file
243             and $file eq $self->_project_mopper_file ) {
244             warn "Skipping $file: it's the mop\n" if $self->debug;
245             return;
246             }
247              
248 87     87   315 warn "Load module: $file\n" if $self->debug;
249              
250 87 50       631 $file = Path::Tiny::path($file);
251 0 0       0  
252 0         0 if ( defined $self->_module_fakeout_namespace ) {
253             my $ns = $self->_module_fakeout_namespace;
254              
255 87 50 33     1528 my $code = $file->slurp;
256             $code =~ s/package /package $ns\::/;
257 0 0       0  
258 0         0 do {
259             local $@;
260             local $Mite::REAL_FILENAME = "$file";
261 87 50       3212 eval("$code; 1") or do die($@);
262             };
263 87         450  
264             return;
265 87 50       8207 }
266 0         0  
267             if ( my $pm_file = eval { $file->relative($inc_dir) } ) {
268 0         0 require $pm_file;
269 0         0 }
270             else {
271 0         0 local $@;
272 0         0 eval( $file->slurp ) or die $@;
273 0         0 }
274 0 0       0  
275             return;
276             }
277 0         0  
278             my ( $self, $dir ) = ( shift, @_ );
279             $dir //= $self->config->data->{source_from};
280 87 50       293  
  87         1476  
281 87         50515 return $self->_recurse_directory(
282             $dir,
283             sub {
284 0         0 my $path = shift;
285 0 0       0 return false if -d $path;
286             return false unless $path =~ m{\.pm$};
287             return false if $path =~ m{\.mite\.pm$};
288 87         983 return true;
289             }
290             );
291             }
292 6     6 0 3606860  
293 6   66     122 my ( $self, $dir ) = ( shift, @_ );
294             $dir //= $self->config->data->{source_from};
295              
296             $self->load_files( [$self->find_pms($dir)], $dir );
297              
298 31     31   63 return;
299 31 100       128 }
300 21 100       378  
301 17 100       190 my ( $self, $dir ) = ( shift, @_ );
302 15         112 $dir //= $self->config->data->{compiled_to};
303              
304 6         363 return $self->_recurse_directory(
305             $dir,
306             sub {
307             my $path = shift;
308 3     3 0 26 return false if -d $path;
309 3   33     32 return true if $path =~ m{\.mite\.pm$};
310             return false;
311 3         17 }
312             );
313 3         40 }
314              
315             my ( $self, $dir ) = ( shift, @_ );
316             $dir //= $self->config->data->{compiled_to};
317 7     7 0 6054  
318 7   66     142 for my $file ($self->find_mites($dir)) {
319             warn "Clean mite: $file\n" if $self->debug;
320             Path::Tiny::path($file)->remove;
321             }
322              
323 46     46   87 return;
324 46 100       139 }
325 33 100       532  
326 23         199 my $self = shift;
327             warn "Clean shim: ${\ $self->_project_shim_file }\n" if $self->debug;
328 7         270 return $self->_project_shim_file->remove;
329             }
330              
331             # Recursively gather all the pm files in a directory
332 2     2 0 960 signature_for _recurse_directory => (
333 2   33     34 pos => [ Path, CodeRef ],
334             );
335 2         12  
336 4 50       379 my ( $self, $dir, $check ) = @_;
337 4         23  
338             my @pm_files;
339              
340 2         165 my $iter = $dir->iterator({ recurse => 1, follow_symlinks => 1 });
341             while( my $path = $iter->() ) {
342             next unless $check->($path);
343             push @pm_files, $path;
344 1     1 0 5 }
345 1 50       4  
  0         0  
346 1         5 return @pm_files;
347             }
348              
349             my ( $self, $project_name ) = ( shift, @_ );
350              
351             warn "Init\n" if $self->debug;
352              
353             $self->config->make_mite_dir;
354              
355             $self->write_default_config(
356             $project_name
357             ) if !-e $self->config->config_file;
358              
359             return;
360             }
361              
362             my $self = shift;
363              
364             my $shim_file = $self->_project_shim_file;
365             $shim_file->parent->mkpath;
366              
367             warn "Write shim: $shim_file\n" if $self->debug;
368              
369 9     9 0 108 my $shim_package = $self->config->data->{shim};
370             return $shim_file if $shim_package eq 'Mite::Shim';
371 9 50       48  
372             my $src_shim = $self->_find_mite_shim;
373 9         73 my $code = $src_shim->slurp;
374             $code =~ s/package Mite::Shim;/package $shim_package;/;
375 9 50       4659 $code =~ s/^Mite::Shim\b/$shim_package/ms;
376             $shim_file->spew( $code );
377              
378             return $shim_file;
379 9         41 }
380              
381             my $self = shift;
382              
383 4     4 0 1476 my $config = $self->config;
384             my $shim_package = $config->data->{shim};
385 4         18 my $shim_dir = $config->data->{source_from};
386 4         299  
387             my $shim_file = $shim_package;
388 4 50       1185 $shim_file =~ s{::}{/}g;
389             $shim_file .= ".pm";
390 4         20 return Path::Tiny::path($shim_dir, $shim_file);
391 4 50       19 }
392              
393 4         20 my $self = shift;
394 4         103  
395 4         1124 for my $dir (@INC) {
396 4         41 # Avoid code refs in @INC
397 4         26 next if ref $dir;
398              
399 4         2958 my $shim = Path::Tiny::path($dir, "Mite", "Shim.pm");
400             return $shim if -e $shim;
401             }
402              
403 6     6   67 croak <<"ERROR";
404             Can't locate Mite::Shim in \@INC. \@INC contains:
405 6         33 @{[ map { " $_\n" } grep { !ref($_) } @INC ]}
406 6         28 ERROR
407 6         32 }
408              
409 6         19 my $self = shift;
410 6         68 my $project_name = Str->(shift);
411 6         22 my %args = @_;
412 6         34  
413             my $libdir = Path::Tiny::path('lib');
414             $self->config->write_config({
415             project => $project_name,
416 4     4   11 shim => $project_name.'::Mite',
417             source_from => $libdir.'',
418 4         14 compiled_to => $libdir.'',
419             %args
420 12 50       164 });
421             return;
422 12         38 }
423 12 100       517  
424             {
425             # Get/set the default for a class
426 0         0 my %Defaults;
427             my $class = shift;
428 0         0 return $Defaults{$class} ||= $class->new;
  0         0  
  0         0  
429             }
430              
431             my ( $class, $new_default ) = ( shift, @_ );
432             $Defaults{$class} = $new_default;
433 9     9 0 309 return;
434 9         45 }
435 9         506 }
436              
437 9         37 1;