File Coverage

blib/lib/Dancer/Config.pm

Criterion	Covered	Total	%
statement	124	124	100.0
branch	29	32	90.6
condition	36	81	44.4
subroutine	28	28	100.0
pod	0	11	0.0
total	217	276	78.6

package Dancer::Config;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT:  how to configure Dancer to suit your needs
$Dancer::Config::VERSION = '1.3520';
use strict;
use warnings;
use base 'Exporter';
use vars '@EXPORT_OK';

use Hash::Merge::Simple;
use Dancer::Config::Object 'hashref_to_object';
use Dancer::Deprecation;
use Dancer::Template;
use Dancer::ModuleLoader;
use Dancer::FileUtils 'path';
use Carp;
use Dancer::Exception qw(:all);

use Encode;

@EXPORT_OK = qw(setting);

my $SETTINGS = {};

# mergeable settings
my %MERGEABLE = map { ($_ => 1) } qw( plugins handlers );
my %_LOADED;

sub settings {$SETTINGS}

my $setters = {
    logger => sub {
        my ($setting, $value) = @_;
        require Dancer::Logger;
        Dancer::Logger->init($value, settings());
    },
    log_file => sub {
        require Dancer::Logger;
        Dancer::Logger->init(setting("logger"), settings());
    },
    session => sub {
        my ($setting, $value) = @_;
        require Dancer::Session;
        Dancer::Session->init($value, settings());
    },
    template => sub {
        my ($setting, $value) = @_;
        require Dancer::Template;
        Dancer::Template->init($value, settings());
    },
    route_cache => sub {
        my ($setting, $value) = @_;
        require Dancer::Route::Cache;
        Dancer::Route::Cache->reset();
    },
    serializer => sub {
        my ($setting, $value) = @_;
        require Dancer::Serializer;
        Dancer::Serializer->init($value);
    },
    # This setting has been deprecated in favor of global_warnings.
    import_warnings => sub {
        my ($setting, $value) = @_;

         Dancer::Deprecation->deprecated(
             message => "import_warnings has been deprecated, please use global_warnings instead."
         );

        $^W = $value ? 1 : 0;
    },
    global_warnings => sub {
        my ($setting, $value) = @_;
        $^W = $value ? 1 : 0;
    },
    traces => sub {
        my ($setting, $traces) = @_;
        $Dancer::Exception::Verbose = $traces ? 1 : 0;
    },
};
$setters->{log_path} = $setters->{log_file};

my $normalizers = {
    charset => sub {
        my ($setting, $charset) = @_;
        length($charset || '')
          or return $charset;
        my $encoding = Encode::find_encoding($charset);
        defined $encoding
          or raise core_config => "Charset defined in configuration is wrong : couldn't identify '$charset'";
        my $name = $encoding->name;
        # Perl makes a distinction between the usual perl utf8, and the strict
        # utf8 charset. But we don't want to make this distinction
        $name eq 'utf-8-strict'
          and $name = 'utf-8';
        return $name;
    },
    session_same_site => sub {
        my ($setting, $same_site_setting) = @_;
        if ($same_site_setting =~ m{^(strict|lax|none)$}i) {
            return ucfirst lc $same_site_setting;
        } else {
            raise core_config => "Invalid session_same_site value $same_site_setting";
        }
    },
};

sub normalize_setting {
    my ($class, $setting, $value) = @_;

    $value = $normalizers->{$setting}->($setting, $value)
      if exists $normalizers->{$setting};

    return $value;
}

# public accessor for get/set
sub setting {
    if (@_ == 1) {
        return _get_setting(shift @_);
    }
    else {
        # can be useful for debug! Use Logger, instead?
        die "Odd number in 'set' assignment" unless scalar @_ % 2 == 0;

        my $count = 0;
        while (@_) {
            my $setting = shift;
            my $value   = shift;

            _set_setting  ($setting, $value);

            # At the moment, with any kind of hierarchical setter,
            # there is no case where the same trigger will be run more
            # than once. If/when a hierarchical setter is implemented,
            # we should create a list of the hooks that should be run,
            # and run them at the end of this while, only (efficiency
            # purposes).
            _trigger_hooks($setting, $value);
            $count++
        }
        return $count; # just to return anything, the number of items set.
    }
}

sub _trigger_hooks {
    my ($setting, $value) = @_;

    $setters->{$setting}->(@_) if defined $setters->{$setting};
}

