File Coverage

blib/lib/Z.pm

Criterion	Covered	Total	%
statement	57	82	69.5
branch	5	18	27.7
condition	2	10	20.0
subroutine	14	14	100.0
pod	0	3	0.0
total	78	127	61.4

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;
		}
		require JSON::PP;
		return \&JSON::PP::encode_json;
	},
	decode_json => sub {
		if ( eval 'use JSON::MaybeXS 1.003000 (); 1' ) {
			return \&JSON::MaybeXS::decode_json;
		}
		require JSON::PP;
		return \&JSON::PP::decode_json;
	},
	STRICT => sub {
		$STRICT ? sub () { !!1 } : sub () { !!0 };
	},
	LAX => sub {
		$STRICT ? sub () { !!0 } : sub () { !!1 };
	},
	all                        => q(List::Util),
	any                        => q(List::Util),
	first                      => q(List::Util),
	head                       => q(List::Util),
	max                        => q(List::Util),
	maxstr                     => q(List::Util),
	min                        => q(List::Util),
	minstr                     => q(List::Util),
	none                       => q(List::Util),
	notall                     => q(List::Util),
	pairfirst                  => q(List::Util),
	pairgrep                   => q(List::Util),
	pairkeys                   => q(List::Util),
	pairmap                    => q(List::Util),
	pairs                      => q(List::Util),
	pairvalues                 => q(List::Util),
	product                    => q(List::Util),
	reduce                     => q(List::Util),
	reductions                 => q(List::Util),
	sample                     => q(List::Util),
	shuffle                    => q(List::Util),
	sum                        => q(List::Util),
	sum0                       => q(List::Util),
	tail                       => q(List::Util),
	uniq                       => q(List::Util),
	uniqnum                    => q(List::Util),
	uniqstr                    => q(List::Util),
	unpairs                    => q(List::Util),
	blessed                    => q(Scalar::Util),
	dualvar                    => q(Scalar::Util),
	isdual                     => q(Scalar::Util),
	isvstring                  => q(Scalar::Util),
	isweak                     => q(Scalar::Util),
	looks_like_number          => q(Scalar::Util),
	openhandle                 => q(Scalar::Util),
	readonly                   => q(Scalar::Util),
	refaddr                    => q(Scalar::Util),
	reftype                    => q(Scalar::Util),
	set_prototype              => q(Scalar::Util),
	tainted                    => q(Scalar::Util),
	unweaken                   => q(Scalar::Util),
	weaken                     => q(Scalar::Util),
	prototype                  => q(Sub::Util),
	set_prototype              => q(Sub::Util),
	set_subname                => q(Sub::Util),
	subname                    => q(Sub::Util),
	check_module_name          => q(Module::Runtime),
	check_module_spec          => q(Module::Runtime),
	compose_module_name        => q(Module::Runtime),
	is_module_name             => q(Module::Runtime),
	is_module_spec             => q(Module::Runtime),
	is_valid_module_name       => q(Module::Runtime),
	is_valid_module_spec       => q(Module::Runtime),
	module_notional_filename   => q(Module::Runtime),
	require_module             => q(Module::Runtime),
	use_module                 => q(Module::Runtime),
	use_package_optimistically => q(Module::Runtime),
);

sub also {
	my ( $class, $target ) = ( shift, shift );

	my %imports;
	for my $arg ( @_ ) {
		my ( $func, $dest ) = split /:/, $arg;
		$dest = $func unless $dest;

		my $source = $also{$func} or do {
			require Carp;
			Carp::croak( "Do not know where to find function $func" );
			next;
		};

		push @{ $imports{ ref( $source ) or $source } ||= [] },
			ref( $source ) ? [ $dest, $source ] : [ $dest, $func ];
	} #/ for my $arg ( @_ )

	for my $source ( sort keys %imports ) {
		if ( $source eq 'CODE' ) {
			for my $func ( @{ $imports{$source} } ) {
				my ( $name, $gen ) = @$func;
				no strict 'refs';
				*{"$target\::$name"} = $gen->();
			}
		}
		else {
			use_module( $source );
			for my $func ( @{ $imports{$source} } ) {
				my ( $name, $orig ) = @$func;
				no strict 'refs';
				*{"$target\::$name"} = \&{"$source\::$orig"};
			}
		}
	} #/ for my $source ( sort keys...)
} #/ sub also

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Z - collection of modules for rapid app development

=head1 SYNOPSIS

This:

 use Z;

Is a shortcut for:

 use strict;
 use warnings;
 use feature 'say', 'state';
 use namespace::autoclean;
 use Syntax::Keyword::Try 'try';
 use Zydeco::Lite -all;
 use Path::Tiny 'path';
 use Object::Adhoc 'object';
 use match::simple 'match';
 use Types::Standard -types, -is, -assert;
 use Types::Common::String -types, -is, -assert;
 use Types::Common::Numeric -types, -is, -assert;
 use Types::Path::Tiny -types, -is, -assert;

It will also do C<< no indirect >> if L<indirect> is installed.

=head1 DESCRIPTION

Just a shortcut for loading a bunch of modules that allow you to
quickly code Perl stuff. I've tried to avoid too many domain-specific
modules like HTTP::Tiny, etc. The modules chosen should be broadly
useful for a wide variety of tasks.

=head2 Perl Version Compatibility

By default, Z requires Perl v5.14, but it has a compatibility mode where
for Perl v5.8.8 and above.

It will use L<Try::Tiny> instead of L<Syntax::Keyword::Try>. (Bear in mind
that these are not 100% compatible with each other.) It will also load
L<Perl6::Say> as a fallback for the C<say> built-in. And it will not provide
C<state>. It will also load L<UNIVERSAL::DOES> if there's no built-in
UNIVERSAL::DOES method.

You can specify whether you want the modern modules or the compatibility
modules:

 use Z -modern;
 # Uses modern modules.
 # Requres Perl 5.14+.

 use Z -compat;
 # Uses compatible modules.
 # Requires Perl 5.8.8+.

 use Z -detect;
 # Uses modern modules on Perl 5.14+.
 # Prints a warning and uses compatible modules on Perl 5.8.8+.

The default is C<< -modern >>.

=head2 Additional Functions

There are a whole bunch of other useful functions that Z I<could> make
available, but it's hard to know the best place to draw the line. So
other functions are available on request:

 use Z qw( weaken unweaken isweak );

 use Z -compat, qw( pairmap pairgrep );

 # Rename functions...
 use Z qw( pairmap:pmap pairgrep:pgrep );

(The things listed in the L</SYNOPSIS> are always imported and don't
support the renaming feature.)

The additional functions available are: everything from L<Scalar::Util>,
everything from L<List::Util>, everything from L<Sub::Util>, everything
from L<Carp> (wrapped versions with C<sprintf> functionality, except
C<confess> which is part of the standard set of functions already),
all the functions (but not the exported regexps) from L<Module::Runtime>,
C<Dumper> from L<Data::Dumper>, C<maybe> and C<provided> from
L<PerlX::Maybe>, C<encode_json> and C<decode_json> from
L<JSON::MaybeXS> or L<JSON::PP> (depending which is installed), and
C<STRICT> and C<LAX> from L<Devel::StrictMode>.

If you specify a compatibility mode (like C<< -modern >>), this must be
first in the import list.

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Z>.

=head1 SEE ALSO

L<Zydeco::Lite>,
L<Types::Standard>,
L<Syntax::Feature::Try>,
L<Path::Tiny>,
L<match::simple>,
L<Object::Adhoc>.

=head1 AUTHOR

Toby Inkster E<lt>[e-mail]<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2020 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.