diff options
Diffstat (limited to 'lib/Youri/Config.pm')
| -rw-r--r-- | lib/Youri/Config.pm | 235 |
1 files changed, 235 insertions, 0 deletions
diff --git a/lib/Youri/Config.pm b/lib/Youri/Config.pm new file mode 100644 index 0000000..dab63aa --- /dev/null +++ b/lib/Youri/Config.pm @@ -0,0 +1,235 @@ +# $Id: Config.pm 961 2006-07-11 09:56:51Z guillomovitch $ +package Youri::Config; + +=head1 NAME + +Youri::Config - Youri configuration handler + +=head1 SYNOPSIS + + use Youri::Config; + + my $config = Youri::Config->new( + command_spec => [ + 'help|h!', + ], + file_spec => [ + 'foo=s', + ], + directories => [ '/etc/youri', "$ENV{HOME}/.youri" ], + file_name => 'app.conf', + caller => $0, + ); + + # get configuration directive + my $foo = $config->get('foo'); + + # get configuration section + my %bar = $config->get_section('bar'); + +=head1 DESCRIPTION + +This class handle configuration for all YOURI tools. + +It uses distinct command line and config files specification, but merges the +two inputs transparently, command line directives overriding config file +directives with the same name. + +Given directories are scanned for a file with given name, and only the first +one found is used. If B<--config> argument is given on command line, no +scanning occurs. If no readable file is found, an exception is thrown. + +==head1 FORMAT + +The file format used is the one from AppConfig, with the additional ability to +use YAML. Here is an exemple configuration file: + + [updates] + class = Youri::Check::Check::Updates + grabbers = <<EOF + --- #YAML:1.0 + debian: + class: Youri::Check::Check::Updates::Debian + aliases: + fuse: ~ + cpan: + class: Youri::Check::Check::Updates::CPAN + fedora: + class: Youri::Check::Check::Updates::Fedora + gentoo: + class: Youri::Check::Check::Updates::Gentoo + freshmeat: + class: Youri::Check::Check::Updates::Freshmeat + aliases: + fuse: fuse-emulator + EOF + +As a side-effect of using YAML, the use of character '~' anywhere is prohibited. +Use ${HOME} instead. + +=head1 SEE ALSO + +AppConfig, YAML + +=cut + +use strict; +use warnings; +use AppConfig qw/:argcount :expand/; +use File::Spec; +use Pod::Usage; +use Carp; +use YAML; + +sub new { + my ($class, %options) = @_; + + my ($command_config, $file_config); + + # process command line + if ($options{command_spec}) { + $command_config = AppConfig->new( + { + CREATE => 1, + GLOBAL => { + DEFAULT => '', + EXPAND => EXPAND_VAR | EXPAND_ENV, + ARGCOUNT => ARGCOUNT_ONE, + } + }, + @{$options{command_spec}} + ); + $command_config->args(); + + pod2usage( + -input => $options{caller}, + -verbose => 0 + ) if $command_config->get('help'); + } + + # process config file + $file_config = AppConfig->new( + { + CREATE => 1, + GLOBAL => { + DEFAULT => '', + EXPAND => EXPAND_VAR | EXPAND_ENV, + ARGCOUNT => ARGCOUNT_ONE, + } + }, + @{$options{file_spec}} + ); + + # find configuration file to use + my $main_file; + + if ($command_config) { + my $file = $command_config->get('config'); + if ($file) { + if (! -f $file) { + carp "Non-existing file $file, skipping"; + } elsif (! -r $file) { + carp "Non-readable file $file, skipping"; + } else { + $main_file = $file; + } + }; + } + + unless ($main_file) { + foreach my $directory (@{$options{directories}}) { + my $file = "$directory/$options{file_name}"; + next unless -f $file && -r $file; + $main_file = $file; + last; + } + } + + croak 'No config file found, aborting' unless $main_file; + $file_config->file($main_file); + + # process inclusions + my $need_rescan; + foreach my $include_file (split(/\s+/, $file_config->get('includes'))) { + # convert relative path to absolute ones + $include_file = File::Spec->rel2abs( + $include_file, (File::Spec->splitpath($main_file))[1] + ); + + if (! -f $include_file) { + warn "Non-existing file $include_file, skipping"; + } elsif (! -r $include_file) { + warn "Non-readable file $include_file, skipping"; + } else { + $file_config->file($include_file); + $need_rescan = 1; + } + } + + $file_config->file($main_file) if $need_rescan; + + # merge command line configuration + if ($command_config) { + my %command_vars = $command_config->varlist('.*'); + while (my ($key, $value) = each %command_vars) { + $file_config->set($key, $value); + } + } + + my $self = bless { + _appconfig => $file_config + }, $class; + + return $self; +} + +=head2 get_section($id) + +Simple wrapper around $config->varlist(), throwing a warning if section I<$id> doesn't exists. + +=cut + +sub get_section { + my ($self, $id) = @_; + croak "Not a class method" unless ref $self; + + my %values = $self->{_appconfig}->varlist('^' . $id . '_', 1); + + carp "No such section $id" unless %values; + + foreach my $value (values %values) { + $value = _yamlize($value); + } + + return %values; +} + +sub get { + my ($self, $variable) = @_; + croak "Not a class method" unless ref $self; + + return _yamlize($self->{_appconfig}->get($variable)); +} + +sub _yamlize { + my ($value) = @_; + + if ($value =~ /^--- #YAML:1.0/) { + eval { + $value = Load($value . "\n"); + }; + $value = undef if $@; + } + + return $value; +} + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2002-2006, YOURI project + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; |