lib/Params/Get.pm

        start → end → jump
        

    1: package Params::Get;
    2: 
    3: use strict;
    4: use warnings;
    5: 
    6: use Carp;
    7: use Devel::Confess;
    8: use Scalar::Util;
    9: 
   10: our @ISA = qw(Exporter);
   11: our @EXPORT_OK = qw(get_params);
   12: 
   13: =head1 NAME
   14: 
   15: Params::Get - Get the parameters to a subroutine in any way you want
   16: 
   17: =head1 VERSION
   18: 
   19: Version 0.14
   20: 
   21: =cut
   22: 
   23: our $VERSION = '0.14';
   24: 
   25: =head1 DESCRIPTION
   26: 
   27: Exports a single function, C<get_params>, which returns a given value.
   28: 
   29: When used hand-in-hand with L<Params::Validate::Strict> and L<Return::Set>,
   30: you should be able to formally specify the input and output sets for a method.
   31: 
   32: =head1 SYNOPSIS
   33: 
   34:     use Params::Get;
   35:     use Params::Validate::Strict;
   36: 
   37:     sub where_am_i
   38:     {
   39:         my $params = Params::Validate::Strict::validate_strict({
   40:             args => Params::Get::get_params(undef, \@_),
   41:             schema => {
   42:                 'latitude' => {
   43:                     type => 'number',
   44:                     min => -90,
   45:                     max => 90
   46:                 }, 'longitude' => {
   47:                     type => 'number',
   48:                     min => -180,
   49:                     max => 180
   50:                 }
   51:             }
   52:         });
   53: 
   54:         print 'You are at ', $params->{'latitude'}, ', ', $params->{'longitude'}, "\n";
   55:     }
   56: 
   57:     where_am_i(latitude => 0.3, longitude => 124);
   58:     where_am_i({ latitude => 3.14, longitude => -155 });
   59: 
   60: =head1	METHODS
   61: 
   62: =head2 get_params
   63: 
   64: Parse the arguments given to a function.
   65: Processes arguments passed to methods and ensures they are in a usable format,
   66: allowing the caller to call the function in any way that they want
   67: e.g. `foo('bar')`, `foo(arg => 'bar')`, `foo({ arg => 'bar' })` all mean the same
   68: when called with
   69: 
   70:     get_params('arg', @_);
   71: 
   72: or
   73: 
   74:     get_params('arg', \@_);
   75: 
   76: Some people like this sort of model, which is also supported.
   77: 
   78:     use MyClass;
   79: 
   80:     my $str = 'hello world';
   81:     my $obj = MyClass->new($str, { type => 'string' });
   82: 
   83:     package MyClass;
   84: 
   85:     use Params::Get;
   86: 
   87:     sub new {
   88:         my $class = shift;
   89:         my $rc = Params::Get::get_params('value', \@_);
   90: 
   91:         return bless $rc, $class;
   92:     }
   93: 
   94: =head2 The C<$default> Parameter
   95: 
   96: The first argument is the C<$default> parameter controls how single-argument calls are interpreted and provides
   97: a default key name for parameter extraction in those cases.
   98: 
   99: When no arguments are provided with a defined C<$default>:
  100: 
  101:     get_params('required'); # Throws usage error
  102: 
  103: The function requires either arguments or an undefined C<$default>.
  104: 
  105: =head3 Usage Examples
  106: 
  107: =over 2
  108: 
  109: =item * Simple scalar parameter:
  110: 
  111:     sub set_country {
  112:         my $params = get_params('country', @_);
  113:         # Accepts: set_country('US')
  114:         # Returns: { country => 'US' }
  115:     }
  116: 
  117: =item * Object constructor with options:
  118: 
  119:     sub new {
  120:         my $class = shift;
  121:         my $params = get_params('value', @_);
  122:         # Accepts: MyClass->new($object)
  123:         # Accepts: MyClass->new($object, { option => 'value' })
  124:         # Returns: { value => $object } or { value => $object, option => 'value' }
  125:     }
  126: 
  127: =item * Hash parameter:
  128: 
  129:     sub configure {
  130:         my $params = get_params('config', @_);
  131:         # Accepts: configure({ db => 'mysql', host => 'localhost' })
  132:         # Returns: { config => { db => 'mysql', host => 'localhost' } }
  133:     }
  134: 
  135: =item * Without default (named parameters only):
  136: 
  137:     sub process {
  138:         my $params = get_params(undef, @_);
  139:         # Accepts: process(name => 'John', age => 30)
  140:         # Returns: { name => 'John', age => 30 }
  141:     }
  142: 
  143: =back
  144: 
  145: =head3 Caveats
  146: 
  147: =over 2
  148: 
  149: =item * When C<$default> is defined and no arguments are provided, an error is thrown
  150: 
  151: =item * There's no way to specify that a default parameter is optional
  152: 
  153: =item * Single hash references always bypass the default parameter naming
  154: 
  155: =back
  156: 
  157: =cut
  158: 
  159: sub get_params
  160: {
  161: 	# Directly return hash reference if the only parameter is a hash reference
●162 → 166 → 170●162 → 166 → 0  162: 	return $_[0] if((scalar(@_) == 1) && (ref($_[0]) eq 'HASH'));	# Note - doesn't check if "default" was given
  Mutants (Total: 3, Killed: 3, Survived: 0)
  163: 
  164: 	my $default = shift;
  165: 
  166: 	if(ref($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  167: 		Carp::croak(__PACKAGE__, '::get_params: $default must be a scalar');
  168: 	}
  169: 
●170 → 172 → 186●170 → 172 → 0  170: 	my $args;
  171: 	my $array_ref;
  172: 	if((scalar(@_) == 1) && (ref($_[0]) eq 'ARRAY')) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  173: 		if($default && (scalar(@{$_[0]}) == 2) && (@{$_[0]}[0] eq $default) && (!ref(@{$_[0]}[1]))) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  174: 			# in main:
  175: 			#	routine('country' => 'US');
  176: 			# in routine():
  177: 			#	$params = Params::Get::get_params('country', \@);
  178: 			return { $default => @{$_[0]}[1] };
  179: 		}
  180: 		$args = $_[0];
  181: 		$array_ref = 1;
  182: 	} else {
  183: 		$args = \@_;
  184: 	}
  185: 
