File Coverage

blib/lib/Module/Spec/V1.pm

Criterion	Covered	Total	%
statement	35	62	56.4
branch	19	42	45.2
condition	2	14	14.2
subroutine	7	13	53.8
pod	3	5	60.0
total	66	136	48.5

package Module::Spec::V1;
$Module::Spec::V1::VERSION = '0.8.0';
# ABSTRACT: Load modules based on V1 specifications
use 5.012;

# use warnings;

our @EXPORT_OK = qw(need_module try_module);

BEGIN {
    require Module::Spec::V0;
    *_generate_code  = \&Module::Spec::V0::_generate_code;
    *_opts           = \&Module::Spec::V0::_opts;
    *_need_module    = \&Module::Spec::V0::_need_module;
    *_require_module = \&Module::Spec::V0::_require_module;
    *_try_module     = \&Module::Spec::V0::_try_module;
    *croak           = \&Module::Spec::V0::croak;
}

state $MODULE_RE  = qr/ [^\W\d]\w*+ (?: :: \w++ )*+ /x;
state $VERSION_RE = qr/ v?+ (?>\d+) (?: [\._] \d+ )*+ /x;

sub parse_module_spec {
    my $spec = pop;
    if ( my ( $m, @v ) = _parse_module_spec($spec) ) {
        my %info = ( module => $m );
        $info{version} = $v[0] if @v;
        return \%info;
    }
    return;
}

