This subroutine provides a simple way to write functions in Perl that take named parameters. It doesn't perform any validation like the Params::Validate module does, but it strives to support the most flexible interface possible.

Here's an example of its usage:

# this sub takes named parameters:
sub restart_server {
    # the variables to store the parameter values in:
    my ($host, $port, $timeout);

    # extract the parameter values:
    get_named_params({
        host    => \$host,
        port    => \$port,
        timeout => \$timeout
        }, \@_
    );

    # ...
}

[download]

It supports Tk-style "-paramname => $value" parameters, libnet-style "ParamName => $value" parameters, and LWP-style "param_name => $value" parameters all transparently:

restart_server(
    -host    => $host,
    -port    => $port,
    -timeout => $timeout
); # works
restart_server(
    Host    => $host,
    Port    => $port,
    Timeout => $timeout
); # so does this...
restart_server(
    host    => $host,
    port    => $port,
    timeout => $timeout
); # and this...

[download]

This routine was written with efficiency in mind. Instead of just returning the values outright, it takes references to variables where they get stored, and the argument list is passed in as an array or hash reference. Keeping with this theme, the named parameters themselves can be passed to your subroutine as a hash/array reference for even better performance:

restart_server({
    -host    => $host,
    -port    => $port,
    -timeout => $timeout
}); # works
restart_server([
    Host    => $host,
    Port    => $port,
    Timeout => $timeout
]); # so does this...

[download]

As mentioned above, get_named_params() doesn't perform any validation, so you'll have to check the destination variables for undef-ness and proper values yourself, or use Params::Validate if you can't be bothered to do that.

It needs Carp.pm for croak(), by the way:

sub get_named_params
{
    my ($destinations, $arg_list) = @_;

    croak "Arguments weren't sent as a reference to a hash or array."
        unless (ref $arg_list eq 'ARRAY' or ref $arg_list eq 'HASH');
    
    # this will store a reference to a hash containing the named param
+eters
    # passed to your sub:
    my $params_hashref;
    if (ref $arg_list eq 'ARRAY')
    {
        if (@$arg_list == 1)
        {
            # The callers of your sub can optionally pass their
            # named parameters as a hash or array references, in
            # which case @_ contains the reference as its first and
            # only element:
            my $ref      = $$arg_list[0];
            my $ref_type = ref $ref;

            croak(
                'Odd number of arguments sent to sub ' .
                'expecting named parameters.'
            ) unless $ref_type;

            croak (
                "Bad refernce type \"$ref_type\" for named " .
                "parameters. Pass them instead as either a " .
                "hash or array reference."
            ) unless ($ref_type eq 'ARRAY' or $ref_type eq 'HASH');

            $params_hashref = (ref $ref eq 'ARRAY')
                        ? { @$ref }
                        : $ref;
        }
        else
        {
            $params_hashref = { @$arg_list };
        }
    }
    else
    {
        $params_hashref = $arg_list;
    }



    my %name_translation_table;
    foreach my $destination_name (keys %$destinations)
    {
        my $stripped_name = strip_param_name($destination_name);

        $name_translation_table{$stripped_name} = $destination_name;
    }

    foreach my $supplied_name (keys %$params_hashref)
    {
        my $stripped_name = strip_param_name($supplied_name);

        next unless (exists $name_translation_table{$stripped_name});

        my $destination_name = $name_translation_table{$stripped_name}
+;
        my $destination_ref  = $destinations->{$destination_name};

        $$destination_ref = $params_hashref->{$supplied_name};
    }
}





sub strip_param_name
{
    my $stripped_name = lc shift;
       $stripped_name =~ s/_//g;
       $stripped_name =~ s/^-//;

    return $stripped_name;
}

[download]

Replies are listed 'Best First'.
Re: Case-insensitive, dash-optional named parameters for your functions
by jdporter (Paladin) on Nov 08, 2004 at 04:14 UTC
    I usually just do this: 
    use Getopt::Long;

sub restart_server {
    my( $host, $port, $timeout );

    local @ARGV = @_;

    GetOptions(
        'host=s'    => \$host,
        'port=i'    => \$port,
        'timeout=i' => \$timeout,
    );

    # ...
}

    [download]
[reply]
[d/l]

      Very clever!

      But it only seems to support Tk-style parameters. If I call the routine without leading dashes in the parameter names, it doesn't work, nor can I make Getopt::Long ignore underscores to enable LWP-style named parameters.

      Still, very clever code reuse there.

[reply]
        About the leading dashes, you can configure Getopt::Long to not require the leading dashes. Check out this thread and specifically my answer. In addition, you can do 'paramname|ParamName|param_name=i' => \$param_name to read the different styles.
[reply]
[d/l]
Re: Case-insensitive, dash-optional named parameters for your functions
by iblech (Friar) on Nov 08, 2004 at 16:11 UTC 
    # Perl 6 :)

sub restart_server (Str +$host, Int +$port, Int +$timeout) {
  ...;
}

# Call using
restart_server host => "...", port => ..., timeout => ...;
# or
restart_server :host«...», :port(...), :timeout(...);

    [download]

    By just adding a + in front of the variable name you can (actually have to) pass this parameter named.

    I noticed, in Perl 5, that you often have only a little small function taking only one parameter:

    # Perl 5
sub foo {
  my $a = shift;
  ...;
}

    [download]

    Later on, you see the need to add a second positional parameter. And maybe your small function won't stop growing and you require a third and fourth parameter, too.

    sub foo {
  my ($a, $b, $c, $d) = @_;
  ...;
}

    [download]

    You think, "I should use named paramaters here", but you (read: I) are probably too lazy to rewrite foo to:

    sub foo {
  my %args = @_;
  my ($a, $b, $c, $d) = @args{qw( a b c d )};
  # Or:
  my ($a, $b, $c, $d) = @{{@_}}{qw( a b c d )};
  ...;
}

    [download]

    Instead, you keep your positional argument calling (bad). But in Perl 6, all you'll have to do is to add one small little +, and (of course) you won't have to extract the parameters out of @_ yourself! And you get compile-time checking, too :)

[reply]
[d/l]
[select]

Back to Cool Uses for Perl