8abde7f4a

Build Type

push

github-actions

Committed by Toby Inkster

Commit Message

Added tag 0.001004 for changeset bf962ffadfff

Run Details

179 of 180 relevant lines covered (99.44%)

5.67 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

99.44

/lib/Exporter/Almighty.pm

use 5.012;
use strict;
use warnings;

package Exporter::Almighty;

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

use parent qw( Exporter::Tiny );

my @builtins;
BEGIN { @builtins = qw( is_bool created_as_string created_as_number ) };
use if $] lt '5.036000', 'builtins::compat' => @builtins;
use if $] ge '5.036000', 'builtin' => @builtins;
no if $] ge '5.036000', 'warnings' => qw( experimental::builtin );

use B                 qw( perlstring );
use Carp              qw( croak );
use Eval::TypeTiny    qw( eval_closure set_subname );
use Exporter::Tiny    qw( mkopt );
use Import::Into;
use Module::Runtime   qw( require_module module_notional_filename );
use Type::Registry    qw();
use Types::Common     qw(
        -sigs
        -types
        assert_Ref       is_Ref
        assert_ArrayRef  is_ArrayRef
        assert_HashRef   is_HashRef
        is_NonEmptySimpleStr
);

sub _exporter_validate_opts {
        my ( $me, $options ) = @_;
        my $into  = $options->{into};
        my $setup = $options->{setup};
        strict->import::into( $into );
        warnings->import::into( $into );
        $me->setup_for( $into, $setup );
}

# Subclasses may wish to provide a subclass of Exporter::Tiny here.
sub base_exporter {
        return 'Exporter::Tiny';
}

sub standard_package_variables {
        my ( $me, $into ) = @_;
        no strict 'refs';
        return (
                \@{"$into\::ISA"},
                \@{"$into\::EXPORT"},
                \@{"$into\::EXPORT_OK"},
                \%{"$into\::EXPORT_TAGS"},
        );
}

signature_for setup_for => (
        method  => 1,
        head    => [ NonEmptySimpleStr ],
        named   => [
                tag    => Optional[HashRef],
                also   => Optional[ArrayRef],
                enum   => Optional[HashRef[ArrayRef]],
                class  => Optional[ArrayRef],
                role   => Optional[ArrayRef],
                duck   => Optional[HashRef[ArrayRef]],
                type   => Optional[ArrayRef],
                const  => Optional[HashRef],
        ],
);

sub setup_for {
        my ( $me, $into, $setup ) = @_;
        $INC{ module_notional_filename($into) } //= __FILE__;
        my @steps = $me->steps( $into, $setup );
        for my $step ( @steps ) {
                $me->$step( $into, $setup );
        }
        return;
}

# Subclasses can wrap this to easily add and remove steps.
sub steps {
        my ( $me, $into, $setup ) = @_;
        my @steps;
        push @steps, 'setup_exporter_for';
        push @steps, 'setup_reexports_for'            if $setup->{also};
        push @steps, 'setup_enums_for'                if $setup->{enum};
        push @steps, 'setup_classes_for'              if $setup->{class};
        push @steps, 'setup_roles_for'                if $setup->{role};
        push @steps, 'setup_ducks_for'                if $setup->{duck};
        push @steps, 'setup_types_for'                if $setup->{type};
        push @steps, 'setup_constants_for'            if $setup->{const};
        push @steps, 'setup_readonly_vars_for';
        push @steps, 'finalize_export_variables_for';
        return @steps;
}