sub _parse_module_spec {
    if ( $_[0] =~ m/\A $MODULE_RE \z/x ) {
        return $_[0];
    }
    elsif ( ref $_[0] eq 'ARRAY' ) {

        croak(qq{Should contain one or two entries})
          unless @{ $_[0] } && @{ $_[0] } <= 2;
        my $m = $_[0][0];
        $m =~ m/\A $MODULE_RE \z/x
          or croak(qq{Can't parse $m});
        return ($m) if @{ $_[0] } == 1;
        my $v = $_[0][1];
        return ( $m, _parse_version_spec($v) );
    }
    elsif ( ref $_[0] eq 'HASH' ) {

        croak(qq{Should contain a single pair}) unless keys %{ $_[0] } == 1;
        my ( $m, $v ) = %{ $_[0] };
        $m =~ m/\A $MODULE_RE \z/x
          or croak(qq{Can't parse $m});
        return ( $m, _parse_version_spec($v) );
    }
    return;
}

sub _parse_v_spec { $_[0] eq '0' ? () : ( $_[0] ) }

sub _parse_version_spec {    # Extra sanity check
    unless ( defined $_[0] && $_[0] =~ m/\A $VERSION_RE \z/x ) {
        croak(qq{Invalid version $_[0]});
    }
    goto &_parse_v_spec;
}

# Precomputed for most common case
state $_OPTS = _opts();

# need_module($spec)
# need_module($spec, \%opts)
sub need_module {
    my $opts = @_ > 1 ? _opts(pop) : $_OPTS;

    my ( $m, @v ) = _parse_module_spec( $_[-1] )
      or croak(qq{Can't parse $_[-1]});
    return _need_module( $opts, $m, @v );
}

# generate_code($spec, \%opts);
sub generate_code {
    my $opts = @_ > 1 ? pop : {};

    my ( $m, @v ) = _parse_module_spec( $_[-1] )
      or croak(qq(Can't parse $_[-1]}));
    return _generate_code( $opts, $m, @v );
}

# try_module($spec)
# try_module($spec, \%opts)
sub try_module {
    my $opts = @_ > 1 ? _opts(pop) : $_OPTS;

    my ( $m, @v ) = _parse_module_spec( $_[-1] )
      or croak(qq{Can't parse $_[-1]});
    return _try_module( $opts, $m, @v );
}

sub need_modules {
    my $op = $_[0] =~ /\A-/ ? shift : '-all';
    state $SUB_FOR = {
        '-all'   => \&_need_all_modules,
        '-any'   => \&_need_any_modules,
        '-oneof' => \&_need_first_module,
    };
    croak(qq{Unknown operator "$op"}) unless my $sub = $SUB_FOR->{$op};
    if ( @_ == 1 && ref $_[0] eq 'HASH' ) {
        @_ = map { [ $_ => $_[0]{$_} ] } keys %{ $_[0] };
    }
    goto &$sub;
}

sub _need_all_modules {
    map { scalar need_module($_) } @_;
}

sub _need_any_modules {
    my ( @m, $m );
    ( $m = try_module($_) ) && push @m, $m for @_;
    return @m;
}

sub _need_first_module {
    my $m;
    ( $m = try_module($_) ) && return ($m) for @_;
    return;
}

1;

#pod =encoding utf8
#pod
#pod =head1 SYNOPSIS
#pod
#pod     use Module::Spec::V1 ();
#pod     Module::Spec::V1::need_module('Mango');
#pod     Module::Spec::V1::need_module( [ 'Mango' => '2.3' ] );
#pod     Module::Spec::V1::need_module( { 'Mango' => '2.3' } );
#pod
#pod =head1 DESCRIPTION
#pod
#pod B
#pod
#pod =head2 MODULE SPECS
#pod
#pod As string
#pod
#pod     M               any version
#pod
#pod As a hash ref
#pod
#pod     { M => V }      minimum match, ≥ V
#pod     { M => '0' }    accepts any version
#pod
#pod As an array ref
#pod
#pod     [ M ]
#pod     [ M => V ]      minimum match, ≥ V
#pod     [ M => '0' ]    same as [ M ], accepts any version
#pod
#pod =head1 FUNCTIONS
#pod
#pod L implements the following functions.
#pod
#pod =head2 need_module
#pod
#pod     $module = need_module('SomeModule');
#pod     $module = need_module( { 'SomeModule' => '2.3' } );
#pod     $module = need_module( [ 'SomeModule' => '2.3' ] );
#pod
#pod     $module = need_module($spec);
#pod     $module = need_module( $spec, \%opts );
#pod
#pod Loads a module and checks for a version requirement (if any).
#pod Returns the name of the loaded module.
#pod
#pod On list context, returns the name of the loaded module
#pod and its version (as reported by C<< $m->VERSION >>).
#pod
#pod     ( $m, $v ) = need_module($spec);
#pod     ( $m, $v ) = need_module( $spec, \%opts );
#pod
#pod These options are currently available:
#pod
#pod =over 4
#pod
#pod =item require
#pod
#pod     require => 1    # default
#pod     require => 0
#pod     require => sub { my ($m, @v) = @_; ... }
#pod
#pod Controls whether the specified module should be Cd or not.
#pod It can be given as a non-subroutine value, which gets
#pod interpreted as a boolean: true means that the module
#pod should be loaded with C and false means
#pod that no attempt should be made to load it.
#pod This option can also be specified as a subroutine which gets
#pod passed the module name and version requirement (if any)
#pod and which should return true if the module should be loaded
#pod with C or false otherwise.
#pod
#pod =back
#pod
#pod =head2 need_modules
#pod
#pod     @modules = need_modules(@spec);
#pod     @modules = need_modules(-all => @spec);
#pod     @modules = need_modules(-any => @spec);
#pod     @modules = need_modules(-oneof => @spec);
#pod
#pod     @modules = need_modules(\%spec);
#pod     @modules = need_modules(-all => \%spec);
#pod     @modules = need_modules(-any => \%spec);
#pod     @modules = need_modules(-oneof => \%spec);
#pod
#pod Loads some modules according to a specified rule.
#pod
#pod The current supported rules are C<-all>, C<-any> and C<-oneof>.
#pod If none of these are given as the first argument,
#pod C<-all> is assumed.
#pod
#pod The specified modules are given as module specs,
#pod either as a  list or as a single hashref.
#pod If given as a list, the corresponding order will be respected.
#pod If given as a hashref, a random order is to be expected.
#pod
#pod The behavior of the rules are as follows:
#pod
#pod =over 4
#pod
#pod =item -all
#pod
#pod All specified modules are loaded by C.
#pod If successful, returns the names of the loaded modules.
#pod
#pod =item -any
#pod
#pod All specified modules are loaded by C.
#pod Returns the names of the modules successfully loaded.
#pod
#pod =item -oneof
#pod
#pod Specified modules are loaded by C
#pod until a successful load.
#pod Returns (in list context) the name of the loaded module.
#pod
#pod =back
#pod
#pod =head2 try_module
#pod
#pod     $module = try_module('SomeModule');
#pod     $module = try_module( { 'SomeModule' => '2.3' } );
#pod     $module = try_module( [ 'SomeModule' => '2.3' ] );
#pod
#pod     $module = try_module($spec);
#pod     $module = try_module( $spec, \%opts );
#pod
#pod Tries to load a module (if available) and checks for a version
#pod requirement (if any). Returns the name of the loaded module
#pod if it can be loaded successfully and satisfies any specified version
#pod requirement.
#pod
#pod On list context, returns the name of the loaded module
#pod and its version (as reported by C<< $m->VERSION >>).
#pod
#pod     ( $m, $v ) = try_module($spec);
#pod     ( $m, $v ) = try_module($spec, \%opts);
#pod
#pod These options are currently available:
#pod
#pod =over 4
#pod
#pod =item require
#pod
#pod     require => 1    # default
#pod     require => 0
#pod     require => sub { my ($m, @v) = @_; ... }
#pod
#pod Controls whether the specified module should be Cd or not.
#pod It can be given as a non-subroutine value, which gets
#pod interpreted as a boolean: true means that the module
#pod should be loaded with C and false means
#pod that no attempt should be made to load it.
#pod This option can also be specified as a subroutine which gets
#pod passed the module name and version requirement (if any)
#pod and which should return true if the module should be loaded
#pod with C or false otherwise.
#pod
#pod =back
#pod
#pod =head1 CAVEATS
#pod
#pod =over 4
#pod
#pod =item *
#pod
#pod Single quotes (C<'>) are not accepted as package separators.
#pod
#pod =item *
#pod
#pod Exceptions are not thrown from the perspective of the caller.
#pod
#pod =back
#pod
#pod =head1 SEE ALSO
#pod
#pod L
#pod
#pod =cut

__END__