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

our $DATE = '2015-07-15'; # DATE
our $VERSION = '1.22'; # VERSION

use 5.010;
use strict;
use warnings;
use Log::Any::IfLOG '$log';

use PERLANCAR::File::HomeDir qw(get_my_home_dir);

our %SPEC;

$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_filenames => {},
        config_dirs => {},
        program_name => {},
    },
};
sub read_config {
    require Config::IOD::Reader;

    my %args = @_;

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

    my $paths;
    if ($args{config_paths}) {
        $paths = $args{config_paths};
    } else {
        my $name = $args{config_filename} //
            $args{program_name} . ".conf";
        for my $dir (@$config_dirs) {
            my $path = "$dir/" . $name;
            push @$paths, $path if -e $path;
        }
    }

    my $reader = Config::IOD::Reader->new;
    my %res;
    my @read;
    for my $path (@$paths) {
        my $hoh = $reader->read_file($path);
        push @read, $path;
        for my $section (keys %$hoh) {
            my $hash = $hoh->{$section};
            for (keys %$hash) {
                $res{$section}{$_} = $hash->{$_};
            }
        }
    }
    [200, "OK", \%res, {'func.read_files' => \@read}];
}

$SPEC{get_args_from_config} = {
    v => 1.1,
    args => {
        r => {},
        config => {},
        args => {},
        subcommand_name => {},
        config_profile => {},
        common_opts => {},
        meta => {},
        meta_is_normalized => {},
    },
};
sub get_args_from_config {
    my %fargs = @_;

    my $r       = $fargs{r};
    my $conf    = $fargs{config};
    my $scn     = $fargs{subcommand_name} // '';
    my $profile = $fargs{config_profile};
    my $args    = $fargs{args} // {};
    my $copts   = $fargs{common_opts};
    my $meta    = $fargs{meta};
    my $found;

    unless ($fargs{meta_is_normalized}) {
        require Perinci::Sub::Normalize;
        $meta = Perinci::Sub::Normalize::normalize_function_metadata($meta);
    }

    # put GLOBAL before all other sections
    my @sections = sort {
        ($a eq 'GLOBAL' ? 0:1) <=> ($b eq 'GLOBAL' ? 0:1) ||
            $a cmp $b
        } keys %$conf;

    my %seen_profiles; # for debugging message
    for my $section (@sections) {
        my ($sect_scn, $sect_profile);
        if ($section =~ /\Aprofile=(.*)\z/) {
            $sect_scn = 'GLOBAL';
            $sect_profile = $1;
        } elsif ($section =~ /\A\S+\z/) {
            $sect_scn = $section;
        } elsif ($section =~ /\A(\S+)\s+profile=(.*)\z/) {
            $sect_scn = $1;
            $sect_profile = $2;
        } else {
            die [412, "Error in config file: invalid section name ".
                     "'$section', please use subcommand name + optional ".
                         "' profile=PROFILE' only"];
        }
        $seen_profiles{$sect_profile}++ if defined $sect_profile;
        if (length $scn) {
            next if $sect_scn ne 'GLOBAL' && $sect_scn ne $scn;
        } else {
            next if $sect_scn ne 'GLOBAL';
        }
        if (defined $profile) {
            next if defined($sect_profile) && $sect_profile ne $profile;
            $found++ if defined($sect_profile) && $sect_profile eq $profile;
        } else {
            next if defined($sect_profile);
        }

        my $as = $meta->{args} // {};
        for my $k (keys %{ $conf->{$section} }) {
            my $v = $conf->{$section}{$k};
            if ($copts->{$k} && $copts->{$k}{is_settable_via_config}) {
                my $sch = $copts->{$k}{schema};
                if ($sch) {
                    require Data::Sah::Normalize;
                    $sch = Data::Sah::Normalize::normalize_schema($sch);
                    # since IOD might return a scalar or an array (depending on
                    # whether there is a single param=val or multiple param=
                    # lines), we need to arrayify the value if the argument is
                    # expected to be an array.
                    if (ref($v) ne 'ARRAY' && $sch->[0] eq 'array') {
                        $v = [$v];
                    }
                }
                $copts->{$k}{handler}->(undef, $v, $r);
            } else {
                # when common option clashes with function argument name, user
                # can use NAME.arg to refer to function argument.
                $k =~ s/\.arg\z//;

                # since IOD might return a scalar or an array (depending on
                # whether there is a single param=val or multiple param= lines),
                # we need to arrayify the value if the argument is expected to
                # be an array.
                if (ref($v) ne 'ARRAY' && $as->{$k} && $as->{$k}{schema} &&
                        $as->{$k}{schema}[0] eq 'array') {
                    $v = [$v];
                }
                $args->{$k} = $v;
            }
        }
    }
    $log->tracef("[pericmd] Seen config profiles: %s",
                 [sort keys %seen_profiles]);

    [200, "OK", $args, {'func.found'=>$found}];
}

1;
# ABSTRACT: Utility routines related to config files

__END__

=pod

=encoding UTF-8

=head1 NAME

Perinci::CmdLine::Util::Config - Utility routines related to config files

=head1 VERSION

This document describes version 1.22 of Perinci::CmdLine::Util::Config (from Perl distribution Perinci-CmdLine-Lite), released on 2015-07-15.

=head1 FUNCTIONS


=head2 get_args_from_config(%args) -> [status, msg, result, meta]

Arguments ('*' denotes required arguments):

=over 4

=item * B<args> => I<any>

=item * B<common_opts> => I<any>

=item * B<config> => I<any>

=item * B<config_profile> => I<any>

=item * B<meta> => I<any>

=item * B<meta_is_normalized> => I<any>

=item * B<r> => I<any>

=item * B<subcommand_name> => I<any>

=back

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

Return value:  (any)


=head2 get_default_config_dirs() -> [status, msg, result, meta]

No arguments.

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

Return value:  (any)


=head2 read_config(%args) -> [status, msg, result, meta]

Arguments ('*' denotes required arguments):

=over 4

=item * B<config_dirs> => I<any>

=item * B<config_filenames> => I<any>

=item * B<config_paths> => I<any>

=item * B<program_name> => I<any>

=back

Returns an enveloped result (an array).

First element (status) is an integer containing HTTP status code
(200 means OK, 4xx caller error, 5xx function error). Second element
(msg) is a string containing error message, or 'OK' if status is
200. Third element (result) is optional, the actual result. Fourth
element (meta) is called result metadata and is optional, a hash
that contains extra information.

Return value:  (any)

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Perinci-CmdLine-Lite>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Perinci-CmdLine-Lite>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-CmdLine-Lite>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by perlancar@cpan.org.

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

=cut
