File Coverage

blib/lib/Defaults/Modern.pm

Criterion	Covered	Total	%
statement	121	121	100.0
branch	14	16	87.5
condition	2	3	66.6
subroutine	25	25	100.0
pod			n/a
total	162	165	98.1

package Defaults::Modern;
$Defaults::Modern::VERSION = '0.009003';
use v5.14;

use strictures 2;
no indirect ':fatal';
no bareword::filehandles;

use Module::Runtime 'use_package_optimistically';
use Try::Tiny;
use Import::Into;


use Carp    ();
use feature ();
use true    ();

use match::simple ();

use Defaults::Modern::Define  ();
use Function::Parameters      ();
use List::Objects::WithUtils  ();
use Path::Tiny                ();
use PerlX::Maybe              ();
use Scalar::Util              ();
use Switch::Plain             ();

use Types::Standard           ();
use Types::Path::Tiny         ();
use Type::Registry            ();
use Type::Utils               ();
use List::Objects::Types      ();


sub import {
  my $class = shift;
  my $pkg = caller;

  state $known = +{
    map {; $_ => 1 } qw/
      all
      autobox_lists
      moo
    /
  };

  my %params;
  my $idx = 0;
  my $typelibs;
  PARAM: for my $item (@_) {
    my $current = $idx++;
    if ($item eq 'with_types' || $item eq '-with_types') {
      $typelibs = $_[$idx];
      splice @_, $current, 2;
      if (ref $typelibs) {
        Carp::croak "with_types should be an ARRAY, got $typelibs"
          if Scalar::Util::reftype($typelibs) ne 'ARRAY';
      } else {
        $typelibs = [ $typelibs ]
      }
      next PARAM
    }

    my $opt = lc($item =~ s/^(?:[-:])//r);
    Carp::croak "$class does not export $opt" unless $known->{$opt};

    if ($opt eq 'all') {
      $params{$_} = 1 for grep {; $_ ne 'all' } keys %$known;
      next PARAM
    }

    $params{$opt} = 1;
  }

  # Us
  Defaults::Modern::Define->import::into($pkg);

  # Core
  Carp->import::into($pkg,
    qw/carp croak confess/,
  );

  Scalar::Util->import::into($pkg,
    qw/blessed reftype weaken/,
  );

  # Pragmas
  strictures->import::into($pkg, version => 2);
  bareword::filehandles->unimport;
  indirect->unimport(':fatal');
  warnings->unimport('once');
  if ($] >= 5.018) {
    warnings->unimport('experimental');
  }

  feature->import(':5.14');
  feature->unimport('switch');

  match::simple->import::into($pkg);
  true->import;

  # External functionality

  state $fp_defaults = +{
    strict                => 1,
    default_arguments     => 1,
    named_parameters      => 1,
    types                 => 1,
    reify_type            => sub {
      state $guard = do { require Type::Utils };
      Type::Utils::dwim_type($_[0], for => $_[1])
    },
  };

  Function::Parameters->import::into( $pkg,
    +{
      fun => {
        name                  => 'optional',
        %$fp_defaults
      },
      method => {
        name                  => 'required',
        attributes            => ':method',
        shift                 => '$self',
        invocant              => 1,
        %$fp_defaults
      }
    }
  );

  Path::Tiny->import::into($pkg, 'path');

  PerlX::Maybe->import::into($pkg, qw/maybe provided/);

  Try::Tiny->import::into($pkg);
  Switch::Plain->import;

  $params{autobox_lists} ?
    List::Objects::WithUtils->import::into($pkg, 'all')
    : List::Objects::WithUtils->import::into($pkg);

  # Types
  state $mytypelibs = [ qw/
    Types::Standard
    Types::Path::Tiny
    List::Objects::Types
  / ];

  for my $typelib (@$mytypelibs, @$typelibs) {
    use_package_optimistically($typelib)->import::into($pkg, -all);
# Irrelevant with Type::Tiny-1.x ->
#    try {
#      Type::Registry->for_class($pkg)->add_types($typelib);
#    } catch {
      # Usually conflicts; whine but prefer user's previous imports:
#      Carp::carp($_)
#    };
  }

  if (defined $params{moo}) {
    require Moo;
    Moo->import::into($pkg);
  }

  $class
}

