—package
Acrux::Config;
use
strict;
use
utf8;
=encoding utf8
=head1 NAME
Acrux::Config - Config::General Configuration of Acrux
=head1 SYNOPSIS
use Acrux::Config;
my $config = Acrux::Config->new(
file => '/etc/myapp.conf',
);
say $config->get('foo');
=head1 DESCRIPTION
The module works with the configuration using L<Config::General>
All getters of this class are allows get access to configuration parameters by path-pointers.
See L<Acrux::Pointer> and L<RFC 6901|https://tools.ietf.org/html/rfc6901>
=head2 new
my $config = Acrux::Config->new(
file => '/etc/myapp.conf',
default => {foo => 'bar'},
);
=head1 ATTRIBUTES
This plugin supports the following attributes
=head2 default
default => {foo => 'bar'}
Default configuration data
=head2 dirs
dirs => ['/etc/foo', '/etc/bar']
Paths to additional directories of config files
=head2 file
file => '/etc/foo.stuff'
Path to configuration file, absolute or relative, defaults to the value of the
C<$0.conf> in the current directory
=head2 noload
noload => 1
This attribute disables loading config file
=head2 options
options => {'-AutoTrue' => 0}
Sets the L<Config::General> options directly
=head2 root
root => '/etc/myapp'
Sets the root directory to configuration files and directories location
=head1 METHODS
This plugin implements the following methods
=head2 array, list
dumper $config->array('/foo'); # ['first', 'second', 'third']
# ['first', 'second', 'third']
dumper $config->array('/foo'); # 'value'
# ['value']
Returns an array of found values from configuration
=head2 config, conf
my $config_hash = $config->config; # { ... }
This method returns config structure directly as hash ref
=head2 error
my $error = $config->error;
Returns error string if occurred any errors while creating the object or reading the configuration file
=head2 first
say $config->first('/foo'); # ['first', 'second', 'third']
# first
Returns an first value of found values from configuration
=head2 get
say $config->get('/datadir');
Returns configuration value by path
=head2 hash, object
dumper $config->hash('/foo'); # { foo => 'first', bar => 'second' }
# { foo => 'first', bar => 'second' }
Returns an hash of found values from configuration
=head2 latest
say $config->latest('/foo'); # ['first', 'second', 'third']
# third
Returns an latest value of found values from configuration
=head2 load
my $config = $config->load;
Loading config files
=head2 pointer
my $pointer = $config->pointer;
Returns current L<Acrux::Pointer> object
=head1 HISTORY
See C<Changes> file
=head1 TO DO
See C<TODO> file
=head1 SEE ALSO
L<Config::General>, L<Acrux::Pointer>
=head1 AUTHOR
Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>
=head1 COPYRIGHT
Copyright (C) 1998-2024 D&D Corporation. All Rights Reserved
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See C<LICENSE> file and L<https://dev.perl.org/licenses/>
=cut
our
$VERSION
=
'0.02'
;
use
Acrux::Pointer;
'-ApacheCompatible'
=> 1,
# Makes possible to tweak all options in a way that Apache configs can be parsed
'-LowerCaseNames'
=> 1,
# All options found in the config will be converted to lowercase
'-UTF8'
=> 1,
# All files will be opened in utf8 mode
'-AutoTrue'
=> 1,
# All options in your config file, whose values are set to true or false values, will be normalised to 1 or 0 respectively
};
sub
new {
my
$class
=
shift
;
my
$args
=
@_
?
@_
> 1 ? {
@_
} : {%{
$_
[0]}} : {};
my
$self
=
bless
{
default
=>
$args
->{defaults} ||
$args
->{
default
} || {},
file
=>
$args
->{file} //
''
,
root
=>
$args
->{root} //
''
,
# base path to default files/directories
dirs
=>
$args
->{dirs} || [],
noload
=>
$args
->{noload} || 0,
options
=> {},
error
=>
''
,
config
=> {},
pointer
=> Acrux::Pointer->new,
files
=> [],
orig
=>
$args
->{options} ||
$args
->{opts} || {},
},
$class
;
my
$myroot
=
length
(
$self
->{root}) ?
$self
->{root} : getcwd();
# Set dirs
my
@dirs
= ();
foreach
my
$dir
(as_array(
$self
->{dirs})) {
unless
(File::Spec->file_name_is_absolute(
$dir
)) {
# rel
$dir
=
length
(
$myroot
)
? File::Spec->rel2abs(
$dir
,
$myroot
)
: File::Spec->rel2abs(
$dir
);
}
push
@dirs
,
$dir
if
-e
$dir
;
}
$self
->{dirs} = [
@dirs
];
# Set config file
my
$file
=
$self
->{file};
$file
=
sprintf
(
"%s.conf"
, basename($0))
unless
length
$file
;
unless
(File::Spec->file_name_is_absolute(
$file
)) {
# rel
$file
=
length
(
$myroot
)
? File::Spec->rel2abs(
$file
,
$myroot
)
: File::Spec->rel2abs(
$file
);
}
$self
->{file} =
$file
;
unless
(
$self
->{noload}) {
unless
(-r
$file
) {
$self
->{error} =
sprintf
(
"Configuration file \"%s\" not found or unreadable"
,
$file
);
return
$self
;
}
}
# Config::General Options
my
$orig
=
$self
->{orig};
$orig
= {}
unless
is_hash_ref(
$orig
);
my
%options
= (%{DEFAULT_CG_OPTS()},
%$orig
);
# Merge everything
$options
{
'-ConfigFile'
} =
$file
;
$options
{
"-ConfigPath"
} ||= [
@dirs
]
if
scalar
(
@dirs
);
$self
->{options} = {
%options
};
# Load
return
$self
if
$self
->{noload};
return
$self
->load;
}
sub
default
{
my
$self
=
shift
;
if
(
scalar
(
@_
) >= 1) {
$self
->{
default
} =
shift
;
return
$self
;
}
return
$self
->{
default
};
}
sub
error {
my
$self
=
shift
;
if
(
scalar
(
@_
) >= 1) {
$self
->{error} =
shift
;
return
$self
;
}
return
$self
->{error};
}
sub
file {
my
$self
=
shift
;
if
(
scalar
(
@_
) >= 1) {
$self
->{file} =
shift
;
return
$self
;
}
return
$self
->{file};
}
sub
dirs {
my
$self
=
shift
;
if
(
scalar
(
@_
) >= 1) {
$self
->{dirs} =
shift
;
return
$self
;
}
return
$self
->{dirs};
}
sub
pointer {
shift
->{pointer} }
sub
load {
my
$self
=
shift
;
my
$opts
=
$self
->{options};
$self
->{error} =
""
;
# Load
my
$cfg
=
eval
{ Config::General->new(
%$opts
) };
return
$self
->error(
sprintf
(
"Can't load configuration from file \"%s\": %s"
,
$self
->file, $@))
if
$@;
return
$self
->error(
sprintf
(
"Configuration file \"%s\" did not return a Config::General object"
,
$self
->file))
unless
ref
$cfg
eq
'Config::General'
;
my
%config
=
$cfg
->getall;
my
@files
=
$cfg
->files;
# Merge defaults
my
$defaults
=
$self
->
default
|| {};
%config
= (
%$defaults
,
%config
)
if
is_hash_ref(
$defaults
) &&
scalar
keys
%$defaults
;
# Add system values
$config
{
'_config_files'
} = [
@files
];
$config
{
'_config_loaded'
} =
scalar
@files
;
# Set config data
$self
->{config} = {
%config
};
# hash data
$self
->pointer->data(clone(
$self
->{config}));
return
$self
;
}
sub
config {
my
$self
=
shift
;
my
$key
=
shift
;
return
undef
unless
$self
->{config};
return
$self
->{config}
unless
defined
$key
and
length
$key
;
return
$self
->{config}->{
$key
};
}
sub
conf {
goto
&config
}
sub
get {
my
$self
=
shift
;
my
$key
=
shift
;
return
$self
->pointer->get(
$key
);
}
sub
first {
my
$self
=
shift
;
return
undef
unless
defined
(
$_
[0]) &&
length
(
$_
[0]);
my
$node
=
$self
->pointer->get(
$_
[0]);
if
(is_array_ref(
$node
)) {
# Array ref
return
exists
(
$node
->[0]) ?
$node
->[0] :
undef
;
}
elsif
(is_value(
$node
)) {
# Scalar value
return
$node
;
}
return
undef
;
}
sub
latest {
my
$self
=
shift
;
return
undef
unless
defined
(
$_
[0]) &&
length
(
$_
[0]);
my
$node
=
$self
->pointer->get(
$_
[0]);
if
(is_array_ref(
$node
)) {
# Array ref
return
exists
(
$node
->[0]) ?
$node
->[-1] :
undef
;
}
elsif
(is_value(
$node
)) {
# Scalar value
return
$node
;
}
return
undef
;
}
sub
array {
my
$self
=
shift
;
return
undef
unless
defined
(
$_
[0]) &&
length
(
$_
[0]);
my
$node
=
$self
->pointer->get(
$_
[0]);
if
(is_array_ref(
$node
)) {
# Array ref
return
$node
;
}
elsif
(
defined
(
$node
)) {
return
[
$node
];
}
return
[];
}
sub
list {
goto
&array
}
sub
hash {
my
$self
=
shift
;
return
undef
unless
defined
(
$_
[0]) &&
length
(
$_
[0]);
my
$node
=
$self
->pointer->get(
$_
[0]);
return
$node
if
is_hash_ref(
$node
);
return
{};
}
sub
object {
goto
&hash
}
1;
__END__