File Coverage

blib/lib/Missing/XS.pm
Criterion Covered Total %
statement 20 36 55.5
branch 3 8 37.5
condition 0 6 0.0
subroutine 7 11 63.6
pod 0 4 0.0
total 30 65 46.1


line stmt bran cond sub pod time code
1 2     2   468319 use v5.012;
  2         22  
2 2     2   11 use strict;
  2         5  
  2         38  
3 2     2   8 use warnings;
  2         13  
  2         136  
4              
5             package Missing::XS;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.001001';
9              
10 2     2   14 use constant { true => !!1, false => !!0 };
  2         4  
  2         147  
11              
12 2     2   998 use Module::Runtime qw( module_notional_filename require_module );
  2         3641  
  2         11  
13              
14             our $CPANM = false;
15             our @RECOMMENDATIONS;
16             sub import {
17 0     0   0 my $class = shift;
18 0         0 $CPANM = !! ( "@_" =~ /cpanm/i );
19             }
20              
21             our @CHECKS = (
22             sub { shift->basic_check_or_warning( 'Class::C3' ) },
23             sub { shift->basic_check_or_warning( 'Class::Load' ) },
24             sub { shift->basic_check_or_warning( 'Date::Calc' ) },
25             sub { shift->basic_check_or_warning( 'Directory::Iterator' ) },
26             sub { shift->basic_check_or_warning( 'Heap::Simple' ) },
27             sub { shift->basic_check_or_warning( 'JSON' ) },
28             sub { shift->basic_check_or_warning( 'JSON::MaybeXS', 'Cpanel::JSON::XS' ) },
29             sub { shift->basic_check_or_warning( 'List::MoreUtils' ) },
30             sub { shift->basic_check_or_warning( 'List::SomeUtils' ) },
31             sub { shift->basic_check_or_warning( 'match::simple' ) },
32             sub { shift->basic_check_or_warning( 'Moo', 'Class::XSAccessor' ) },
33             sub {
34             my $class = shift;
35             return true if !$INC{'Mouse/Util.pm'};
36             Mouse::Util::MOUSE_XS()
37             or warn "Mouse is installed without its XS backend.\n";
38             },
39             sub { shift->basic_check_or_warning( 'Object::Accessor' ) },
40             sub { shift->basic_check_or_warning( 'Object::Adhoc', 'Class::XSAccessor' ) },
41             sub { shift->basic_check_or_warning( 'Package::Stash' ) },
42             sub { shift->basic_check_or_warning( 'Params::Validate' ) },
43             sub { shift->basic_check_or_warning( 'PerlX::ArraySkip' ) },
44             sub { shift->basic_check_or_warning( 'PerlX::Maybe' ) },
45             sub { shift->basic_check_or_warning( 'PPI' ) },
46             sub { shift->basic_check_or_warning( 'Readonly' ) },
47             sub { shift->basic_check_or_warning( 'Ref::Util' ) },
48             sub { shift->basic_check_or_warning( 'Set::Product' ) },
49             sub { shift->basic_check_or_warning( 'String::Numeric' ) },
50             sub { shift->basic_check_or_warning( 'Text::CSV', 'Text::CSV_XS' ) },
51             sub { shift->basic_check_or_warning( 'Time::Format', 'Time::Format_XS' ) },
52             sub { shift->basic_check_or_warning( 'Type::Params', 'Class::XSAccessor' ) },
53             sub { shift->basic_check_or_warning( 'Type::Tiny' ) },
54             sub { shift->basic_check_or_warning( 'URL::Encode' ) },
55             );
56              
57             sub all_checks {
58 0     0 0 0 my $class = shift;
59 0         0 for my $check ( @CHECKS ) {
60 0         0 $class->$check;
61             }
62 0 0 0     0 if ( $CPANM and @RECOMMENDATIONS ) {
63 0         0 warn "\n";
64 0         0 warn "You may wish to run:\n";
65 0         0 warn qq|cpanm @{[ map qq{"$_"}, @RECOMMENDATIONS ]}\n|;
  0         0  
66             }
67             }
68              
69             sub basic_check_or_warning {
70 0     0 0 0 my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
71 0   0     0 $xs_backend //= "$frontend\::XS";
72 0 0       0 $class->basic_check( $frontend, $xs_backend )
73             or $class->basic_warning( $frontend, $xs_backend );
74             }
75              
76             sub basic_check {
77 2     2 0 53051 my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
78            
79             # If this module is not being used at all, everything is okay.
80 2         9 my $frontend_filename = module_notional_filename( $frontend );
81 2 100       93 return true if !$INC{$frontend_filename};
82            
83 1         2 return !!eval { require_module($xs_backend) };
  1         16  
84             }
85              
86             sub basic_warning {
87 0     0 0   my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
88 0           warn sprintf( "%s loaded but %s is not available.\n", $frontend, $xs_backend );
89 0           push @RECOMMENDATIONS, $xs_backend;
90             }
91              
92             END {
93 2 50   2   13171 __PACKAGE__->all_checks unless $ENV{PERL_MISSING_XS_NO_END};
94             };
95              
96             1;
97              
98             __END__