As few posts running around these days I propose you an idea I had recently and that seems to work as I expected.

The goal is, as the title says, to use GetOptionsFromArray from Getopt::Long to parse arguments passed to a sub adding the flexibility in arg specification and adding also a primitive type check.

In the below code the sub test (yeah! what a great name! ;) defines the hash %opts where initial default values are declared and where GetOptionsFromArray will soon put passed in arguments and defines also a @template to hold definitions of various arguments type (with the benefit of a minimal type check for free)

Here my actual code:

use strict;
use warnings;
use Getopt::Long qw(GetOptionsFromArray);
use Data::Dumper;

my $debug = 0; # 0-2
Getopt::Long::Configure ("debug") if $debug > 1;

sub test{
        if ($debug){ print "\@_ received: ",Dumper \@_; }
        
        # default values in the destination hash
        my %opts = ( 
                len => 42,
                switchx => '',
                # colors => [qw(red yellow green)], # these are NOT ov
+erwritten, why?
                colors => [],
        );
        
        # copy for debug purpose
        my %default = %opts;
        
        # template for valid options
        my @template = (
            "len|lunghezza=i",
            "switchx",
            "tick=i",
            "colors=s@",
        );
        
        my $ret = GetOptionsFromArray(\@_, \%opts, @template ) ;
        
        # handle errors
        unless($ret){
            print "template for this sub is:\n",
                    "\t",(join "\n\t", @template),"\n",
                    "default values are:\n",
                    ( map{
                        "\t$_ = ".
                        ( ref ($default{$_}) eq 'ARRAY' ? (join ' ',@{
+$default{$_}}) : $default{$_} ).
                        "\n"}sort keys %default ),"\n";
            return; # this should be die
        }
        
        if ($debug){ print "GetOptionsFromArray returned: $ret\n"; }
        if ($debug){ print "\@_ after GetOptionsFromArray: ", Dumper \
+@_; }
        print "final \%opts result: ", Dumper \%opts;
        print "remaining in \@_:", Dumper \@_ if @_;
        
}

foreach my $argtest (
    [( qw(-len 1111) )],
    [( qw(-l 11) )],
    [( qw(-lunghezza 12121212) )],
    [( qw(-len AAAA) )],
    [( qw(-len 2222 -un known) )],
    [( qw(-len 2222 -tick 3333) )],
    [( qw(-len 2222 -colors blue -colors cyan -colors orange) )],
    [( qw(-len 2222 --switchx) )],
    [( qw(-len 3333 --switchx -- Alpha Bravo) )],
    
){
    print "PASSING: (",(join ' ', @$argtest),")\n";
    test ( @$argtest );
    print "\n";
}
[download]

..and the output

PASSING: (-len 1111)
final %opts result: $VAR1 = {
          'switchx' => '',
          'len' => 1111,
          'colors' => []
        };

PASSING: (-l 11)
final %opts result: $VAR1 = {
          'switchx' => '',
          'colors' => [],
          'len' => 11
        };

PASSING: (-lunghezza 12121212)
final %opts result: $VAR1 = {
          'switchx' => '',
          'colors' => [],
          'len' => 12121212
        };

PASSING: (-len AAAA)
Value "AAAA" invalid for option len (number expected)
template for this sub is:
        len|lunghezza=i
        switchx
        tick=i
        colors=s@
default values are:
        colors =
        len = 42
        switchx =


PASSING: (-len 2222 -un known)
Unknown option: un
template for this sub is:
        len|lunghezza=i
        switchx
        tick=i
        colors=s@
default values are:
        colors =
        len = 42
        switchx =


PASSING: (-len 2222 -tick 3333)
final %opts result: $VAR1 = {
          'colors' => [],
          'len' => 2222,
          'tick' => 3333,
          'switchx' => ''
        };

PASSING: (-len 2222 -colors blue -colors cyan -colors orange)
final %opts result: $VAR1 = {
          'len' => 2222,
          'colors' => [
                        'blue',
                        'cyan',
                        'orange'
                      ],
          'switchx' => ''
        };

PASSING: (-len 2222 --switchx)
final %opts result: $VAR1 = {
          'colors' => [],
          'len' => 2222,
          'switchx' => 1
        };

PASSING: (-len 3333 --switchx -- Alpha Bravo)
final %opts result: $VAR1 = {
          'switchx' => 1,
          'colors' => [],
          'len' => 3333
        };
remaining in @_:$VAR1 = [
          'Alpha',
          'Bravo'
        ];
[download]

I wonder if this behaviour can be put into a module (the original idea was to use Class::Method::Modifiers to inject code just before the original subroutine) but I wonder if it is worth to and notably which interface to expose. Perhaps something like Sub::Getopt::Long is a nice name for this.

An eventual module interface should be similar to a simple:

use Sub::Getopt::Long qw( longargs );

sub MyOwnStuff{
                my %opts = ( len => 1, wid => 2); # defaults
  
                %opts = longargs( \%opts, [qw( len=i wid=i )], @_ );

                # or simply
             
                my %opts = longargs( {len => 1, wid => 2}, [qw( len=i 
+wid=i )], @_ );

}
[download]

Any comment or suggestions are as always warmly welcome!

L*