Params::Smart - use both positional and named arguments in a subroutine

Params-Smart documentation Contained in the Params-Smart distribution.

Index

Code Index:

NAME

Top

Params::Smart - use both positional and named arguments in a subroutine

SYNOPSIS

Top

  use Params::Smart 0.04;

  sub my_sub {
    %args = Params(qw( foo bar ?bo ?baz ))->args(@_);
    ...
  }

  my_sub( foo=> 1, bar=>2, bo=>3 );  # call with named arguments

  my_sub(1, 2, 3);                   # same, with positional args

DESCRIPTION

Top

This module provides "smart" parameter handling for subroutines without having to use a changed syntax or source filters. Features include:

Usage is as follows:

  sub my_sub {
    %vals = Params( @template )->args( @args );
    ...
  }

The @template specifies the names of parameters in the order that they should be given in subroutine calls, and @args is the list of argument to be parsed: usually you just specify the void list @_.

The keys in the returned hash %vals are assigned to the appropriate arguments, irrespective of calling style.

Names may be called with an optional initial dash, as with Getargs::Mixed:

  my_sub( -first => 1, -second => 2 );

Smart parameters can be used for method calls:

  sub my_method {
    my $self = shift;
    %vals = Params( @template )->args( @args );
    ...
  }

The values may also contain additional keys which begin with an underscore. These are internal/diagnostic values:

_named

True if the parameters were treated as named, false if positional. See CAVEATS below.

To improve performance, Params memoizes parameter templates when they are parsed, based on where the call to Params was made.

This may be problematic if templates are changed dynamically. To override memoization, use ParamsNC function:

  %vals = ParamsNC( @template )->args( @_ );

There are two styles of templates, Simple Parameter Templates with a Perl6-like syntax, and Complex Parameter Templates which allow more options to be specified using hashes.

Simple Parameter Templates

Simple parameter templates contain a list of key names in the order that they are expected for positional calls:

  sub my_sub {
    %vals = Params(qw( first second third ))->args(@_);
     ...
  }

Calling the subroutine with the following

  my_sub(1, 2, 3);

sets the values

  %vals = (
    first  => 1,
    second => 2,
    third  => 3
  );

Parameters are required by default. To make a parameter optional, add a question mark before it:

  %vals = Params(qw( first second ?third ))->args(@_);

Note that no required parameters may follow an optional parameter.

If one wants to "slurp" all remaining arguments into one value, add an asterisk before it:

  %vals = Params(qw( first *second ))->args(@_);

So the above example call would set the values

  %vals = (
    first  => 1,
    second => [ 2, 3 ]
  );

Note that the slurp argument is required unless it also includes a question-mark:

  %vals = Params(qw( first *?second ))->args(@_);

You can also mark options as being allowed when called with named parameters only by adding a plus sign before them:

  %vals = Params(qw( common +?obscure +?strange +?weird ))->args(@_);

This is useful when there are many options which are rarely needed (and too awkward to use in positional calling), or may have dangerous side effects if accidentally specified with a positional calling style. (The order of named-only parameters does not matter.)

You can also enforce named-only calling conventions on a subroutine by omitting question-marks from at least one parameter:

  %vals = Params(qw( +first +second ))->args(@_);

As of version 0.04, default values can also be specified:

  %vals = Params(qw( first=1 second=2 ))->args(@_);

Defaults can be delimited with quotes:

  %vals = Params( 'first="some string"' ))->args(@_);

You can also specify aliases by separating them with a vertical bar:

  %vals = Params(qw( hour|hh minute|min|mm seconds|sec|ss ))->args(@_);

All named parameter calls using aliases will be stored using the first name.

In general use of aliases are not recommended for subroutines. (This feature is a hook for implementing script-wide "getopts"-like functions.)

Complex Parameter Templates

You may use more complex templates if you need to specify additional information, such as callbacks:

  %vals = Params(
    {
      name     => "first",
      required => 1,
      callback => sub { ... },
      comment  => "first parameter",
    },
    {
      name     => "next",
      slurp    => 1,
      comment  => "second parameter",
    },
  )->args(@_);

Each parameter is specified by a hash reference with the following keys:

name

The name of the parameter. May include aliases, separated by vertical bars.

required

The parameter is required if true.

default

A default value of the parameter.