●186 → 189 → 229●186 → 189 → 0  186: 	my $num_args = scalar(@{$args});
  187: 
  188: 	# Populate %rc based on the number and type of arguments
  189: 	if($num_args == 1) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  190: 		if(defined($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  191: 			if(!ref($args->[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  192: 				# %rc = ($default => shift);
  193: 				return { $default => $args->[0] };
  194: 			}
  195: 			if(ref($args->[0]) eq 'ARRAY') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  196: 				return { $default => $args->[0] };
  197: 			}
  198: 			if(ref($args->[0]) eq 'SCALAR') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  199: 				return { $default => ${$args->[0]} };
  200: 			}
  201: 			if(ref($args->[0]) eq 'CODE') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  202: 				return { $default => $args->[0] };
  203: 			}
  204: 			if(Scalar::Util::blessed($args->[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  205: 				return { $default => $args->[0] };
  206: 			}
  207: 		}
  208: 		if(!defined($args->[0])) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  209: 			return;
  210: 		}
  211: 		if(ref($args->[0]) eq 'REF') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  212: 			$args->[0] = ${$args->[0]};
  213: 		}
  214: 		if(ref($args->[0]) eq 'HASH') {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  215: 			return $args->[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
  216: 		}
  217: 		if((ref($args->[0]) eq 'ARRAY') && (scalar(@{$args->[0]}) == 0)) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  218: 			# in main:
  219: 			#	routine('countries' => []);
  220: 			# in routine():
  221: 			#	$params = Params::Get::get_params('countries', \@);
  222: 			if(defined($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  223: 				return { $default => [] }
  224: 			}
  225: 			return $args->[0];
  Mutants (Total: 2, Killed: 2, Survived: 0)
  226: 		}
  227: 		Carp::croak('Usage: ', __PACKAGE__, '->', (caller(1))[3], '()');
  228: 	}
