File Coverage

blib/lib/Getopt/EX/Config.pm

Criterion	Covered	Total	%
statement	70	99	70.7
branch	13	30	43.3
condition	5	16	31.2
subroutine	16	23	69.5
pod	5	11	45.4
total	109	179	60.8

package Getopt::EX::Config;

use v5.14;
use warnings;

our $VERSION = '1.0202';

our $REPLACE_UNDERSCORE = 1;

use Data::Dumper;
use Getopt::Long;

use List::Util qw(first);
use Hash::Util qw(lock_keys);

our %CONFIG;

sub import {
    my $class = shift;
    my $caller = caller;
    my @names = @_ ? @_ : 'config';
    no strict 'refs';
    for my $name (@names) {
	*{"$caller\::$name"} = sub {
	    $CONFIG{$caller}->config(@_);
	};
    };
}

sub new {
    my $class = shift;
    my $config = ref $_[0] eq 'HASH' ? shift : { @_ };
    for my $key (keys %$config) {
        $key =~ /^[a-zA-Z]/ or die "$key: config key must start with a letter\n";
    }
    # Initialize internal keys for lock_keys compatibility
    $config->{_argv} = [];
    $config->{_configure} = [];
    my $caller = caller;
    $CONFIG{$caller} = bless $config, $class;
    $config;
}

sub object {
    $CONFIG{+caller};
}

sub deal_with {
    my $obj = shift;
    if ($obj eq __PACKAGE__) {
	$obj = $CONFIG{+caller} // die;
    }
    my($my_argv, $argv) = split_argv(shift);
    $obj->getopt($my_argv, @_) if @$my_argv;
    $obj->{_argv} = [ @$my_argv ];
    return $obj;
}