slurp

This parameter slurps the remaining arguments if true. The parameter will be an array reference.

name_only

This parameter may be specified using named-calls only if true.

needs

This parameter needs these other parameters to be specified (either as a list reference, or a string for a single required parameter).

type

Not yet implemented. Use the callback to validate the value.

callback

An optional callback which validates and coerces the parameter. The callback is passed the parameter-parsing object, the name of the parameter, and the value:

  callback => sub {
    my ($self, $name, $value) = @_;
    ...
    return $value;
  },

The $name is the primary name for the parameter, and not any aliases which might have been used.

It is expected to return the coerced value, or die if there is a problem:

  callback => sub {
    my ($self, $name, $value, $hashref) = @_;
    die "$name must be >= 0"
      if ($value < 0);
    return $value || 1;
  },

Callbacks can also update the acceptable parameters:

  callback => sub {
    my ($self, $name, $value, $hashref) = @_;
    if ($value eq "zip") {
      $self->set_param( {
        name    => "compression_level",
        default => 6,
      } );
    }
    return $value;
  },

One can use this to change or add new named parameters based on the values of existing parameters. However, one should use ParamsNC so that the modified template is not cached.

In many cases you should use the needs option and avoid dynamically updating the parameters.

Note that dynamically-added parameters cannot dynamically add other parameters (at least not in this version).

The $hashref is a reference to the values being returned. One may not be able to rely on a specific parameter being set before the callback is executed, however.

Note that the order that callbacks are called is not determined, so do not rely on one callback being called before another.

Do not call any internal methods aside from those documented here, as they do not have a defined behavior and may change in future versions.

comment

An optional comment describing the field. This is currently unused but may be displayed in error messages in future versions.

Compatability with Previous Versions

Note that the formatting for simple parameter templates has changed since version 0.03, and the complex parameter templates were not implemented until version 0.04, so it is best to specify a minimum version in use statements

  use Params::Smart 0.04;

CAVEATS

Top

Because Perl5 treats hashes as lists, this module attempts to interpret the arguments as a hash of named parameters first. If some hash keys match, and some do not, then it assumes there has been an error. If no keys match, then it assumes that it the arguments are positional.

In theory one can pass positional arguments where every other argument matches a hash key, or one can pass a hash with the wrong keys (possible if one copies/pastes code from the wrong call) and so it is treated as a positional argument.

This is probably uncommon for most data, but subroutines should take extra care to check if values are within allowed ranges. There may even be security issues if users can blindly specify data that they know can cause this confusion. If the application is critical enough, then this may not be an appropriate module to use (at least not until the ability to distinguish between lists and hashes is improved).

To diagnose potential bugs, or to enforce named or positional calling one can check the _named parameter.

A future version might make use of Perl internals to get around this problem.

SEE ALSO

Top

This module is superficially similar in function to Getargs::Mixed but does not require named parameters to have an initial dash ('-').

Class::NamedParams provides a framework for implementing named parameters in classes.

Sub::NamedParams will create a named-parameter wrapper around subroutines which use positional parameters.

The syntax of the parameter templates is inspired by Perl6::Subs, though not necessarily compatible. (See also Apocalypse 6 in Perl6::Bible).

Sub::Usage inspired the error-messages returned by calls to arg().

Params::Validate is useful for (additional) parameter validation beyond what this module is capable of.

Class::ParmList provides a framework for parameter validation as well.

AUTHOR

Top

Robert Rothenberg <rrwo at cpan.org>

Suggestions and Bug Reporting

Feedback is always welcome. Please use the CPAN Request Tracker at http://rt.cpan.org to submit bug reports.

LICENSE

Top

Copyright (c) 2005-2007 Robert Rothenberg. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Params-Smart documentation Contained in the Params-Smart distribution. 
package Params::Smart;

use 5.006;
use strict;
use warnings; # ::register __PACKAGE__;

use Carp;
use Regexp::Common qw( delimited );

require Exporter;

our @ISA         = qw( Exporter );
our @EXPORT      = qw( Params );
our @EXPORT_OK   = qw( Params ParamsNC );
our %EXPORT_TAGS = ( all => \@EXPORT_OK ); 

our $VERSION = '0.08';

