File Coverage

blib/lib/Params/Dry.pm

Criterion	Covered	Total	%
statement	84	109	77.0
branch	9	30	30.0
condition	1	14	7.1
subroutine	26	27	96.3
pod	4	4	100.0
total	124	184	67.3

#* Name: Params::Dry
#* Info: Simple Global Params Management System
#* Author: Pawel Guspiel (neo77)
#*
#* First. If you can use any function as in natural languague - you will use and understand it even after few months.
#*
#* Second. Your lazy life will be easy, and you will reduce a lot of errors if you will have guarancy that your parameter
#*   for example ,,client'', in whole project means the same ( ex. is defined as string(32) ).
#*
#* Third. You are lazy, so to have this guarancy, you want to set it, in one and only in one place.
#*
#* Yes, DRY principle in its pure form!
#*
#* So all what you can find in this module.
#*
#* That's all. Easy to use. Easy to manage. Easy to understand.
#*
#* Additional informations
#* 1. I didn't wrote here any special extensions (callbacks, ordered parameter list, evals etc). Params module has to be fast.
#* If there will be any extension in future. It will be in separate module.
#* 2. Ordered parameters list or named parameter list? Named parameter list. For sure.
#* Majority of the time you are spending on READING code, not writing it. So for sure named parameter list is better.
#*

