view release on metacpan or  search on metacpan

lib/Missing/XS.pm  view on Meta::CPAN

use v5.012;
use strict;
use warnings;

package Missing::XS;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.001001';

use constant { true => !!1, false => !!0 };

use Module::Runtime qw( module_notional_filename require_module );

our $CPANM = false;
our @RECOMMENDATIONS;
sub import {
	my $class = shift;
	$CPANM = !! ( "@_" =~ /cpanm/i );
}

our @CHECKS = (
	sub { shift->basic_check_or_warning( 'Class::C3' ) },
	sub { shift->basic_check_or_warning( 'Class::Load' ) },
	sub { shift->basic_check_or_warning( 'Date::Calc' ) },
	sub { shift->basic_check_or_warning( 'Directory::Iterator' ) },
	sub { shift->basic_check_or_warning( 'Heap::Simple' ) },
	sub { shift->basic_check_or_warning( 'JSON' ) },
	sub { shift->basic_check_or_warning( 'JSON::MaybeXS', 'Cpanel::JSON::XS' ) },
	sub { shift->basic_check_or_warning( 'List::MoreUtils' ) },
	sub { shift->basic_check_or_warning( 'List::SomeUtils' ) },
	sub { shift->basic_check_or_warning( 'match::simple' ) },
	sub { shift->basic_check_or_warning( 'Moo', 'Class::XSAccessor' ) },
	sub {
		my $class = shift;
		return true if !$INC{'Mouse/Util.pm'};
		Mouse::Util::MOUSE_XS()
			or warn "Mouse is installed without its XS backend.\n";
	},
	sub { shift->basic_check_or_warning( 'Object::Accessor' ) },
	sub { shift->basic_check_or_warning( 'Object::Adhoc', 'Class::XSAccessor' ) },
	sub { shift->basic_check_or_warning( 'Package::Stash' ) },
	sub { shift->basic_check_or_warning( 'Params::Validate' ) },
	sub { shift->basic_check_or_warning( 'PerlX::ArraySkip' ) },
	sub { shift->basic_check_or_warning( 'PerlX::Maybe' ) },
	sub { shift->basic_check_or_warning( 'PPI' ) },
	sub { shift->basic_check_or_warning( 'Readonly' ) },
	sub { shift->basic_check_or_warning( 'Ref::Util' ) },
	sub { shift->basic_check_or_warning( 'Set::Product' ) },
	sub { shift->basic_check_or_warning( 'String::Numeric' ) },
	sub { shift->basic_check_or_warning( 'Text::CSV', 'Text::CSV_XS' ) },
	sub { shift->basic_check_or_warning( 'Time::Format', 'Time::Format_XS' ) },
	sub { shift->basic_check_or_warning( 'Type::Params', 'Class::XSAccessor' ) },
	sub { shift->basic_check_or_warning( 'Type::Tiny' ) },
	sub { shift->basic_check_or_warning( 'URL::Encode' ) },
);

sub all_checks {
	my $class = shift;
	for my $check ( @CHECKS ) {
		$class->$check;
	}
	if ( $CPANM and @RECOMMENDATIONS ) {
		warn "\n";
		warn "You may wish to run:\n";
		warn qq|cpanm @{[ map qq{"$_"}, @RECOMMENDATIONS ]}\n|;
	}
}

sub basic_check_or_warning {
	my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
	$xs_backend //= "$frontend\::XS";
	$class->basic_check( $frontend, $xs_backend )
		or $class->basic_warning( $frontend, $xs_backend );
}

sub basic_check {
	my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
	
	# If this module is not being used at all, everything is okay.
	my $frontend_filename = module_notional_filename( $frontend );
	return true if !$INC{$frontend_filename};
	
	return !!eval { require_module($xs_backend) };
}

sub basic_warning {
	my ( $class, $frontend, $xs_backend ) = ( shift, @_ );
	warn sprintf( "%s loaded but %s is not available.\n", $frontend, $xs_backend );
	push @RECOMMENDATIONS, $xs_backend;
}

END {
	__PACKAGE__->all_checks unless $ENV{PERL_MISSING_XS_NO_END};
};

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Missing::XS - print warnings about XS modules you should probably install