sub parse_param {
  my $self  = shift;
  my $param = shift;

  local ($_);
  if (ref($param) eq "HASH") {
    # we only want to pass supported parameters
    my $info = {
      _parsed => 0,
    };
    foreach (qw( 
         name type default required name_only slurp
         callback comment needs
     )) {
      $info->{$_} = $param->{$_};
    }
    return $info;
  } elsif (!ref($param)) {
    $param =~ /^([\?\+\*]+)?([\@\$\%\&])?([\w\|]+)(\=.+)?/;
    my $mod  = $1 || "";
    my $type = $2;
    my $name = $3;
    my $def  = substr($4,1) if (defined $4);

    if ((defined $def) &&
	($def =~ /$RE{quoted}{-keep}/)) {
      $def = $3;
    }

    unless (defined $name) {
      croak "malformed parameter $param";
    }
    if ($name =~ /^\_\w+/) {
      croak "parameter $name cannot begin with an underscore";
    }

    if (exists $self->{names}->{$name}) {
      croak "parameter $name already specified";
    }
    else {
      my $info = {
        name      => $name,
        type      => $type,
        default   => $def,
        required  => (($mod !~ /\?/) || 0),
        name_only => (($mod =~ /\+/) || 0),
	slurp     => (($mod =~ /\*/) || 0),
        callback  => undef, # sub { return $_[2]; },
        comment   => $name,
        needs     => undef,
        _parsed   => 1,
      };
      return $info;
    }
  } else {
    croak "invalid parameter";
  }
  return;
}

sub set_param {
  my $self = shift;
  my $info = shift;
  croak "invalid parameter" unless (ref($info) eq "HASH");

  # TODO - name_only should be set if this is dynamic

  $self->{dynamic}   ||= ($self->{lock});
  $info->{name_only} ||= ($self->{dynamic});

  my @names = split /\|/, $info->{name};
  $info->{name} = undef;

  do {
    my $name = shift @names;
    $info->{name} = $name, unless (defined $info->{name});
    if (exists $self->{names}->{$name}) {
      $self->{names}->{$name} = $info;
    }
    else {
      my $index = scalar(@{$self->{order}});
      unless ($info->{name_only}) {
        $info->{_index} = $index;
        $self->{order}->[$index] = $name;
      }
      $self->{names}->{$name} = $info;
    }
    if (@names) {
      $info->{name_only} ||= 1;
      $info->{required}    = 0;
      delete $info->{default};
    }
  } while (@names);
  return $info;
}

sub new {
  my $class = shift;
  my $self  = {
    names   => { },
    order   => [ ],
    lock    => 0,
    dynamic => 0,
  };
  bless $self, $class;

  my $index = 0;
  my $last;
 SLURP: while (my $param = shift) {

    my $info = $self->parse_param($param);
    if ($info) {
      if ($info->{slurp}) {
	croak "no parameters can follow a slurp" if (@_);
      }
      if ($last && $info->{required} && (!$last->{required})) {
	croak "a required parameter cannot follow an optional parameter";
      }
      if ($info->{name_only} && $info->{slurp}) {
	croak "a parameter cannot be named_only and a slurp";
      }
      if ($last && ($info->{_parsed} != $last->{_parsed})) {
        croak "cannot mix parsed and non-parsed parameters";
      }
      $self->set_param($info);
      $last = $info;
    }
    else {
      croak "unknown error";
    }
    $index++;
  }

  $self->{lock} = 1;
  return $self;
}

# We have the exported Params() function rather than requiring calls
# to Params::Smart->new() so that the code looks a lot cleaner.  It's
# also a wrapper for a home-grown memoization function. (We cannot use
# Memoize because callbacks become problematic.)

my %Memoization = ( );

sub Params {
  my $key = join $;, map { $_||""} (caller);
  return  $Memoization{$key} ||= __PACKAGE__->new(@_);
}

sub ParamsNC {
  return __PACKAGE__->new(@_);
}

# Note: usage does not display aliases, nor named_only parameters

sub _usage {
  my $self  = shift;
  my $error = shift;
  my $named = shift || 0;

  local($_);

  my $caller = (caller(2))[3] || "";

  my $usage = $error . ";\nusage: $caller(";

  # TODO - handle named parameters etc.

  $usage .=
      join(", ", map {
        my $name = $_;
        $name = "?$name", unless ($self->{names}->{$name}->{required});
        $name = "*$name", if ($self->{names}->{$name}->{slurp});
        $name;
      } @{$self->{order}}) . ") ";


  croak $usage;
}

