File Coverage

blib/lib/Moops/Keyword/Class.pm
Criterion Covered Total %
statement 38 38 100.0
branch 9 12 75.0
condition 4 6 66.6
subroutine 10 10 100.0
pod 0 2 0.0
total 61 68 89.7


line stmt bran cond sub pod time code
1 33     33   448 use v5.14;
  33         118  
2 33     33   180 use strict;
  33         67  
  33         1016  
3 33     33   178 use warnings FATAL => 'all';
  33         66  
  33         1702  
4 33     33   224 no warnings qw(void once uninitialized numeric);
  33         97  
  33         2782  
5              
6             package Moops::Keyword::Class;
7              
8             our $AUTHORITY = 'cpan:TOBYINK';
9             our $VERSION = '0.037';
10              
11 30     30   237 use Moo;
  30     3   126  
  30         232  
  3         18  
  3         5  
  3         17  
12 30     30   33063 use B 'perlstring';
  30     3   68  
  30         20081  
  3         1101  
  3         8  
  3         2031  
13             extends qw( Moops::Keyword::Role );
14              
15             my %using = (
16             Moo => 'use Moo; use MooX::late;',
17             Moose => 'use Moose; use MooseX::KavorkaInfo;',
18             Mouse => 'use Mouse;',
19             Tiny => 'use Class::Tiny; use Class::Tiny::Antlers;',
20             );
21              
22             sub generate_package_setup_oo
23             {
24 64     64 0 215 my $self = shift;
25 64   66     775 my $using = $self->relations->{using}[0] // $self->default_oo_implementation;
26            
27 64 50       308 exists($using{$using})
28             or Carp::croak("Cannot create a package using $using; stopped");
29            
30 64         205 my @lines = (
31             'use namespace::autoclean -also => "has";',
32             'use Lexical::Accessor;',
33             );
34 64 50       383 push @lines, "use MooseX::MungeHas qw(@{[ $self->arguments_for_moosex_mungehas ]});"
  64         509  
35             if $using =~ /^Mo/;
36              
37 64 100       255 if ($using eq 'Moose')
38             {
39 15         730 state $has_xs = !!eval('require MooseX::XSAccessor');
40 15 50       95 push @lines, 'use MooseX::XSAccessor;' if $has_xs;
41             }
42              
43             my @return = (
44 64         1608 $using{$using},
45             $self->generate_package_setup_relationships,
46             @lines,
47             );
48            
49             # Note that generate_package_setup_relationships typically adds
50             # `with` statements for composing roles, so we need to add this
51             # make_immutable *after* calling it.
52 64 100       251 $self->_mk_guard('__PACKAGE__->meta->make_immutable;')
53             if $self->should_make_immutable;
54            
55 64         498 return @return;
56             }
57              
58             sub should_make_immutable
59             {
60 63     63 0 143 my $self = shift;
61 63   66     387 my $using = $self->relations->{using}[0] // $self->default_oo_implementation;
62 63 100       514 ($using eq 'Moose' or $using eq 'Mouse');
63             }
64              
65             around generate_package_setup_relationships => sub
66             {
67             my $orig = shift;
68             my $self = shift;
69            
70             my @classes = @{ $self->relations->{extends} || [] };
71             return (
72             @classes ? sprintf("extends(%s);", join ",", map perlstring($_), @classes) : (),
73             $self->$orig(@_),
74             );
75             };
76              
77             around known_relationships => sub
78             {
79             my $next = shift;
80             my $self = shift;
81             return($self->$next(@_), qw/ extends /);
82             };
83              
84             1;