view release on metacpan or  search on metacpan

lib/Perinci/CmdLine/Util/Config.pm  view on Meta::CPAN

package Perinci::CmdLine::Util::Config;

use 5.010001;
use strict;
use warnings;
use Log::ger;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2025-11-15'; # DATE
our $DIST = 'Perinci-CmdLine-Util-Config'; # DIST
our $VERSION = '1.727'; # VERSION

our @EXPORT_OK = (
    'get_default_config_dirs',
    'read_config',
    'get_args_from_config',
);

our %SPEC;

# from PERLANCAR::File::HomeDir 0.03, with minor modification
sub _get_my_home_dir {
    if ($^O eq 'MSWin32') {
        # File::HomeDir always uses exists($ENV{x}) first, does it want to avoid
        # accidentally creating env vars?
        return $ENV{HOME} if $ENV{HOME};
        return $ENV{USERPROFILE} if $ENV{USERPROFILE};
        return join($ENV{HOMEDRIVE}, "\\", $ENV{HOMEPATH})
            if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};
    } else {
        return $ENV{HOME} if $ENV{HOME};
        my @pw;
        eval { @pw = getpwuid($>) };
        return $pw[7] if @pw;
    }
    die "Can't get home directory";
}

$SPEC{get_default_config_dirs} = {
    v => 1.1,
    args => {},
};
sub get_default_config_dirs {
    my @dirs;
    #local $PERLANCAR::File::HomeDir::DIE_ON_FAILURE = 1;
    my $home = _get_my_home_dir();
    if ($^O eq 'MSWin32') {
        push @dirs, $home;
    } else {
        push @dirs, "$home/.config", $home, "/etc";
    }
    \@dirs;
}

$SPEC{read_config} = {
    v => 1.1,
    args => {
        config_paths    => {},
        config_filename => {},
        config_dirs     => {},
        program_name    => {},
        # TODO: hook_file
        hook_section    => {},
        # TODO: hook_param?
    },
};
sub read_config {
    require Config::IOD::Reader;

    my %args = @_;

    my $config_dirs = $args{config_dirs} // get_default_config_dirs();

    my $paths;

    my @filenames;
    my %section_config_filename_map;
    if (my $names = $args{config_filename}) {
        for my $name (ref($names) eq 'ARRAY' ? @$names : ($names)) {
            if (ref($name) eq 'HASH') {
                $section_config_filename_map{$name->{filename}} = $name->{section};
                push @filenames, $name->{filename};
            } else {
                $section_config_filename_map{$name} = 'GLOBAL';
                push @filenames, $name;
            }
        }
    }
    unless (@filenames) {
        @filenames = (($args{program_name} // "prog") . ".conf");
    }

    if ($args{config_paths}) {