# The callback is expected to coerce the data or return an error

sub _run_callback {
  my $self = $_[0];
  my $name = $_[1];
  my $callback = $_[0]->{names}->{$name}->{callback};
  if (ref($callback) eq "CODE") {
    return &{$callback}(@_);
  }
  else {
    croak "expected code reference for callback";
  }
}

sub args {
  my $self = shift;

  # TODO - return a reference to $self in the values

  my %vals = ( );

  # $vals{_args} = [ @_ ];

  my $named = !(@_ % 2);

  # For even number positional parameter with undef in them. 
  for (my $i=0; ($named && ($i < @_)); $i += 2) {
    if (!defined $_[$i]) { $named = 0 }
  }

  if ($named) {
    my %unknown = ( );
    my $i = 0;
    while ($named && ($i < @_)) {
      my $n = $_[$i];
      $n = substr($n,1) if ($n =~ /^\-/);
      if (exists $self->{names}->{$n}) {
        my $truename = $self->{names}->{$n}->{name};
	$vals{$truename} = $_[$i+1];
        if ($self->{names}->{$truename}->{callback}) {
	  $@ = undef;
	  eval {
	    $vals{$truename} =
	      $self->_run_callback($truename, $vals{$truename}, \%vals);
	  };
	  $self->_usage($@,$named) if ($@);
	}
      } else {
	$unknown{$n} = $i;
      }
      $i += 2;
    }

    # As long as there are unknown keys and dynamically-added
    # parameters, we'll keep re-checking.

    while ($self->{dynamic}) {
      $self->{dynamic} = 0;
      if ($named && (keys %unknown)) {
        foreach my $n (keys %unknown) {
	  if (exists $self->{names}->{$n}) {
            my $truename = $self->{names}->{$n}->{name};
	    $vals{$truename} = $_[$unknown{$n}+1];
	    if ($self->{names}->{$truename}->{callback}) {
	      $@ = undef;
	      eval {
		$vals{$truename} =
		  $self->_run_callback($truename, $vals{$truename}, \%vals);
	      };
	      $self->_usage($@,$named) if ($@);
	    }
	    delete $unknown{$n};
	  }
        }
      }
    }

    if ($named && (keys %unknown) && (keys %vals)) {
      $self->_usage("unrecognized parameters: " .
	join(" ", map { "\"$_\"" } keys %unknown), $named);
    }
    elsif ($named && (keys %unknown)) {
      $named = 0;
      %vals = ( );
    }
  }

  unless ($named) {
    my $i = 0;
    while ($i < @_) {
      my $n = $self->{order}->[$i];
      unless (defined $n) {
	$self->_usage("too many arguments",$named);
      }
      my $truename = $self->{names}->{$n}->{name};
      if ($self->{names}->{$truename}->{slurp}) {
	$vals{$truename} = [ @_[$i..$#_] ];
	$i = $#_; # we don't want to use 'last'
      } else {
	$vals{$truename} = $_[$i];
      }
      if ($self->{names}->{$truename}->{callback}) {
	$@ = undef;
	eval {
	  $vals{$truename} =
	    $self->_run_callback($truename, $vals{$truename}, \%vals);
	};
	$self->_usage($@,$named) if ($@);
      }
      $i++;
    }
  }

  # validation stage

  foreach my $name (keys %{ $self->{names} }) {
    my $info = $self->{names}->{$name};
    unless (exists($vals{$name})) {
      $vals{$name} = $info->{default},
        if (($name eq $info->{name}) && (defined $info->{default}));
    }
    if ($info->{required} && !exists($vals{$name})) {
      $self->_usage("missing required parameter \"$name\"", $named);
    }
    if (defined $info->{needs}) {
      # convert a scalar into a list with one element
      if (!ref $info->{needs}) { $info->{needs} = [ $info->{needs} ] }

      foreach my $dep (@{ $info->{needs} }) {
        unless (exists($vals{$dep})) {
          $self->_usage("missing required parameter \"$dep\" (needed by \"$name\")", $named);
        }
      }

    }
  }

  $vals{_named} = $named;

  return %vals;
}


1;

__END__