sub argv {
    my $obj = shift;
    @{ $obj->{_argv} // [] };
}

sub configure {
    my $obj = shift;
    push @{$obj->{_configure}}, @_;
    $obj;
}

use Getopt::EX::Func;
*arg2kvlist = \&Getopt::EX::Func::arg2kvlist;

sub getopt {
    my $obj = shift;
    my $argv = shift // [];
    return if @{ $argv } == 0;

    # Filter out internal keys (must start with a letter)
    @_ = grep { ref($_) || /^[a-zA-Z]/ } @_;

    # Convert underscore options to underscore|dash format
    @_ = map { ref($_) ? $_ : s/^(\w*_[\w_]*)/"$1|" . ($1 =~ s:_:-:gr)/er } @_
        if $REPLACE_UNDERSCORE;

    my $p = Getopt::Long::Parser->new(
        config => [ 'bundling', @{$obj->{_configure} // []} ]
    );
    $p->getoptionsfromarray(
	$argv,
	$obj,
	"config=s" => sub {
	    $obj->config(arg2kvlist($_[1]));
	},
	@_
    ) or die "Option parse error.\n";
}

sub config {
    my $obj = shift;
    if (@_ == 1) {
	$obj->get(@_);
    } else {
	$obj->set(@_);
    }
}

######################################################################

sub set {
    my $obj = shift;
    while (my($k, $v) = splice @_, 0, 2) {
	my $c = $obj;
	my @names = split /\./, $k;
	my $name = pop @names;
	for (@names) {
	    $c = $c->{$_} // die "$k: invalid name.\n";
	}
	exists $c->{$name} or die "$k: invalid name.\n";
	if (ref $c->{$name}) {
	    ${$c->{$name}} = $v;
	} else {
	    $c->{$name} = $v;
	}
    }
    ();
}

sub get :lvalue {
    my $c = shift;
    my $key = shift;
    if (ref $c->{$key}) {
	${$c->{$key}};
    } else {
	$c->{$key};
    }
}

sub mod_argv {
    my($mod, $argv) = splice @_, 0, 2;
    ($mod, split_argv($argv), @_);
}

sub split_argv {
    my $argv = shift;
    my @my_argv;
    if (@$argv and
	$argv->[0] !~ /^-M/ and
	defined(my $i = first { $argv->[$_] eq '--' } keys @$argv)) {
	splice @$argv, $i, 1; # remove '--'
	@my_argv = splice @$argv, 0, $i;
    }
    (\@my_argv, $argv);
}

1;

=encoding utf-8

=head1 NAME

Getopt::EX::Config - Getopt::EX module configuration interface

=head1 SYNOPSIS

    example -Mfoo::config(foo=yabaa,bar=dabba) ...

    example -Mfoo::config(foo=yabba) --config bar=dabba ... -- ...

    example -Mfoo::config(foo=yabba) --bar=dabba ... -- ...

    example -Mfoo --foo=yabaa --bar=dabba -- ...

=head1 VERSION

Version 1.0202

=head1 DESCRIPTION

This module provides an interface to define configuration information
for C modules.  In the traditional way, in order to set
options for a module, it was necessary to define dedicated command
line options for them.  To do so, it is necessary to avoid name
conflicts with existing command options or with other modules used
together.

Using this module, it is possible to define configuration information
only for the module and to define module-specific command options.

You can create config object like this:

    use Getopt::EX::Config;
    my $config = Getopt::EX::Config->new(
        char  => 0,
        width => 0,
        code  => 1,
        name  => "Franky",
    );

This call returns hash object and each member can be accessed like
C<< $config->{width} >>.

You can set these configuration values by calling C function
with module declaration.

    example -Mfoo::config(width,code=0) ...

Parameter list is given by key-value pairs, and C<1> is assumed when
value is not given.  Above code set C to C<1> and C to
C<0>.

Also module specific options can be taken care of by calling
C method from module startup funciton C or
C.

    sub finalize {
        our($mod, $argv) = @_;
        $config->deal_with($argv);
    }

Then you can use C<--config> module option like this:

    example -Mfoo --config width,code=0 -- ...

The module startup function is executed between the C
and C calls.  Therefore, if you want to give priority to
module-specific options over the startup function, you must call
C in the C function.

If you want to make module private option, say C<--width> to set C<<
$config->{width} >> value, C method takes C
style option specifications.

    sub finalize {
        our($mod, $argv) = @_;
        $config->deal_with(
            $argv,
            "width!",
            "code!",
            "name=s",
        );
    }

Then you can use module private option like this:

    example -Mcharcode --width --no-code --name=Benjy -- ...

By default, option names with underscores are automatically aliased with
dash equivalents. For example, if you specify C, both C<--long_lc>
and C<--long-lc> will work. This conversion can be disabled by setting
C<$Getopt::EX::Config::REPLACE_UNDERSCORE> to 0.

The reason why it is not necessary to specify the destination of the
value is that the hash object is passed when calling the
C library.  The above code is equivalent to the
following code.  See L
for detail.

=head2 Nested Hash Configuration

Config values can be hash references for structured configuration:

    my $config = Getopt::EX::Config->new(
        mode   => '',
        hashed => { h3 => 0, h4 => 0, h5 => 0, h6 => 0 },
    );

Nested values can be accessed using dot notation in the C
function:

    example -Mfoo::config(hashed.h3=1,hashed.h4=1) ...

    example -Mfoo --config hashed.h3=1 -- ...

The dot notation navigates into nested hashes: C sets
C<< $config->{hashed}{h3} >> to C<1>.  The intermediate key
(C) must exist as a hash reference, and the leaf key (C)
must already exist in that hash.

Hash options can also be defined as module private options using
L hash type (C<%>):

    $config->deal_with($argv, "hashed=s%");

This allows:

    example -Mfoo --hashed h3=1 --hashed h4=1 -- ...

Note that the C hash type auto-vivifies keys, so
C<--hashed h3=1> works even when C does not pre-exist in the hash.

The dot notation and nested hash support are designed with future
extensibility in mind.  For example, a configuration file under
F<~/.config> could store module settings in YAML-like format:

    # ~/.config/example/foo.yml
    mode: dark
    hashed:
      h3: 1
      h4: 1
      h5: 1
      h6: 1

This would map naturally to the nested hash structure and dot notation
already supported by this module.

    sub finalize {
        our($mod, $argv) = @_;
        $config->deal_with(
            $argv,
            "width!" => \$config->{width},
            "code!"  => \$config->{code},
            "name=s" => \$config->{name},
        );
    }

=head1 FUNCTIONS

=over 7

=item B(I => I, ...)

This module exports the function C by default.  As explained
above, this is why the C function can be executed with module
declaration.

If you want to use a function with a different name, specify it
explicitly.  In the following example, the function C is defined
and can be used in the same way as C.

    use Getopt::EX::Config qw(config set);

=item B(I)

The C function may also be used to refer parameters in the
program.  In this case, specify single argument.

    my $width = config('width');

Parameter value references can also be used as left-hand side values,
so values can be assigned.

    config('width') = 42;

=back

=head1 METHODS

=over 7

=item B(I)

=item B(I)

Return configuration object.

Call with key-value list like this:

    my $config = Getopt::EX::Config->new(
        char  => 0,
        width => 0,
        code  => 1,
        name  => "Franky",
    );

Or call with hash reference.

    my %config = (
        char  => 0,
        width => 0,
        code  => 1,
        name  => "Franky",
    );
    my $config = Getopt::EX::Config->new(\%config);

In this case, C<\%config> and C<$config> should be identical.
Do not apply C to the hash before calling C.

Config keys must start with a letter (a-z, A-Z).  Keys starting with
underscore or other characters are reserved for internal use.

=item B

You can get argument reference in C or C
function declared in C module.  Call C method
with that reference.

    sub finalize {
        our($mod, $argv) = @_;
        $config->deal_with($argv);
    }

You can define module specific options by giving L style
definition with that call.

    sub finalize {
        our($mod, $argv) = @_;
        $config->deal_with($argv,
                           "width!", "code!", "name=s");
    }

=item B(I)

Set L configuration options.  Returns the object itself
for method chaining.  Internally uses L so that
global configuration is not affected.

    $config->configure('pass_through');
    $config->deal_with($argv, "width!", "name=s");

Or with method chaining:

    $config->configure('pass_through')->deal_with($argv, ...);

=item B

Returns the remaining arguments after C processing.  When
used with C configuration, unrecognized options are
preserved and can be retrieved with this method.

    sub finalize {
        our($mod, $argv) = @_;
        $config->configure('pass_through')->deal_with($argv, "width!", "name=s");
        my @extra = $config->argv;  # unrecognized options
    }

=back

=head1 VARIABLES

=over 7

=item B<$REPLACE_UNDERSCORE>

When set to true (default), option names with underscores are automatically
aliased with dash equivalents. For example, C becomes
C, allowing both C<--long_lc> and C<--long-lc> to work.

Set to false to disable this conversion:

    $Getopt::EX::Config::REPLACE_UNDERSCORE = 0;

=back

=head1 SEE ALSO

L

L

=head1 AUTHOR

Kazumasa Utashiro

=head1 COPYRIGHT

The following copyright notice applies to all the files provided in
this distribution, including binary files, unless explicitly noted
otherwise.

Copyright ©︎ 2025-2026 Kazumasa Utashiro

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut