File Coverage

blib/lib/Jojo/Base/Compat.pm
Criterion Covered Total %
statement 41 85 48.2
branch 0 18 0.0
condition 0 9 0.0
subroutine 14 18 77.7
pod 1 2 50.0
total 56 132 42.4


line stmt bran cond sub pod time code
1              
2             package Jojo::Base::Compat;
3              
4             our $VERSION = '0.7.0';
5              
6 1     1   1129 use 5.018;
  1         3  
7 1     1   5 use strict;
  1         2  
  1         20  
8 1     1   5 use warnings;
  1         1  
  1         24  
9 1     1   5 use utf8;
  1         2  
  1         5  
10 1     1   32 use feature ();
  1         2  
  1         13  
11 1     1   5 use experimental ();
  1         2  
  1         51  
12              
13             BEGIN {
14 1     1   485 require Mojo::Base;
15 1         178641 our @ISA = qw(Mojo::Base);
16             }
17              
18 1     1   10 use Carp ();
  1         2  
  1         17  
19 1     1   4 use Mojo::Util ();
  1         3  
  1         47  
20             #use Sub::Inject 0.2.0 ();
21 1     1   7 use Importer::Zim ();
  1         2  
  1         47  
22              
23             use constant ROLES =>
24 1     1   6 !!(eval { require Jojo::Role; Jojo::Role->VERSION('0.5.0'); 1 });
  1         2  
  1         2  
  1         379  
  0         0  
  0         0  
25              
26 1     1   6 use constant SIGNATURES => ($] >= 5.020);
  1         2  
  1         227  
27              
28             our %EXPORT_TAGS;
29             our %EXPORT_GEN;
30              
31             sub import {
32 0     0     my $class = shift;
33 0 0         return unless my $flag = shift;
34 0           my $caller = caller;
35              
36             # Base
37 0           my $base;
38 0 0 0       if ($flag eq '-base') { $base = $class }
  0 0 0        
    0          
    0          
39              
40             # Strict
41             elsif ($flag eq '-strict') { }
42              
43             # Role
44             elsif ($flag eq '-role') {
45 0           Carp::croak 'Jojo::Role 0.5.0+ is required for roles' unless ROLES;
46 0           Jojo::Role->make_role($caller);
47             }
48              
49             # Module
50             elsif (($base = $flag) && ($flag = '-base') && !$base->can('new')) {
51 0           require(Mojo::Util::class_to_path($base));
52             }
53              
54             # Jojo modules are strict!
55 0           $_->import for qw(strict warnings utf8);
56 0           feature->import(':5.18');
57 0           experimental->import('lexical_subs');
58              
59             # Signatures (Perl 5.20+)
60 0 0 0       if ((shift || '') eq '-signatures') {
61 0           Carp::croak 'Subroutine signatures require Perl 5.20+' unless SIGNATURES;
62 0           experimental->import('signatures');
63             }
64              
65             # ISA
66 0 0         if ($base) {
67 1     1   7 no strict 'refs';
  1         2  
  1         383  
68 0           push @{"${caller}::ISA"}, $base;
  0            
69             }
70              
71 0   0       my @exports = @{$EXPORT_TAGS{$flag} // []};
  0            
72 0 0         if (@exports) {
73 0           my %exports = $class->_generate_subs($caller, @exports);
74 0           Importer::Zim::export_to($caller, %exports);
75             #goto &Sub::Inject::sub_inject;
76             }
77             }
78              
79 0     0 0   sub role_provider {'Jojo::Role'}
80              
81             sub with_roles {
82 0     0 1   Carp::croak 'Jojo::Role 0.5.0+ is required for roles' unless ROLES;
83 0           my ($self, @roles) = @_;
84              
85 0 0         return Jojo::Role->create_class_with_roles($self, @roles)
86             unless my $class = Scalar::Util::blessed $self;
87              
88 0           return Jojo::Role->apply_roles_to_object($self, @roles);
89             }
90              
91             BEGIN {
92 1     1   9 %EXPORT_TAGS = (-base => [qw(has with)], -role => [qw(has)], -strict => [],);
93              
94             %EXPORT_GEN = (
95             has => sub {
96 0         0 my (undef, $target) = @_;
97 0         0 return sub { Mojo::Base::attr($target, @_) }
98 0         0 },
99             with => sub { # dummy
100 0         0 return sub { Carp::croak 'Jojo::Role 0.5.0+ is required for roles' }
101 0         0 },
102 1         7 );
103              
104 1         83 return unless ROLES;
105              
106 0           push @{$EXPORT_TAGS{-role}}, @{$Jojo::Role::EXPORT_TAGS{-role}};
  0            
  0            
107              
108             $EXPORT_GEN{$_} = $Jojo::Role::EXPORT_GEN{$_}
109 0           for @{$Jojo::Role::EXPORT_TAGS{-role}};
  0            
110             }
111              
112             sub _generate_subs {
113 0     0     my ($class, $target) = (shift, shift);
114 0           return map { my $cb = $EXPORT_GEN{$_}; $_ => $class->$cb($target) } @_;
  0            
  0            
115             }
116              
117             1;
118              
119             __END__