sub setup_exporter_for {
        my ( $me, $into, $setup ) = @_;
        
        my ( $into_ISA, undef, undef, $into_EXPORT_TAGS ) =
                $me->standard_package_variables( $into );
        
        # Set up @ISA in caller package.
        my $base = $me->base_exporter( $into, $setup );
        push @$into_ISA, $base unless $into->isa( $base );
        
        # Set up %EXPORT_TAGS in caller package.
        my %tags = %{ $setup->{tag} // {} };
        for my $tag_name ( keys %tags ) {
                my @exports = @{ assert_ArrayRef $tags{$tag_name} };
                $tag_name =~ s/^[-:]//;
                push @{ $into_EXPORT_TAGS->{$tag_name} //= [] }, @exports;
        }
        
        return;
}

sub setup_reexports_for {
        my ( $me, $into, $setup ) = @_;
        
        my $next = $into->can( '_exporter_validate_opts' );
        
        my $optlist = mkopt( $setup->{also} );
        require_module( $_->[0] ) for @$optlist;
        
        my $method_name = "$into\::_exporter_validate_opts";
        my $method_code = sub {
                my ( $class, $opts ) = @_;
                is_NonEmptySimpleStr( my $caller = $opts->{into} ) or return;
                for my $also ( @$optlist ) {
                        my ( $module, $args ) = @$also;
                        $module->import::into( $caller, @{ $args // [] } );
                }
                goto $next if $next;
        };
        no strict 'refs';
        *$method_name = set_subname $method_name => $method_code;
}

sub setup_enums_for {
        my ( $me, $into, $setup ) = @_;
        
        require Type::Tiny::Enum;
        my $reg = Type::Registry->for_class( $into );
        $me->_ensure_isa_type_library( $into );
        
        my %tags = %{ assert_HashRef $setup->{enum} // {} };
        for my $tag_name ( keys %tags ) {
                my $values = $tags{$tag_name};
                $tag_name =~ s/^[-:]//;
                my $type_name = $tag_name;
                $tag_name = lc $tag_name;
                
                Type::Tiny::Enum->import( { into => $into }, $type_name, $values );
                $into->add_type( $reg->lookup( $type_name ) );
        }
        
        return;
}

sub setup_classes_for {
        my ( $me, $into, $setup ) = @_;
        require Type::Tiny::Class;
        $me->_setup_classes_or_roles_for( $into, $setup, 'class', 'Type::Tiny::Class' );
}

sub setup_roles_for {
        my ( $me, $into, $setup ) = @_;
        require Type::Tiny::Role;
        $me->_setup_classes_or_roles_for( $into, $setup, 'role', 'Type::Tiny::Role' );
}

sub _setup_classes_or_roles_for {
        my ( $me, $into, $setup, $kind, $tt_class ) = @_;
        
        my $reg = Type::Registry->for_class( $into );
        $me->_ensure_isa_type_library( $into );
        
        my $optlist = mkopt( $setup->{$kind} );
        for my $dfn ( @$optlist ) {
                ( my $pkg_name  = ( $dfn->[1] //= {} )->{$kind} // $dfn->[0] );
                ( my $type_name = ( $dfn->[1] //= {} )->{name}  // $dfn->[0] ) =~ s/:://g;
                $tt_class->import( { into => $into }, @$dfn );
                $into->add_type( $reg->lookup( $type_name ) );
                eval { require_module( $pkg_name ) };
        }
        
        return;
}

sub setup_ducks_for {
        my ( $me, $into, $setup ) = @_;
        
        require Type::Tiny::Duck;
        my $reg = Type::Registry->for_class( $into );
        $me->_ensure_isa_type_library( $into );
        
        my %types = %{ assert_HashRef $setup->{duck} // {} };
        for my $type_name ( keys %types ) {
                my $values = $types{$type_name};
                Type::Tiny::Duck->import( { into => $into }, $type_name, $values );
                $into->add_type( $reg->lookup( $type_name ) );
        }
        
        return;
}

sub setup_types_for {
        my ( $me, $into, $setup ) = @_;
        
        my $reg = Type::Registry->for_class( $into );
        $me->_ensure_isa_type_library( $into );
        
        my $optlist = mkopt( $setup->{type} );
        my @extends = ();
        for my $dfn ( @$optlist ) {
                my ( $lib, $list ) = @$dfn;
                eval { require_module( $lib ) };
                if ( is_ArrayRef $list ) {
                        for my $type_name ( @$list ) {
                                $into->add_type( $lib->get_type( $type_name ) );
                        }
                }
                else {
                        push @extends, $lib;
                }
        }
        
        if ( @extends ) {
                require Type::Utils;
                my $wrapper = eval "sub { package $into; &Type::Utils::extends; }";
                $wrapper->( @extends );
        }
        
        return;
}

sub _ensure_isa_type_library {
        my ( $me, $into ) = @_;
        return if $into->isa( 'Type::Library' );
        my ( $old_isa ) = $me->standard_package_variables( $into );
        my $new_isa = [];
        my $saw_exporter_tiny = 0;
        for my $pkg ( @$old_isa ) {
                if ( $pkg eq 'Exporter::Tiny' ) {
                        push @$new_isa, 'Type::Library';
                        $saw_exporter_tiny++;
                }
                else {
                        push @$new_isa, $pkg;
                }
        }
        push @$new_isa, 'Type::Library' unless $saw_exporter_tiny;
        @$old_isa = @$new_isa;
}

sub setup_constants_for {
        my ( $me, $into, $setup ) = @_;
        
        my ( $into_ISA, undef, undef, $into_EXPORT_TAGS ) =
                $me->standard_package_variables( $into );

        my %tags = %{ assert_HashRef $setup->{const} // {} };
        for my $tag_name ( keys %tags ) {
                my %exports = %{ assert_HashRef $tags{$tag_name} };
                $tag_name =~ s/^[-:]//;
                my @constant_names = sort keys %exports;
                push @{ $into_EXPORT_TAGS->{$tag_name}   //= [] }, @constant_names;
                push @{ $into_EXPORT_TAGS->{'constants'} //= [] }, @constant_names;
                $me->make_constant_subs( $into, \%exports );
        }
        
        return;
}

sub make_constant_subs {
        my ( $me, $into, $constants ) = @_;
        
        for my $key ( keys %$constants ) {
                my $value = $constants->{$key};
                my $full_name = "$into\::$key";
                
                my $coderef;
                if ( is_Ref $value ) {
                        $coderef = eval_closure(
                                source      => 'sub () { $value }',
                                environment => { '$value' => \$value },
                        );
                }
                else {
                        $coderef = eval sprintf(
                                'sub () { %s %s }',
                                is_bool( $value ) ? '!!' : ( created_as_number( $value ) ? '0+' : '' ),
                                perlstring( $value ),
                        );
                }
                
                no strict 'refs';
                *$full_name = set_subname $full_name => $coderef;
        }
}

sub setup_readonly_vars_for {
        my ( $me, $into, $setup ) = @_;
        
        my ( $into_ISA, $into_EXPORT, $into_EXPORT_OK, $into_EXPORT_TAGS ) =
                $me->standard_package_variables( $into );
        
        my @constants = @{ $into_EXPORT_TAGS->{'constants'} // [] };
        for my $name ( @constants ) {
                no strict 'refs';
                my $full_name = "$into\::$name";
                ${ $full_name } = &{ $full_name }();
                Internals::SvREADONLY( ${ $full_name }, 1 );
                push @{ $into_EXPORT_TAGS->{'ro_vars'} //= [] }, '$' . $name;
        }
        
        return;
}

sub finalize_export_variables_for {
        my ( $me, $into, $setup ) = @_;
        
        my ( $into_ISA, $into_EXPORT, $into_EXPORT_OK, $into_EXPORT_TAGS ) =
                $me->standard_package_variables( $into );
        
        my %all_exports;
        for my $list ( $into_EXPORT, $into_EXPORT_OK, values %{ $into_EXPORT_TAGS // {} } ) {
                is_ArrayRef $list or next;
                $all_exports{$_}++ for @$list;
        }
        @{ $into_EXPORT_OK } = sort keys %all_exports;
        
        my %default_exports;
        for my $list ( $into_EXPORT, $into_EXPORT_TAGS->{default} ) {
                is_ArrayRef $list or next;
                $default_exports{$_}++ for @$list;
        }
        @{ $into_EXPORT } = sort keys %default_exports;
        
        return;
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Exporter::Almighty - combining Exporter::Tiny with some other stuff for added power

=head1 SYNOPSIS

  package Your::Package;
  
  use v5.12;
  use Exporter::Almighty -setup => {
    tag => {
      foo => [ 'foo1', 'foo2' ],
      bar => [ 'bar1' ],
    },
    const => {
      colours => { RED => 'red', BLUE => 'blue', GREEN => 'green' },
    },
    enum => {
      Status => [ 'dead', 'alive' ],
    },
    also => [
      'strict',
      'Scalar::Util' => [ 'refaddr' ],
      'warnings',
    ],
  };
  
  sub foo1 { ... }
  sub foo2 { ... }
  sub bar1 { ... }
  
  1;

=head1 DESCRIPTION

This module aims to make building exporters easier. It is based on
L<Exporter::Tiny>, but helps you avoid manually setting C<< @EXPORT_OK >>,
C<< %EXPORT_TAGS >>, etc.

Exporter::Almighty supports lexical exports, even on Perl versions as old
as 5.12.

Exporter::Almighty indeed requires Perl 5.12, so it's strongly recommended
you add C<< use v5.12 >> (or higher) before C<< use Exporter::Almighty >>
so that your package can benefit from features which don't exist in legacy
versions of Perl.

=head2 Setup Options

Exporter::Almighty's own setup happens through its import. A setup hashref
is passed as per the example in the L</SYNOPSIS>. Each key in this hash is
a setup option.

The names are all short, singular names, in case you forget whether to use
C<tag> or C<tags>!

=head3 C<< tag >>

This is a hashref where the keys are tag names and the values are arrayrefs
of function names.

  use Exporter::Almighty -setup => {
    tag => {
      foo => [ 'foo1', 'foo2' ],
      bar => [ 'bar1' ],
    }
  };

A user of the package defined in the L</SYNOPSIS> could import:

  use Your::Package qw( foo1 foo2 bar1 );   # import functions by name
  use Your::Package qw( :foo );             # import 'foo1' and 'foo2'
  use Your::Package qw( -foo );             # same!

If you have a tag called C<default>, that is special. It will be
automatically exported if your caller doesn't provide an explicit
list of things they want to import.

The following other tags also have special meanings: C<constants>,
C<types>, C<assert>, C<is>, C<to>, and C<all>.

By convention, tags names should be snake_case.

=head3 C<< const >>

Similar to C<< tag >> this is a hashref where keys are tag names, but instead
of the values being arrayrefs of function names, they are hashrefs which
define constants.

  use Exporter::Almighty -setup => {
    const => {
      colours => { RED => 'red', BLUE => 'blue', GREEN => 'green' },
    },
  };

A user of the package defined in the L</SYNOPSIS> could import:

  use Your::Package qw( RED GREEN BLUE );   # import constants by name
  use Your::Package qw( :colours );         # import 'colours' constants
  use Your::Package qw( :constants );       # import ALL constants

By convention, the tag names should be snake_case, but constant names
should be SHOUTING_SNAKE_CASE.

For every constant like C<< RED >>, a readonly variable C<< $RED >> is
also created, making it easier to interpolate the constant into a string.
These are not exported by default.

  use Your::Package qw( $RED $GREEN $BLUE );  # import ro vars by name
  use Your::Package qw( :ro_vars );           # import ALL ro vars

=head3 C<< type >>

This is an arrayref of type libraries. Each library listed will be I<imported>
into your exporter, and then the types in it will be I<re-exported> to the
people who use your package. Each type library can optionally be followed by an
arrayref of type names if you don't want to just import all types.

  package Your::Package;
  
  use Exporter::Almighty -setup => {
    tags => {
      foo => [ 'foo1', 'foo2' ],
    },
    type => [
      'Types::Standard',
      'Types::Common::String'  => [ 'NonEmptyStr' ],
      'Types::Common::Numeric' => [ 'PositiveInt', 'PositiveOrZeroInt' ],
    ],
  };
  
  sub foo1 { ... }
  sub foo2 { ... }
  
  ...;
  
  package main;
  
  use Your::Package qw( -foo is_NonEmptyStr );
  
  my $got = foo1();
  if ( is_NonEmptyStr( $got ) ) {
    foo2();
  }

If you re-export types like this, then your module will be "promoted" to being
a subclass of L<Type::Library> instead of L<Exporter::Tiny>. (Type::Library is
itself a subclass of Exporter::Tiny, so you don't miss out on any features.)

=head3 C<< enum >>

This is a hashref where keys are enumerated type names, and the values are
arrayrefs of strings.

  use Exporter::Almighty -setup => {
    enum => {
      Status => [ 'dead', 'alive' ],
    },
  };

A user of the package defined in the L</SYNOPSIS> could import:

  use Your::Package qw(
    Status
    is_Status
    assert_Status
    to_Status
    STATUS_ALIVE
    STATUS_DEAD
  );
  use Your::Package qw( +Status );  # shortcut for the above

The C<Status> function exported by the above will return a L<Type::Tiny::Enum>
object.

The C<< :types >>, C<< :is >>, C<< :assert >>, C<< :to >>, and C<< :constants >>
tags will also automatically include the relevent exports.

If you export any enums then your module will be "promoted" from being an
L<Exporter::Tiny> to being a L<Type::Library>.

By convention, enum types should be UpperCamelCase.

=head3 C<< class >>

This is an arrayref of class names.

  use Exporter::Almighty -setup => {
    class => [
      'HTTP::Tiny',
      'LWP::UserAgent',
    ],
  };

People can import:

  use Your::Package qw( +HTTPTiny +LWPUserAgent );
  
  unless ( is_HTTPTiny($x) or is_LWPUserAgent($x) ) {
    $x = HTTPTiny->new();
  }

These create L<Type::Tiny::Class> type constraints similar to how C<enum>
works. It will similarly promote your exporter to a L<Type::Library>.

Notice that the C<new> method will be proxied through to the underlying
class, so these can also work as useful aliases for long class names.

  use Exporter::Almighty -setup => {
    class => [
      'ShortName' => { class => 'Very::Long::Class::Name' },
      'TinyName'  => { class => 'An::Even::Longer::Class::Name' },
    ],
  };

Exporter::Almighty will attempt to pre-emptively load modules mentioned here,
so you don't need to do it yourself. However if the modules don't exist, it
won't complain.

=head3 C<< role >>

This works the same as C<class>, except for roles.

=head3 C<< duck >>

This is a hashref where keys are "duck type" type names, and the values are
arrayrefs of method names.

  use Exporter::Almighty -setup => {
    duck => [
      'UserAgent' => [ 'head', 'get', 'post' ],
    ],
  };

These create L<Type::Tiny::Duck> type constraints similar to how C<enum>
works. It will similarly promote your exporter to be a L<Type::Library>.

=head3 C<< also >>

A list of other packages to also export to your caller. Each package name
can optionally be followed by an arrayref of import arguments.

  use Exporter::Almighty -setup => {
    also => [
      'strict',
      'Scalar::Util' => [ 'refaddr' ],
      'warnings',
    ],
  };

Your caller isn't given any options allowing them to opt in or out of this,
so it is recommended that this be used sparingly. L<strict>, L<warnings>,
L<feature>, L<experimental>, and L<namespace::autoclean> are good packages to
consider listing here. Packages that export named functions are less good.

=head2 API

Instead of:

  package Your::Package;
  use Exporter::Almighty -setup => \%setup;

It is possible to do this at run-time:

  Exporter::Almighty->setup_for( 'Your::Package', %setup );

This may allow slightly more flexibility in some cases.

Exporter::Almighty is also designed to be easily subclassable.

=head2 Exporter::Tiny features you get for free

=head3 Features for you

Exporter::Almighty will import L<strict> and L<warnings> into your package.

You can export package variables, though it's rarely a good idea:

  package Your::Package;
  
  use Exporter::Almighty -setup => {
    tag => { default => [ 'xxx', '$YYY' ] },
  };
  
  our $YYY = 42;

You can use generators:

  package Your::Package;
  
  use Exporter::Almighty -setup => {
    tag => { default => [ 'xxx' ] },
  };
  
  sub _generate_xxx {
    my ( $me, $name, $vals, $opts ) = @_;
    my $caller = $opts->{into};
    
    # Return the sub which will be installed into caller as 'xxx'.
    return sub {
    };
  }
  
  ...;
  
  package main;
  use Your::Package 'xxx' => \%vals;
  
  xxx( ... );

=head3 Features for your caller

Your caller can do lexical imports:

  use Your::Package -lexical, qw( ... );

Your caller can rename imported functions:

  use Your::Package foo => { -as => 'foofoo' };

And everything else described in L<Exporter::Tiny::Manual::Importing>.

=head1 BUGS

Please report any bugs to
L<https://github.com/tobyink/p5-exporter-almighty/issues>.

=head1 SEE ALSO

L<Exporter::Tiny>, L<Exporter::Shiny>.

L<CXC::Exporter::Util> was an inspiration for this module and the features
overlap a bit.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2023 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.


1	use 5.012;	4✔
2	use strict;	4✔
3	use warnings;	4✔
4
5	package Exporter::Almighty;
6
7	our $AUTHORITY = 'cpan:TOBYINK';
8	our $VERSION = '0.001004';
9
10	use parent qw( Exporter::Tiny );	4✔
11
12	my @builtins;
13	BEGIN { @builtins = qw( is_bool created_as_string created_as_number ) };	4✔
14	use if $] lt '5.036000', 'builtins::compat' => @builtins;	4✔
15	use if $] ge '5.036000', 'builtin' => @builtins;	4✔
16	no if $] ge '5.036000', 'warnings' => qw( experimental::builtin );	4✔
17
18	use B qw( perlstring );	4✔
19	use Carp qw( croak );	4✔
20	use Eval::TypeTiny qw( eval_closure set_subname );	4✔
21	use Exporter::Tiny qw( mkopt );	4✔
22	use Import::Into;	4✔
23	use Module::Runtime qw( require_module module_notional_filename );	4✔
24	use Type::Registry qw();	4✔
25	use Types::Common qw(	4✔
26	-sigs
27	-types
28	assert_Ref is_Ref
29	assert_ArrayRef is_ArrayRef
30	assert_HashRef is_HashRef
31	is_NonEmptySimpleStr
32	);	4✔
33
34	sub _exporter_validate_opts {
35	my ( $me, $options ) = @_;	2✔
36	my $into = $options->{into};	2✔
37	my $setup = $options->{setup};	2✔
38	strict->import::into( $into );	2✔
39	warnings->import::into( $into );	2✔
40	$me->setup_for( $into, $setup );	2✔
41	}
42
43	# Subclasses may wish to provide a subclass of Exporter::Tiny here.
44	sub base_exporter {
45	return 'Exporter::Tiny';	8✔
46	}
47
48	sub standard_package_variables {
49	my ( $me, $into ) = @_;	30✔
50	no strict 'refs';	4✔
51	return (
52	\@{"$into\::ISA"},	30✔
53	\@{"$into\::EXPORT"},	30✔
54	\@{"$into\::EXPORT_OK"},	30✔
55	\%{"$into\::EXPORT_TAGS"},	30✔
56	);
57	}
58
59	signature_for setup_for => (
60	method => 1,
61	head => [ NonEmptySimpleStr ],
62	named => [
63	tag => Optional[HashRef],
64	also => Optional[ArrayRef],
65	enum => Optional[HashRef[ArrayRef]],
66	class => Optional[ArrayRef],
67	role => Optional[ArrayRef],
68	duck => Optional[HashRef[ArrayRef]],
69	type => Optional[ArrayRef],
70	const => Optional[HashRef],
71	],
72	);
73
74	sub setup_for {
75	my ( $me, $into, $setup ) = @_;
76	$INC{ module_notional_filename($into) } //= __FILE__;
77	my @steps = $me->steps( $into, $setup );
78	for my $step ( @steps ) {
79	$me->$step( $into, $setup );
80	}
81	return;
82	}
83
84	# Subclasses can wrap this to easily add and remove steps.
85	sub steps {
86	my ( $me, $into, $setup ) = @_;	16✔
87	my @steps;	16✔
88	push @steps, 'setup_exporter_for';	16✔
89	push @steps, 'setup_reexports_for' if $setup->{also};	16✔
90	push @steps, 'setup_enums_for' if $setup->{enum};	16✔
91	push @steps, 'setup_classes_for' if $setup->{class};	16✔
92	push @steps, 'setup_roles_for' if $setup->{role};	16✔
93	push @steps, 'setup_ducks_for' if $setup->{duck};	16✔
94	push @steps, 'setup_types_for' if $setup->{type};	16✔
95	push @steps, 'setup_constants_for' if $setup->{const};	16✔
96	push @steps, 'setup_readonly_vars_for';	16✔
97	push @steps, 'finalize_export_variables_for';	16✔
98	return @steps;	16✔
99	}
100
101	sub setup_exporter_for {
102	my ( $me, $into, $setup ) = @_;	7✔
103
104	my ( $into_ISA, undef, undef, $into_EXPORT_TAGS ) =	7✔
105	$me->standard_package_variables( $into );
106
107	# Set up @ISA in caller package.
108	my $base = $me->base_exporter( $into, $setup );	7✔
109	push @$into_ISA, $base unless $into->isa( $base );	7✔
110
111	# Set up %EXPORT_TAGS in caller package.
112	my %tags = %{ $setup->{tag} // {} };	7✔
113	for my $tag_name ( keys %tags ) {	7✔
114	my @exports = @{ assert_ArrayRef $tags{$tag_name} };	7✔
115	$tag_name =~ s/^[-:]//;	7✔
116	push @{ $into_EXPORT_TAGS->{$tag_name} //= [] }, @exports;	7✔
117	}
118
119	return;	7✔
120	}
121
122	sub setup_reexports_for {
123	my ( $me, $into, $setup ) = @_;	2✔
124
125	my $next = $into->can( '_exporter_validate_opts' );	2✔
126
127	my $optlist = mkopt( $setup->{also} );	2✔
128	require_module( $_->[0] ) for @$optlist;	2✔
129
130	my $method_name = "$into\::_exporter_validate_opts";	2✔
131	my $method_code = sub {
132	my ( $class, $opts ) = @_;	2✔
133	is_NonEmptySimpleStr( my $caller = $opts->{into} ) or return;	2✔
134	for my $also ( @$optlist ) {	2✔
135	my ( $module, $args ) = @$also;	4✔
136	$module->import::into( $caller, @{ $args // [] } );	4✔
137	}
138	goto $next if $next;	2✔
139	};	2✔
140	no strict 'refs';	4✔
141	*$method_name = set_subname $method_name => $method_code;	2✔
142	}
143
144	sub setup_enums_for {
145	my ( $me, $into, $setup ) = @_;	2✔
146
147	require Type::Tiny::Enum;	2✔
148	my $reg = Type::Registry->for_class( $into );	2✔
149	$me->_ensure_isa_type_library( $into );	2✔
150
151	my %tags = %{ assert_HashRef $setup->{enum} // {} };	2✔
152	for my $tag_name ( keys %tags ) {	2✔
153	my $values = $tags{$tag_name};	2✔
154	$tag_name =~ s/^[-:]//;	2✔
155	my $type_name = $tag_name;	2✔
156	$tag_name = lc $tag_name;	2✔
157
158	Type::Tiny::Enum->import( { into => $into }, $type_name, $values );	2✔
159	$into->add_type( $reg->lookup( $type_name ) );	2✔
160	}
161
162	return;	2✔
163	}
164
165	sub setup_classes_for {
166	my ( $me, $into, $setup ) = @_;	1✔
167	require Type::Tiny::Class;	1✔
168	$me->_setup_classes_or_roles_for( $into, $setup, 'class', 'Type::Tiny::Class' );	1✔
169	}
170
171	sub setup_roles_for {
172	my ( $me, $into, $setup ) = @_;	1✔
173	require Type::Tiny::Role;	1✔
174	$me->_setup_classes_or_roles_for( $into, $setup, 'role', 'Type::Tiny::Role' );	1✔
175	}
176
177	sub _setup_classes_or_roles_for {
178	my ( $me, $into, $setup, $kind, $tt_class ) = @_;	2✔
179
180	my $reg = Type::Registry->for_class( $into );	2✔
181	$me->_ensure_isa_type_library( $into );	2✔
182
183	my $optlist = mkopt( $setup->{$kind} );	2✔
184	for my $dfn ( @$optlist ) {	2✔
185	( my $pkg_name = ( $dfn->[1] //= {} )->{$kind} // $dfn->[0] );	2✔
186	( my $type_name = ( $dfn->[1] //= {} )->{name} // $dfn->[0] ) =~ s/:://g;	2✔
187	$tt_class->import( { into => $into }, @$dfn );	2✔
188	$into->add_type( $reg->lookup( $type_name ) );	2✔
189	eval { require_module( $pkg_name ) };	2✔
190	}
191
192	return;	2✔
193	}
194
195	sub setup_ducks_for {
196	my ( $me, $into, $setup ) = @_;	1✔
197
198	require Type::Tiny::Duck;	1✔
199	my $reg = Type::Registry->for_class( $into );	1✔
200	$me->_ensure_isa_type_library( $into );	1✔
201
202	my %types = %{ assert_HashRef $setup->{duck} // {} };	1✔
203	for my $type_name ( keys %types ) {	1✔
204	my $values = $types{$type_name};	1✔
205	Type::Tiny::Duck->import( { into => $into }, $type_name, $values );	1✔
206	$into->add_type( $reg->lookup( $type_name ) );	1✔
207	}
208
209	return;	1✔
210	}
211
212	sub setup_types_for {
213	my ( $me, $into, $setup ) = @_;	2✔
214
215	my $reg = Type::Registry->for_class( $into );	2✔
216	$me->_ensure_isa_type_library( $into );	2✔
217
218	my $optlist = mkopt( $setup->{type} );	2✔
219	my @extends = ();	2✔
220	for my $dfn ( @$optlist ) {	2✔
221	my ( $lib, $list ) = @$dfn;	2✔
222	eval { require_module( $lib ) };	2✔
223	if ( is_ArrayRef $list ) {	2✔
224	for my $type_name ( @$list ) {	1✔
225	$into->add_type( $lib->get_type( $type_name ) );	1✔
226	}
227	}
228	else {
229	push @extends, $lib;	1✔
230	}
231	}
232
233	if ( @extends ) {	2✔
234	require Type::Utils;	1✔
235	my $wrapper = eval "sub { package $into; &Type::Utils::extends; }";	1✔
236	$wrapper->( @extends );	1✔
237	}
238
239	return;	2✔
240	}
241
242	sub _ensure_isa_type_library {
243	my ( $me, $into ) = @_;	7✔
244	return if $into->isa( 'Type::Library' );	7✔
245	my ( $old_isa ) = $me->standard_package_variables( $into );	7✔
246	my $new_isa = [];	7✔
247	my $saw_exporter_tiny = 0;	7✔
248	for my $pkg ( @$old_isa ) {	7✔
249	if ( $pkg eq 'Exporter::Tiny' ) {	1✔
250	push @$new_isa, 'Type::Library';	1✔
251	$saw_exporter_tiny++;	1✔
252	}
253	else {
254	push @$new_isa, $pkg;	×
255	}
256	}
257	push @$new_isa, 'Type::Library' unless $saw_exporter_tiny;	7✔
258	@$old_isa = @$new_isa;	7✔
259	}
260
261	sub setup_constants_for {
262	my ( $me, $into, $setup ) = @_;	3✔
263
264	my ( $into_ISA, undef, undef, $into_EXPORT_TAGS ) =	3✔
265	$me->standard_package_variables( $into );
266
267	my %tags = %{ assert_HashRef $setup->{const} // {} };	3✔
268	for my $tag_name ( keys %tags ) {	3✔
269	my %exports = %{ assert_HashRef $tags{$tag_name} };	4✔
270	$tag_name =~ s/^[-:]//;	4✔
271	my @constant_names = sort keys %exports;	4✔
272	push @{ $into_EXPORT_TAGS->{$tag_name} //= [] }, @constant_names;	4✔
273	push @{ $into_EXPORT_TAGS->{'constants'} //= [] }, @constant_names;	4✔
274	$me->make_constant_subs( $into, \%exports );	4✔
275	}
276
277	return;	3✔
278	}
279
280	sub make_constant_subs {
281	my ( $me, $into, $constants ) = @_;	5✔
282
283	for my $key ( keys %$constants ) {	5✔
284	my $value = $constants->{$key};	17✔
285	my $full_name = "$into\::$key";	17✔
286
287	my $coderef;	17✔
288	if ( is_Ref $value ) {	17✔
289	$coderef = eval_closure(	2✔
290	source => 'sub () { $value }',
291	environment => { '$value' => \$value },
292	);
293	}
294	else {
295	$coderef = eval sprintf(	15✔
296	'sub () { %s %s }',
297	is_bool( $value ) ? '!!' : ( created_as_number( $value ) ? '0+' : '' ),
298	perlstring( $value ),
299	);
300	}
301
302	no strict 'refs';	4✔
303	*$full_name = set_subname $full_name => $coderef;	17✔
304	}
305	}
306
307	sub setup_readonly_vars_for {
308	my ( $me, $into, $setup ) = @_;	8✔
309
310	my ( $into_ISA, $into_EXPORT, $into_EXPORT_OK, $into_EXPORT_TAGS ) =	8✔
311	$me->standard_package_variables( $into );
312
313	my @constants = @{ $into_EXPORT_TAGS->{'constants'} // [] };	8✔
314	for my $name ( @constants ) {	8✔
315	no strict 'refs';	4✔
316	my $full_name = "$into\::$name";	9✔
317	${ $full_name } = &{ $full_name }();	9✔
318	Internals::SvREADONLY( ${ $full_name }, 1 );	9✔
319	push @{ $into_EXPORT_TAGS->{'ro_vars'} //= [] }, '$' . $name;	9✔
320	}
321
322	return;	8✔
323	}
324
325	sub finalize_export_variables_for {
326	my ( $me, $into, $setup ) = @_;	3✔
327
328	my ( $into_ISA, $into_EXPORT, $into_EXPORT_OK, $into_EXPORT_TAGS ) =	3✔
329	$me->standard_package_variables( $into );
330
331	my %all_exports;	3✔
332	for my $list ( $into_EXPORT, $into_EXPORT_OK, values %{ $into_EXPORT_TAGS // {} } ) {	3✔
333	is_ArrayRef $list or next;	22✔
334	$all_exports{$_}++ for @$list;	22✔
335	}
336	@{ $into_EXPORT_OK } = sort keys %all_exports;	3✔
337
338	my %default_exports;	3✔
339	for my $list ( $into_EXPORT, $into_EXPORT_TAGS->{default} ) {	3✔
340	is_ArrayRef $list or next;	6✔
341	$default_exports{$_}++ for @$list;	4✔
342	}
343	@{ $into_EXPORT } = sort keys %default_exports;	3✔
344
345	return;	3✔
346	}
347
348	1;
349
350	__END__
351
352	=pod
353
354	=encoding utf-8
355
356	=head1 NAME
357
358	Exporter::Almighty - combining Exporter::Tiny with some other stuff for added power
359
360	=head1 SYNOPSIS
361
362	package Your::Package;
363
364	use v5.12;
365	use Exporter::Almighty -setup => {
366	tag => {
367	foo => [ 'foo1', 'foo2' ],
368	bar => [ 'bar1' ],
369	},
370	const => {
371	colours => { RED => 'red', BLUE => 'blue', GREEN => 'green' },
372	},
373	enum => {
374	Status => [ 'dead', 'alive' ],
375	},
376	also => [
377	'strict',
378	'Scalar::Util' => [ 'refaddr' ],
379	'warnings',
380	],
381	};
382
383	sub foo1 { ... }
384	sub foo2 { ... }
385	sub bar1 { ... }
386
387	1;
388
389	=head1 DESCRIPTION
390
391	This module aims to make building exporters easier. It is based on
392	L<Exporter::Tiny>, but helps you avoid manually setting C<< @EXPORT_OK >>,
393	C<< %EXPORT_TAGS >>, etc.
394
395	Exporter::Almighty supports lexical exports, even on Perl versions as old
396	as 5.12.
397
398	Exporter::Almighty indeed requires Perl 5.12, so it's strongly recommended
399	you add C<< use v5.12 >> (or higher) before C<< use Exporter::Almighty >>
400	so that your package can benefit from features which don't exist in legacy
401	versions of Perl.
402
403	=head2 Setup Options
404
405	Exporter::Almighty's own setup happens through its import. A setup hashref
406	is passed as per the example in the L</SYNOPSIS>. Each key in this hash is
407	a setup option.
408
409	The names are all short, singular names, in case you forget whether to use
410	C<tag> or C<tags>!
411
412	=head3 C<< tag >>
413
414	This is a hashref where the keys are tag names and the values are arrayrefs
415	of function names.
416
417	use Exporter::Almighty -setup => {
418	tag => {
419	foo => [ 'foo1', 'foo2' ],
420	bar => [ 'bar1' ],
421	}
422	};
423
424	A user of the package defined in the L</SYNOPSIS> could import:
425
426	use Your::Package qw( foo1 foo2 bar1 ); # import functions by name
427	use Your::Package qw( :foo ); # import 'foo1' and 'foo2'
428	use Your::Package qw( -foo ); # same!
429
430	If you have a tag called C<default>, that is special. It will be
431	automatically exported if your caller doesn't provide an explicit
432	list of things they want to import.
433
434	The following other tags also have special meanings: C<constants>,
435	C<types>, C<assert>, C<is>, C<to>, and C<all>.
436
437	By convention, tags names should be snake_case.
438
439	=head3 C<< const >>
440
441	Similar to C<< tag >> this is a hashref where keys are tag names, but instead
442	of the values being arrayrefs of function names, they are hashrefs which
443	define constants.
444
445	use Exporter::Almighty -setup => {
446	const => {
447	colours => { RED => 'red', BLUE => 'blue', GREEN => 'green' },
448	},
449	};
450
451	A user of the package defined in the L</SYNOPSIS> could import:
452
453	use Your::Package qw( RED GREEN BLUE ); # import constants by name
454	use Your::Package qw( :colours ); # import 'colours' constants
455	use Your::Package qw( :constants ); # import ALL constants
456
457	By convention, the tag names should be snake_case, but constant names
458	should be SHOUTING_SNAKE_CASE.
459
460	For every constant like C<< RED >>, a readonly variable C<< $RED >> is
461	also created, making it easier to interpolate the constant into a string.
462	These are not exported by default.
463
464	use Your::Package qw( $RED $GREEN $BLUE ); # import ro vars by name
465	use Your::Package qw( :ro_vars ); # import ALL ro vars
466
467	=head3 C<< type >>
468
469	This is an arrayref of type libraries. Each library listed will be I<imported>
470	into your exporter, and then the types in it will be I<re-exported> to the
471	people who use your package. Each type library can optionally be followed by an
472	arrayref of type names if you don't want to just import all types.
473
474	package Your::Package;
475
476	use Exporter::Almighty -setup => {
477	tags => {
478	foo => [ 'foo1', 'foo2' ],
479	},
480	type => [
481	'Types::Standard',
482	'Types::Common::String' => [ 'NonEmptyStr' ],
483	'Types::Common::Numeric' => [ 'PositiveInt', 'PositiveOrZeroInt' ],
484	],
485	};
486
487	sub foo1 { ... }
488	sub foo2 { ... }
489
490	...;
491
492	package main;
493
494	use Your::Package qw( -foo is_NonEmptyStr );
495
496	my $got = foo1();
497	if ( is_NonEmptyStr( $got ) ) {
498	foo2();
499	}
500
501	If you re-export types like this, then your module will be "promoted" to being
502	a subclass of L<Type::Library> instead of L<Exporter::Tiny>. (Type::Library is
503	itself a subclass of Exporter::Tiny, so you don't miss out on any features.)
504
505	=head3 C<< enum >>
506
507	This is a hashref where keys are enumerated type names, and the values are
508	arrayrefs of strings.
509
510	use Exporter::Almighty -setup => {
511	enum => {
512	Status => [ 'dead', 'alive' ],
513	},
514	};
515
516	A user of the package defined in the L</SYNOPSIS> could import:
517
518	use Your::Package qw(
519	Status
520	is_Status
521	assert_Status
522	to_Status
523	STATUS_ALIVE
524	STATUS_DEAD
525	);
526	use Your::Package qw( +Status ); # shortcut for the above
527
528	The C<Status> function exported by the above will return a L<Type::Tiny::Enum>
529	object.
530
531	The C<< :types >>, C<< :is >>, C<< :assert >>, C<< :to >>, and C<< :constants >>
532	tags will also automatically include the relevent exports.
533
534	If you export any enums then your module will be "promoted" from being an
535	L<Exporter::Tiny> to being a L<Type::Library>.
536
537	By convention, enum types should be UpperCamelCase.
538
539	=head3 C<< class >>
540
541	This is an arrayref of class names.
542
543	use Exporter::Almighty -setup => {
544	class => [
545	'HTTP::Tiny',
546	'LWP::UserAgent',
547	],
548	};
549
550	People can import:
551
552	use Your::Package qw( +HTTPTiny +LWPUserAgent );
553
554	unless ( is_HTTPTiny($x) or is_LWPUserAgent($x) ) {
555	$x = HTTPTiny->new();
556	}
557
558	These create L<Type::Tiny::Class> type constraints similar to how C<enum>
559	works. It will similarly promote your exporter to a L<Type::Library>.
560
561	Notice that the C<new> method will be proxied through to the underlying
562	class, so these can also work as useful aliases for long class names.
563
564	use Exporter::Almighty -setup => {
565	class => [
566	'ShortName' => { class => 'Very::Long::Class::Name' },
567	'TinyName' => { class => 'An::Even::Longer::Class::Name' },
568	],
569	};
570
571	Exporter::Almighty will attempt to pre-emptively load modules mentioned here,
572	so you don't need to do it yourself. However if the modules don't exist, it
573	won't complain.
574
575	=head3 C<< role >>
576
577	This works the same as C<class>, except for roles.
578
579	=head3 C<< duck >>
580
581	This is a hashref where keys are "duck type" type names, and the values are
582	arrayrefs of method names.
583
584	use Exporter::Almighty -setup => {
585	duck => [
586	'UserAgent' => [ 'head', 'get', 'post' ],
587	],
588	};
589
590	These create L<Type::Tiny::Duck> type constraints similar to how C<enum>
591	works. It will similarly promote your exporter to be a L<Type::Library>.
592
593	=head3 C<< also >>
594
595	A list of other packages to also export to your caller. Each package name
596	can optionally be followed by an arrayref of import arguments.
597
598	use Exporter::Almighty -setup => {
599	also => [
600	'strict',
601	'Scalar::Util' => [ 'refaddr' ],
602	'warnings',
603	],
604	};
605
606	Your caller isn't given any options allowing them to opt in or out of this,
607	so it is recommended that this be used sparingly. L<strict>, L<warnings>,
608	L<feature>, L<experimental>, and L<namespace::autoclean> are good packages to
609	consider listing here. Packages that export named functions are less good.
610
611	=head2 API
612
613	Instead of:
614
615	package Your::Package;
616	use Exporter::Almighty -setup => \%setup;
617
618	It is possible to do this at run-time:
619
620	Exporter::Almighty->setup_for( 'Your::Package', %setup );
621
622	This may allow slightly more flexibility in some cases.
623
624	Exporter::Almighty is also designed to be easily subclassable.
625
626	=head2 Exporter::Tiny features you get for free
627
628	=head3 Features for you
629
630	Exporter::Almighty will import L<strict> and L<warnings> into your package.
631
632	You can export package variables, though it's rarely a good idea:
633
634	package Your::Package;
635
636	use Exporter::Almighty -setup => {
637	tag => { default => [ 'xxx', '$YYY' ] },
638	};
639
640	our $YYY = 42;
641
642	You can use generators:
643
644	package Your::Package;
645
646	use Exporter::Almighty -setup => {
647	tag => { default => [ 'xxx' ] },
648	};
649
650	sub _generate_xxx {
651	my ( $me, $name, $vals, $opts ) = @_;
652	my $caller = $opts->{into};
653
654	# Return the sub which will be installed into caller as 'xxx'.
655	return sub {
656	};
657	}
658
659	...;
660
661	package main;
662	use Your::Package 'xxx' => \%vals;
663
664	xxx( ... );
665
666	=head3 Features for your caller
667
668	Your caller can do lexical imports:
669
670	use Your::Package -lexical, qw( ... );
671
672	Your caller can rename imported functions:
673
674	use Your::Package foo => { -as => 'foofoo' };
675
676	And everything else described in L<Exporter::Tiny::Manual::Importing>.
677
678	=head1 BUGS
679
680	Please report any bugs to
681	L<https://github.com/tobyink/p5-exporter-almighty/issues>.
682
683	=head1 SEE ALSO
684
685	L<Exporter::Tiny>, L<Exporter::Shiny>.
686
687	L<CXC::Exporter::Util> was an inspiration for this module and the features
688	overlap a bit.
689
690	=head1 AUTHOR
691
692	Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
693
694	=head1 COPYRIGHT AND LICENCE
695
696	This software is copyright (c) 2023 by Toby Inkster.
697
698	This is free software; you can redistribute it and/or modify it under
699	the same terms as the Perl 5 programming language system itself.
700
701	=head1 DISCLAIMER OF WARRANTIES
702
703	THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
704	WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
705	MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
706

tobyink / p5-exporter-almighty / 8abde7f4a

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous