view release on metacpan or  search on metacpan

lib/Z.pm  view on Meta::CPAN

use 5.008008;
use strict;
use warnings;

package Z;

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

use Import::Into ();
use IO::Handle   ();
use Module::Runtime qw( use_module );
use Zydeco::Lite qw( true false );

BEGIN {
	*PERL_IS_MODERN = ( $] ge '5.014' ) ? \&true : \&false;
}

my $STRICT = 0;
$ENV{$_} && ++$STRICT && last for qw(
	EXTENDED_TESTING
	AUTHOR_TESTING
	RELEASE_TESTING
	PERL_STRICT
);

sub import {
	my ( $target, $class ) = ( scalar caller, shift );
	
	my $mode = '-modern';
	( $_[0] || '' ) =~ /^-/ and $mode = shift;
	
	my $collection = 'modules';
	
	if ( PERL_IS_MODERN ) {
		$collection = 'compat_modules' if $mode eq '-compat';
	}
	else {
		$collection = 'compat_modules';
		
		if ( $mode eq '-modern' ) {
			require Carp;
			return Carp::croak( "$target requires Perl v5.14 or above; stopping" );
		}
		elsif ( $mode eq '-detect' ) {
			require Carp;
			Carp::carp(
				"$target may require Perl v5.14 or above; attempting compatibility mode" );
		}
	} #/ else [ if ( PERL_IS_MODERN ) ]
	
	for my $modules ( $class->$collection ) {
		my ( $name, $version, @args ) = @$modules;
		use_module( $name, $version )->import::into( $target, @args );
	}
	
	eval {
		require indirect;
		'indirect'->unimport::out_of( $target );
		1;
	}
		or !$STRICT
		or do {
		require Carp;
		Carp::carp( "Could not load indirect.pm" );
		};
		
	$class->also( $target, @_ );
	
	use_module( 'namespace::autoclean' )->import::into( $target );
	
	return $class;
} #/ sub import

sub modules {
	my $class = shift;
	
	return (
		[ 'Syntax::Keyword::Try',   '0.018',    qw( try                ) ],
		[ 'Zydeco::Lite',           '0.070',    qw( -all               ) ],
		[ 'Types::Standard',        '1.010000', qw( -types -is -assert ) ],
		[ 'Types::Common::Numeric', '1.010000', qw( -types -is -assert ) ],
		[ 'Types::Common::String',  '1.010000', qw( -types -is -assert ) ],
		[ 'Types::Path::Tiny',      '0',        qw( -types -is -assert ) ],
		[ 'Object::Adhoc',          '0.003',    qw( object             ) ],
		[ 'Path::Tiny',             '0.101',    qw( path               ) ],
		[ 'match::simple',          '0.010',    qw( match              ) ],
		[ 'strict',                 '0',        qw( refs subs vars     ) ],
		[ 'warnings',               '0',        qw( all                ) ],
		[ 'feature',                '0',        qw( say state          ) ],
	);
} #/ sub modules

sub compat_modules {
	my $class = shift;
	
	my @modules =
		grep { my $name = $_->[0]; $name !~ /feature|Try/ } $class->modules;
		
	push @modules, [ 'Try::Tiny', '0.30' ];
	
	if ( $] ge '5.010' ) {
		push @modules, [ 'feature', '0', qw( say ) ];
	}
	else {
		push @modules, [ 'Perl6::Say',      '0.06' ];
		push @modules, [ 'UNIVERSAL::DOES', '0.001' ];
	}
	
	return @modules;
} #/ sub compat_modules

my %also = (
	Dumper => sub {
		require Data::Dumper;
		return sub {
			local $Data::Dumper::Deparse;
			Data::Dumper::Dumper( @_ );
		};
	},
	croak => sub {
		return sub {
			require Carp;
			Carp::croak( @_ > 1 ? sprintf( shift, @_ ) : @_ );
		};
	},
	carp => sub {
		return sub {
			require Carp;
			Carp::carp( @_ > 1 ? sprintf( shift, @_ ) : @_ );
		};
	},
	cluck => sub {
		return sub {
			require Carp;
			Carp::cluck( @_ > 1 ? sprintf( shift, @_ ) : @_ );
		};
	},
	maybe => sub {
		if ( eval 'use PerlX::Maybe::XS 0.003 (); 1' ) {
			return \&PerlX::Maybe::XS::maybe;
		}
		return sub ($$@) {
			( defined $_[0] and defined $_[1] )
				? @_
				: ( ( @_ > 1 ) ? @_[ 2 .. $#_ ] : qw() );
		};
	},
	provided => sub {
		if ( eval 'use PerlX::Maybe::XS 0.003 (); 1' ) {
			return \&PerlX::Maybe::XS::provided;
		}
		return sub ($$$@) {
			( shift )
				? @_
				: ( ( @_ > 1 ) ? @_[ 2 .. $#_ ] : qw() );
		};
	},
	encode_json => sub {
		if ( eval 'use JSON::MaybeXS 1.003000 (); 1' ) {
			return \&JSON::MaybeXS::encode_json;
		}