sub _set_setting {
    my ($setting, $value) = @_;

    return unless @_ == 2;

    # normalize the value if needed
    $value = Dancer::Config->normalize_setting($setting, $value);
    $SETTINGS->{$setting} = $value;
    return $value;
}

sub _get_setting {
    my $setting = shift;

    return $SETTINGS->{$setting};
}

sub conffile { path(setting('confdir') || setting('appdir'), 'config.yml') }

sub environment_file {
    my $env = setting('environment');
    # XXX for compatibility reason, we duplicate the code from `init_envdir` here
    # we don't know how if some application don't already do some weird stuff like
    # the test in `t/15_plugins/02_config.t`.
    my $envdir = setting('envdir') || path(setting('appdir'), 'environments');
    return path($envdir, "$env.yml");
}

sub init_confdir {
    return setting('confdir') if setting('confdir');
    setting confdir => $ENV{DANCER_CONFDIR} || setting('appdir');
}

sub init_envdir {
    return setting('envdir') if setting('envdir');
    my $appdirpath = defined setting('appdir')                 ?
                     path( setting('appdir'), 'environments' ) :
                     path('environments');

    setting envdir => $ENV{DANCER_ENVDIR} || $appdirpath;
}

sub load {
    init_confdir();
    init_envdir();

    # look for the conffile
    return 1 unless -f conffile;

    # load YAML
    my $module = load_yaml_module();

    unless ($_LOADED{conffile()}) {
        load_settings_from_yaml(conffile, $module);
        $_LOADED{conffile()}++;
    }

    my $env = environment_file;

    # don't load the same env twice
    unless( $_LOADED{$env} ) {
        if (-f $env ) {
            load_settings_from_yaml($env, $module);
            $_LOADED{$env}++;
        }
        elsif (setting('require_environment')) {
            # failed to load the env file, and the main config said we needed it.
            confess "Could not load environment file '$env', and require_environment is set";
        }
    }

    foreach my $key (grep { $setters->{$_} } keys %$SETTINGS) {
        $setters->{$key}->($key, $SETTINGS->{$key});
    }
    if ( $SETTINGS->{strict_config} ) {
        $SETTINGS = hashref_to_object($SETTINGS);
    }

    return 1;
}

sub load_settings_from_yaml {
    my ($file, $module) = @_;

    $module ||= load_yaml_module();

    my $config;
    {
        no strict 'refs';
        $config = eval { &{ $module . '::LoadFile' }($file) }
        or confess "Unable to parse the configuration file: $file: $@";
    }

    $SETTINGS = Hash::Merge::Simple::merge( $SETTINGS, {
        map {
            $_ => Dancer::Config->normalize_setting( $_, $config->{$_} )
        } keys %$config
    } );

    return scalar keys %$config;
}

sub load_yaml_module {
    my ($module) = @_;

    $module ||= $SETTINGS->{engines}{YAML}{module} || 'YAML';

    my ( $result, $error ) = Dancer::ModuleLoader->load($module);
    confess "Could not load $module: $error"
        unless $result;

    return $module;
}

sub load_default_settings {
    $SETTINGS->{server}        ||= $ENV{DANCER_SERVER}        || '0.0.0.0';
    $SETTINGS->{port}          ||= $ENV{DANCER_PORT}          || '3000';
    $SETTINGS->{content_type}  ||= $ENV{DANCER_CONTENT_TYPE}  || 'text/html';
    $SETTINGS->{charset}       ||= $ENV{DANCER_CHARSET}       || '';
    $SETTINGS->{startup_info}  ||= !$ENV{DANCER_NO_STARTUP_INFO};
    $SETTINGS->{daemon}        ||= $ENV{DANCER_DAEMON}        || 0;
    $SETTINGS->{apphandler}    ||= $ENV{DANCER_APPHANDLER}    || 'Standalone';
    $SETTINGS->{warnings}      ||= $ENV{DANCER_WARNINGS}      || 0;
    $SETTINGS->{auto_reload}   ||= $ENV{DANCER_AUTO_RELOAD}   || 0;
    $SETTINGS->{traces}        ||= $ENV{DANCER_TRACES}        || 0;
    $SETTINGS->{server_tokens} ||= !$ENV{DANCER_NO_SERVER_TOKENS};
    $SETTINGS->{logger}        ||= $ENV{DANCER_LOGGER}        || 'file';
    $SETTINGS->{environment}   ||=
         $ENV{DANCER_ENVIRONMENT}
      || $ENV{PLACK_ENV}
      || 'development';

    setting $_ => {} for keys %MERGEABLE;
    setting template        => 'simple';
}

load_default_settings();

1;

__END__