●229 → 229 → 241●229 → 229 → 0  229: 	if($num_args == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  230: 		if(defined($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  231: 			# if(defined($_[0]) && (ref($_[0]) eq 'ARRAY')) {
  232: 				# FIXME
  233: 				# return { $default => [] };
  234: 			# }
  235: 			# FIXME: No means to say that the default is optional
  236: 			# Carp::croak('Usage: ', __PACKAGE__, '->', (caller(1))[3], "($default => \$val)");
  237: 			Carp::croak(Devel::Confess::longmess("Usage: ", __PACKAGE__, '->', (caller(1))[3], "($default => \$val)"));
  238: 		}
  239: 		return;
  240: 	}
●241 → 241 → 258●241 → 241 → 0  241: 	if(($num_args == 2) && (ref($args->[1]) eq 'HASH')) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  242: 		if(defined($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  243: 			if(scalar keys %{$args->[1]}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  244: 				if($args->[0] eq $default) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  245: 					return { $default => $args->[1] };
  246: 				}
  247: 				# Obj->new('foo', { 'key1' => 'val1' } - set foo to the mandatory first argument, and the rest are options
  248: 				return {
  249: 					$default => $args->[0],
  250: 					%{$args->[1]}
  251: 				};
  252: 			}
  253: 			# Obj->new(foo => {}) - set foo to be an empty hash
  254: 			return { $default => $args->[1] }
  255: 		}
  256: 	}
  257: 
●258 → 258 → 261●258 → 258 → 0  258: 	if($array_ref && defined($default)) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  259: 		return { $default => $args };
  260: 	}
●261 → 261 → 266●261 → 261 → 0  261: 	if(($num_args % 2) == 0) {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  262: 		my %rc = @{$args};
  263: 		return \%rc;
  264: 	}
  265: 
●[NOT COVERED] 266 → 266 → 0  266: 	Carp::croak('Usage: ', __PACKAGE__, '->', (caller(1))[3], '()');
  267: }
  268: 
  269: =head1 AUTHOR
  270: 
  271: Nigel Horne, C<< <njh at nigelhorne.com> >>
  272: 
  273: =head1 BUGS
  274: 
  275: Sometimes giving an array ref rather than array fails.
  276: 
  277: =head1 SEE ALSO
  278: 
  279: =over 4
  280: 
  281: =item * L<Params::Smart>
  282: 
  283: =item * L<Params::Validate::Strict>
  284: 
  285: =item * L<Return::Set>
  286: 
  287: =item * L<Test Dashboard|https://nigelhorne.github.io/Params-Get/coverage/>
  288: 
  289: =back
  290: 
  291: =head1 SUPPORT
  292: 
  293: This module is provided as-is without any warranty.
  294: 
  295: Please report any bugs or feature requests to C<bug-params-get at rt.cpan.org>,
  296: or through the web interface at
  297: L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Params-Get>.
  298: I will be notified, and then you'll
  299: automatically be notified of progress on your bug as I make changes.
  300: 
  301: You can find documentation for this module with the perldoc command.
  302: 
  303:     perldoc Params::Get
  304: 
  305: You can also look for information at:
  306: 
  307: =over 4
  308: 
  309: =item * MetaCPAN
  310: 
  311: L<https://metacpan.org/dist/Params-Get>
  312: 
  313: =item * RT: CPAN's request tracker
  314: 
  315: L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Params-Get>
  316: 
  317: =item * CPAN Testers' Matrix
  318: 
  319: L<http://matrix.cpantesters.org/?dist=Params-Get>
  320: 
  321: =item * CPAN Testers Dependencies
  322: 
  323: L<http://deps.cpantesters.org/?module=Params::Get>
  324: 
  325: =back
  326: 
  327: =head1 LICENCE AND COPYRIGHT
  328: 
  329: Copyright 2025-2026 Nigel Horne.
  330: 
  331: Usage is subject to the GPL2 licence terms.
  332: If you use it,
  333: please let me know.
  334: 
  335: =cut
  336: 
  337: 1;