The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Kelp::Module::Config;
use Kelp::Base 'Kelp::Module';
use Carp;
use Try::Tiny;
use Test::Deep;

# Extension to look for
attr ext => 'pl';

# Directory where config files are
attr path => sub {
    my $self = shift;
    return [
        $ENV{KELP_CONFIG_DIR},
        $self->app->path,
        $self->app->path . '/conf',
        $self->app->path . '/../conf'
    ]
};

attr separator => sub { qr/\./ };

# Defaults
attr data => sub {
    my $self = shift;

    # Return a big hash with default values
    return {

        # Default charset is UTF-8
        charset => 'UTF-8',

        app_url => 'http://localhost:5000',

        # Modules to load
        modules => [qw/JSON Template/],

        # Module initialization params
        modules_init => {

            # Routes
            Routes => {
                base => ref( $self->app )
            },

            # Template
            Template => {
                paths => [
                    $self->app->path . '/views',
                    $self->app->path . '/../views'
                ]
            },

            # JSON
            JSON => {
                allow_blessed   => 1,
                convert_blessed => 1,
                utf8            => 1
            },
        },

        # List of the middleware to add
        middleware => [],

        # Initializations of the middleware
        middleware_init => {},

    };
};

sub get {
    my ( $self, $path ) = @_;
    return unless $path;
    my @a = split( $self->separator, $path );
    my $val = $self->data;
    for my $chunk (@a) {
        if ( ref($val) eq 'HASH' ) {
            $val = $val->{$chunk};
        }
        else {
            croak "Config path $path breaks at '$chunk'";
        }
    }
    return $val;
}

# Override this one to use other config formats.
sub load {
    my ( $self, $filename ) = @_;

    # Open and read file
    open( my $in, "<:encoding(UTF-8)", $filename )
      or do {
        warn "Can not read config file " . $filename;
        return {};
      };

    my $text = do { local $/ = undef; <$in> };
    close($in);

    my $_eval = sub {
        local $@;
        return (eval shift, $@);
    };

    my ( $hash, $error ) = $_eval->( $text );
    die "Config file $filename parse error: " . $error if $error;
    die "Config file $filename did not return a HASH - $hash"
      unless ref $hash eq 'HASH';

    return $hash;
}

sub build {
    my ( $self, %args ) = @_;

    # Get an easy access reference to the data
    my $data_ref = $self->data;

    # Create a private sub that searches for a file in all the paths
    # specified in $self->path
    my $find = sub {
        my $name = shift;
        my @paths = ref( $self->path ) ? @{ $self->path } : ( $self->path );
        for my $path (@paths) {
            next unless defined $path;
            my $filename = sprintf( '%s/%s.%s', $path, $name, $self->ext );
            return $filename if -r $filename;
        }
    };

    # Create a private sub that parses a config file
    my $process = sub {
        my $name   = shift;
        my $parsed = {};
        try {
            $parsed = $self->load($name);
        }
        catch {
            croak "Parsing $name died with error: '${_}'";
        };
        $data_ref = _merge( $data_ref, $parsed );
    };

    # Find, parse and merge 'config' and mode files
    for ( 'config', $self->app->mode ) {
        if ( my $filename = $find->($_) ) {
            $process->($filename);
        }
    }

    # Register two methods: config and config_hash
    $self->register(
        config_hash => $self->data,
        config      => sub {
            my ( $app, $path ) = @_;
            return $self->get($path);
        }
    );
}

sub _merge {
    my ( $a, $b, $sigil ) = @_;

    return $b
      if !ref($a)
      || !ref($b)
      || ref($a) ne ref($b);

    if ( ref $a eq 'ARRAY' ) {
        return $b unless $sigil;
        if ( $sigil eq '+' ) {
            for my $e (@$b) {
                push @$a, $e unless grep { eq_deeply( $_, $e ) } @$a;
            }
        }
        else {
            $a = [
                grep {
                    my $e = $_;
                    !grep { eq_deeply( $_, $e ) } @$b
                } @$a
            ];
        }
        return $a;
    }
    elsif ( ref $a eq 'HASH' ) {
        for my $k ( keys %$b ) {
            my $s = $k =~ s/^(\+|\-)// ? $1 : '';
            $a->{$k} =
              exists $a->{$k}
              ? _merge( $a->{$k}, $b->{"$s$k"}, $s )
              : $b->{$k};
        }

        return $a;
    }
    return $b;
}

1;

__END__

=pod

=head1 NAME

Kelp::Module::Config - Configuration for Kelp applications

=head1 DESCRIPTION

This is one of the two modules that are automatically loaded for each and every
Kelp application. It reads configuration files containing Perl-style hashes,
and merges them depending on the value of the application's C<mode> attribute.