1;

=pod

=head1 NAME

Defaults::Modern - Yet another approach to modernistic Perl

=head1 SYNOPSIS

  use Defaults::Modern;

  # Function::Parameters + List::Objects::WithUtils + types ->
  fun to_immutable ( (ArrayRef | ArrayObj) $arr ) {
    # blessed() and confess() are available (amongst others):
    my $immutable = immarray( blessed $arr ? $arr->all : @$arr );
    confess 'No items in array!' unless $immutable->has_any;
    $immutable
  }

  package My::Foo {
    use Defaults::Modern;

    # define keyword for defining constants ->
    define ARRAY_MAX = 10;

    # Moo(se) with types ->
    use Moo;

    has myarray => (
      isa => ArrayObj,
      is  => 'ro',
      writer  => '_set_myarray',
      coerce  => 1,
      default => sub { [] },
    );

    # Method with optional positional param and implicit $self ->
    method slice_to_max (Int $max = -1) {
      my $arr = $self->myarray;
      $self->_set_myarray(
        $arr->sliced( 0 .. $max >= 0 ? $max : ARRAY_MAX )
      )
    }
  }

  # Optionally autobox list-type refs via List::Objects::WithUtils ->
  use Defaults::Modern 'autobox_lists';
  my $obj = +{ foo => 'bar', baz => 'quux' }->inflate;
  my $baz = $obj->baz;

  # See DESCRIPTION for complete details on imported functionality.

=head1 DESCRIPTION

Yet another approach to writing Perl in a modern style.

. . . also saves me extensive typing ;-)

When you C, you get:

=over

=item *

L (version 2), which enables L and makes most warnings
fatal; additionally L and L method calls are
disallowed explicitly (not just in development environments)

=item *

The C feature set (C, C, C, C) -- except for
C, which is deprecated in newer perls (and L is
provided anyway).

C warnings are also disabled on C.

=item *

B, B, and B error reporting tools from L

=item *

B, B, and B utilities from L

=item *

All of the L object constructors (B,
B, B, B, B, B, B,
B)

=item *

B and B keywords from L

=item *

The full L set and L -- useful in
combination with L (see the L and
L POD)

=item *

B and B from L

=item *

The B object constructor from L and related types/coercions
from L

=item *

B and B definedness-checking syntax sugar from L

=item *

A B keyword for defining constants based on L

=item *

The B<|M|> match operator from L

=item *

The B and B switch/case constructs from L

=item *

L.pm so you can skip adding '1;' to all of your modules

=back

If you want to automatically load (shown here with the '-all' import tag, as
well) and register other L compatible libraries (see
L), they can be specified at import time:

  use Defaults::Modern
    -all,
    -with_types => [ 'Types::Mine' ],

This feature is unnecessary with L version 1.x and higher, which
will automatically register L-based types in the caller's
L.

If you import the tag C, ARRAY and HASH type references are autoboxed
via L:

  use Defaults::Modern 'autobox_lists';
  my $itr = [ 1 .. 10 ]->natatime(2);

L version 2+ is depended upon in order to guarantee availability, but not
automatically imported:

  use Defaults::Modern;
  use Moo;

  has foo => (
    is  => 'ro',
    isa => ArrayObj,
    coerce  => 1,
    default => sub { [] },
  );

(If you're building classes, you may want to look into L /
L or similar -- L imports an awful lot of
Stuff. L may be nicer to work with.)

=head1 SEE ALSO

This package just glues together useful parts of CPAN, the
most visible portions of which come from the following modules:

L

L

L and L

L

L

L

L

L

L

L

L

=head1 AUTHOR

Jon Portnoy

Licensed under the same terms as Perl.

Inspired by L and L.

The code backing the B keyword is forked from TOBYINK's
L to avoid the L dependency and is copyright Toby
Inkster.

=cut

# vim: ts=2 sw=2 et sts=2 ft=perl