package Params::Dry;
{

    use strict;
    use warnings;

    use 5.10.0;

# --- version ---
    our $VERSION = 1.20_03;

#=------------------------------------------------------------------------ { use, constants }

    use Carp;    # confess

    use Params::Dry::Types;              # to mark that will reserving this namespace (build in types)
    use Params::Dry::Types;              # to mark that will reserving this namespace (build in types)
    use Params::Dry::Types::String;      # string extended types
    use Params::Dry::Types::Object;      # object extended types
    use Params::Dry::Types::DateTime;    # datetime extended types
    use Params::Dry::Types::Number;      # number extended types
    use Params::Dry::Types::Ref;         # ref extended types

    use constant DEFAULT_TYPE => 1;      # default check (for param_op)
    use constant TRUE         => 1;      # true
    use constant FALSE        => 0;      # and false
    use constant OK           => TRUE;   # true
    use constant NO           => FALSE;  # false

    our $Debug = FALSE;                  # use Debug mode or not

#=------------------------------------------------------------------------ { export }

# import strict params

    use parent 'Exporter';

    our @EXPORT_OK = qw(__ rq op tdef typedef no_more DEFAULT_TYPE param_rq param_op);

    our %EXPORT_TAGS = (
                         shorten => [qw(__ rq op tdef no_more DEFAULT_TYPE)],
                         short   => [qw(__ rq op typedef no_more DEFAULT_TYPE)],
                         long    => [qw(__ param_rq param_op typedef no_more DEFAULT_TYPE)]
    );

#=------------------------------------------------------------------------ { module private functions }

    #=---------
    #  _error
    #=---------
    #* printing error message
    # RETURN: dies (in case of Debug is making confess)
    sub _error {
        my ( $package, $filename, $line, $subroutine, $evaltext ) = ( caller( 1 ) )[ 0 .. 3, 6 ];

        my $message = ' at ' . ( $subroutine || $evaltext || 'no sub' ) . " line $line\n";
        my $debug = "\nvim $filename +$line\n\n";

        ( $Params::Dry::Debug ) ? confess( @_, $message, $debug ) : die( @_, $message );
    } #+ end of: sub _error

    #=-----------------------
    #  __get_effective_type
    #=-----------------------
    #* counts effective type of type (ex. for super_client base type is client and for client base type is String[20]
    #* so for super_client final type will be String[20])
    #* RETURN: final type string
    sub __get_effective_type {
        my $param_type = $Params::Dry::Internal::typedefs{ "$_[0]" };

        if ( $param_type ) {

            my @effective_params_list = map { split /\s*\|\s*/, __get_effective_type( $_ ) } split /\s*\|\s*/, $param_type;

            return join '|', sort keys %{ { map { $_ => 1 } @effective_params_list } };

        } else {
            return $_[0];
        } #+ end of: else [ if ( $param_type ) ]

    } #+ end of: sub __get_effective_type

    #=--------------------
    #  __check_parameter
    #=--------------------
    #* checks validity of the parameter
    #* RETURN: param value
    sub __check_parameter {
        my ( $p_name, $p_type, $p_default, $p_is_required ) = @_;

        # --- check internal syntax ---
        _error( "Name of the parameter has to be defined" ) unless $p_name;

        # --- detect type (set explicite or get it from name?)
        my $counted_param_type = ( !defined( $p_type ) or ( $p_type =~ /^\d+$/ and $p_type == DEFAULT_TYPE ) ) ? $p_name : $p_type;

        # --- check effective parameter definition
        my $effective_param_type = __get_effective_type( $counted_param_type );

        # --- check effective parameter definition for used name (if exists) and if user is not trying to replace name-type with new one (to keep clean naminigs)
        if ( $Params::Dry::Internal::typedefs{ "$p_name" } ) {
            my $effective_name_type = __get_effective_type( $p_name );
            _error( "This variable $p_name is used before in code as $p_name type ($effective_name_type) and here you are trying to redefine it to $counted_param_type ($effective_param_type)" )
                if $effective_name_type ne $effective_param_type;
        } #+ end of: if ( $Params::Dry::Internal::typedefs...)

        # --- getting final parameter value ---
        my $param_value = ( $Params::Dry::Internal::current_params->{ "$p_name" } ) // $p_default // undef;

        # --- required / optional
        if ( !defined( $param_value ) ) {
            ( $p_is_required ) ? _error( "Parameter '$p_name' is required)" ) : return;
        } #+ end of: if ( !defined( $param_value...))

        my @check_functions = ();

        # --- prepare all check functions names and its parameters
        for my $effective_param_type ( split /\s*\|\s*/, $effective_param_type ) {

            # --- get package, function and parameters
            my ( $type_package, $type_function, $parameters ) = $effective_param_type =~ /^(?:(.+)::)?([^\[]+)(?:\[(.+?)\])?/;

            my $final_type_package = ( $type_package ) ? 'Params::Dry::Types::' . $type_package : 'Params::Dry::Types';

            my @type_parameters = split /\s*,\s*/, $parameters // '';

            # --- set default type unless type ---
            _error( "Type $counted_param_type ($effective_param_type) is not defined" ) unless $final_type_package->can( "$type_function" );

            push @check_functions, { check_function => $final_type_package . '::' . $type_function, type_parameters => \@type_parameters };
        } #+ end of: for my $effective_param_type...

        # --- check if is valid
        my $is_valid = NO;
        for my $check_function_hash ( @check_functions ) {
            my $check_function = $check_function_hash->{ 'check_function' };
            my $type_parameters = $check_function_hash->{ 'type_parameters' } || [];
            {
                no strict 'refs';
                &$check_function( $param_value, @$type_parameters ) and $is_valid = TRUE;
            }
        } #+ end of: for my $check_function_hash...
        _error( "Parameter '$p_name' is not '$counted_param_type' type (effective: $effective_param_type)" ) unless $is_valid;

        $param_value;
    } #+ end of: sub __check_parameter

#=------------------------------------------------------------------------ { module public functions }

    #=-----
    #  rq
    #=-----
    #* check if required parameter exists, if yes check it, if not report error
    #* RETURN: param value
    sub rq($;$$) {
        my ( $p_name, $p_type, $p_default ) = @_;

        return __check_parameter( $p_name, $p_type, $p_default, TRUE );
    } #+ end of: sub rq($;$$)

    #=-----
    #  op
    #=-----
    #* check if required parameter exists, if yes check it, if not return undef
    #* RETURN: param value
    sub op($;$$) {
        my ( $p_name, $p_type, $p_default ) = @_;

        return __check_parameter( $p_name, $p_type, $p_default, FALSE );
    } #+ end of: sub op($;$$)

    #=------
    # tdef
    #=------
    #* make relation between name and definition, which can be used to check param types
    #* RETURN: name of the type
    sub tdef($$) {
        my ( $p_name, $p_definition ) = @_;

        if ( exists $Params::Dry::Internal::typedefs{ $p_name } ) {
            _error( "Error parameter $p_name already defined as $p_definition" )
                if __get_effective_type( $Params::Dry::Internal::typedefs{ $p_name } ) ne __get_effective_type( $p_definition );
        } #+ end of: if ( exists $Params::Dry::Internal::typedefs...)

        # --- just add new definition
        $Params::Dry::Internal::typedefs{ $p_name } = $p_definition;

        return $p_name;

    } #+ end of: sub tdef($$)

    #=-----
    #  __
    #=-----
    #* gets the parameters to internal use
    # RETURN: first param if params like (object, %params) or undef otherwise
    sub __ {
        my $self = ( ( scalar @_ % 2 ) ? shift : undef );
        push @Params::Dry::Internal::params_stack, { @_ };
        $Params::Dry::Internal::current_params = $Params::Dry::Internal::params_stack[-1];

        return $self;
    } #+ end of: sub __

    #=----------
    #  no_more
    #=----------
    #* mark end of param processing part
    #* required in case param call during param checking
    # RETURN: current params
    sub no_more() {

        pop @Params::Dry::Internal::params_stack;
        $Params::Dry::Internal::current_params = $Params::Dry::Internal::params_stack[-1];
    } #+ end of: sub no_more

# --- add additional names for funtions (long)

    {
        no warnings 'once';

        *param_rq = *rq;
        *param_op = *op;
        *typedef  = *tdef;
    };
};
0115 && 0x4d;

# ABSTRACT: Simple Global Params Management System

#+ End of Params::Dry
__END__