The main configuration file name is C<config.pl>, and it will be searched in the
C<conf> and C<../conf> directories. You can also set the C<KELP_CONFIG_DIR> environmental
variable with the path to the configuration files.

This module comes with some L<default values|/DEFAULTS>, so if there are no
configuration files found, those values will be used.
Any values from configuration files will add to or override the default values.

=head1 ORDER

First the module will look for C<conf/config.pl>, then for C<../conf/config.pl>.
If found, they will be parsed and merged into the default values.
The same order applies to the I<mode> file too, so if the application
L<mode|Kelp/mode> is I<development>, then C<conf/development.pl> and
C<../conf/development.pl> will be looked for. If found, they will also be merged
to the config hash.

=head1 MERGING

The first configuration file this module will look for is C<config.pl>. This is
where you should keep configuration options that apply to all running environments.
The mode-specific configuration file will be merged to this config, and it will
take priority. Merging is done as follows:

=over

=item Scalars will always be overwriten.

=item Hashes will be merged.

=item Arrays will be overwritten, except in case when the name of the array contains a
sigil as follows:

=over

=item

C<+> in front of the name will add the elements to the array:

    # in config.pl
    {
        middleware => [qw/Bar Foo/]
    }

    # in development.pl
    {
        '+middleware' => ['Baz']    # Add 'Baz' in development
    }

=cut

=item

C<-> in front of the name will remove the elements from the array:

    # in config.pl
    {
        modules => [qw/Template JSON Logger/]
    }

    # in test.pl
    {
        '-modules' => [qw/Logger/]  # Remove the Logger modules in test mode
    }

=cut

=item

No sigil will cause the array to be completely replaced:

    # in config.pl
    {
        middleware => [qw/Bar Foo/]
    }

    # in cli.pl
    {
        middleware => []    # No middleware in CLI
    }

=cut

=back

=back

=head1 REGISTERED METHODS

This module registers the following methods into the underlying app:

=head2 config

A wrapper for the C</get> method.

    # Somewhere in the app
    my $pos = $self->config('row.col.position');

    # Gets {row}->{col}->{position} from the config hash

=head2 config_hash

A reference to the entire configuration hash.

    my $pos = $self->config_hash->{row}->{col}->{position};

Using this or C<config> is entirely up to the application developer.

=head1 ATTRIBUTES

This module implements some attributes, which can be overridden by subclasses.

=head2 ext

The file extension of the configuration files. Default is C<pl>.

=head2 separator

A regular expression for the value separator used by L</get>. The default is
C<qr/\./>, i.e. a dot.

=head2 path

Specifies a path, or an array of paths where to look for configuration files.
This is particularly useful when writing tests, because you can set a custom
path to a peculiar configuration.

=head2 data

The hashref with data contained in all of the merged configurations.

=head1 METHODS

The module also implements some methods for parsing the config files, which can
be overridden in extending classes.

=head2 get

C<get($string)>

Get a value from the config using a separated string.

    my $value = $c->get('bar.foo.baz');
    my $same  = $c->get('bar')->{foo}->{baz};
    my $again = $c->data->{bar}->{foo}->{baz};

By default the separator is a dot, but this can be changed via the
L</separator> attribute.

=head2 load

C<load(filename)>

Loads, and parses the file C<$filename> and returns a hash reference.

=head1 DEFAULTS

This module sets certain default values. All of them may be overridden in any of
the C<conf/> files. It probably pays to view the code of this module and look
and the C<defaults> sub to see what is being set by default, but here is the
short version:

=head2 charset

C<UTF-8>

=head2 app_url

C<http://localhost:5000>

=head2 modules

An arrayrf with module names to load on startup. The default value is
C<['JSON', 'Template']>

=head2 modules_init

A hashref with initializations for each of the loaded modules, except this one,
ironically.

=head2 middleware

An arrayref with middleware to load on startup. The default value is an
empty array.

=head2 middleware_init

A hashref with initialization arguments for each of the loaded middleware.

=head1 SUBCLASSING

You can subclass this module and use other types of configuration files
(for example YAML). You need to override the C<ext> attribute
and the C<load> subroutine.

    package Kelp::Module::Config::Custom;
    use Kelp::Parent 'Kelp::Module::Config';

    # Set the config file extension to .cus
    attr ext => 'cus';

    sub load {
        my ( $self, $filename ) = @_;

        # Load $filename, parse it and return a hashref
    }

    1;

Later ...

    # app.psgi
    use MyApp;

    my $app = MyApp->new( config_module => 'Config::Custom' );

    run;

The above example module will look for C<config/*.cus> to load as configuration.

=head1 TESTING

Since the config files are searched in both C<conf/> and C<../conf/>, you can
use the same configuration set of files for your application and for your tests.
Assuming the all of your test will reside in C<t/>, they should be able to load
and find the config files at C<../conf/>.

=cut