imported initial version of youri svn

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;