lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / Config.pm

package Lire::Config;

use strict;

use vars qw/ $VERSION $PACKAGE $SINGLETON /;

use Lire::Config::Build qw(ac_info ac_path);

use Carp;

=pod

=head1 NAME

Lire::Config - import Lire configuration variables to perl

=head1 SYNOPSIS

 use Lire::Config;

 Lire::Config->init();

 my $cfg->value = Lire::Config->get( 'lr_schemas_path' );

 my $var = Lire::Config->get_var( 'lr_schemas_path' );

=head1 DESCRIPTION

This package provides the API to access the Lire configuration.

=head1 METHODS

These methods can be called directly on a Lire::Config instance or the
Lire::Config package itself. In the last case, it is the same thing
as calling the method on the object returned by the instance()
method.

=cut

$SINGLETON = new Lire::Config::XMLFilesConfig();

sub lire_program_config_init {
    $SINGLETON->init();
    init_vars();
}

sub init_vars {
    # VERSION does not hold this module's version, but the Lire version.
    # ($VERSION)        = '$Release:$' =~ m!Release: ([.\d]+)!;
    $VERSION        = ac_info('VERSION');

    $PACKAGE        = ac_info('PACKAGE');
}

=pod

=head2 instance()

Returns the singleton Lire::Config object from which configuration can
be queried.

=cut

sub instance {
    return $SINGLETON;
}

BEGIN {
    no strict 'refs';

    # Autogenerate methods which delegates to the singleton.
    foreach my $method ( qw/ init config_spec config_spec_path
                             add_config_spec_path_dir del_config_spec_path_dir
                             add_config_path
                             add_config_file del_config_file config_files
                             get_config_file
                             get get_var / )
      {
          *{$method} = sub { my $pkg = shift; $SINGLETON->$method( @_ ) };
      }
}

package Lire::Config::XMLFilesConfig;

use base qw/ Lire::Config /;

use Lire::Config::Parser;
use Lire::Config::SpecParser;
use Lire::Utils qw/ tilde_expand check_param /;
use Lire::Error qw/ directory_not_readable /;
use Lire::Config::Build 'ac_path';

use Carp;

sub new {
    my $proto = shift;
    my $class = ref( $proto ) || $proto;

    my $self = 
      bless {
             '_config_spec_dirs' => [ ac_path('datadir', 'PACKAGE') . "/config-spec" ],
             '_config_files' => [],
             '_parsed_config' => {},
             '_defaults' => undef,
             '_spec' => undef,
    }, $class;

    my @dirs = ( ac_path('datadir', 'PACKAGE') ."/defaults",
                 ac_path('sysconfdir', 'PACKAGE') . "/config",
                 tilde_expand( "~/.lire/config" )
               );

    foreach my $dir ( @dirs ) {
        next unless -d $dir;
        $self->add_config_path( $dir );
    }

    my $cfg_file = tilde_expand( "~/.lire/config.xml" );
    $self->add_config_file( $cfg_file )
      if -f $cfg_file;

    return $self;
}

=pod

=head2 config_spec()

Returns the configuration specification used by the current
configuration.

=cut

sub config_spec {
    my $self = $_[0];

    croak( "config_spec() called while configuration wasn't initialized" )
      unless $self->{'_spec'};

    return $self->{'_spec'};
}

=pod

=head2 config_spec_path()

Returns a list of directories which will be searched for configuration
specification file. By default, configuration specifications are only
looked for in F<<datadir>/lire/config-spec>.

=cut

sub config_spec_path {
    return @{$_[0]->{'_config_spec_dirs'}};
}

=pod

=head2 add_config_spec_path_dir( $dir )

This method adds a directory to list of directories that will is used
to search for configuration specification files.

=cut

sub add_config_spec_path_dir {
    my ( $self, $dir ) = @_;

    croak "missing 'dir' argument"
      unless $dir;

    unshift @{$self->{'_config_spec_dirs'}}, $dir;
    delete $self->{'_spec'};

    return;
}

=pod

=head2 del_config_spec_path_dir( $dir )

This method removes a directory from the list of directories that is
used to search for configuration specification files.

=cut

sub del_config_spec_path_dir {
    my ( $self, $dir ) = @_;

    croak "missing 'dir' argument"
      unless $dir;

    @{$self->{'_config_spec_dirs'}} =
      grep { $_ ne $dir } $self->config_spec_path();

    delete $self->{'_spec'};

    return;
}

=pod

=head2 config_files()

Returns the list of configuration files that will be used for this
configuration.

=cut

sub config_files {
    my ( $self, $dir ) = @_;

    return @{$self->{'_config_files'}}
}

sub _find_config_files {
    my $self = shift;

    my @files;

    foreach(@_) {
        if(-d) {
            opendir DIR, $_
              or croak directory_not_readable( $_ );
            my @ents = grep { !/^\./ } readdir DIR;
            closedir DIR;
            my $d = $_;
            push @files, map { "$d/$_" } $self->_find_config_files(@ents);
        } else {
            push @files, $_
              if !/^[.#]/ && /\.xml$/;
        }
    }

    return @files;
}

=pod

=head2 add_config_path( $path )

Adds configuration files to the list of files that are part of the
configuration. Directories will be scanned recursively.

=cut

sub add_config_path {
    my ( $self, $path ) = @_;

    check_param( $path, 'path' );

    foreach ( $self->_find_config_files( $path ) ) {
        $self->add_config_file( $_ );
    }

    return;
}

=pod

=head2 add_config_file( $file )

Adds a configuration file to the list of files that will be parsed to
initialize the configuration.

=cut

sub add_config_file {
    my ( $self, $file ) = @_;

    check_param( $file, 'file' );

    push @{$self->{'_config_files'}}, $file;
    $self->_load_config_file( $file ) if $self->{'_spec'};

    return;
}

=pod

=head2 del_config_file( $file )

Removes a configuration file from the list of files that are part of
the configuration.

=cut

sub del_config_file {
    my ( $self, $file ) = @_;

    check_param( $file, 'file' );

    @{$self->{'_config_files'}} = grep { $_ ne $file } $self->config_files();
    delete $self->{'_parsed_config'}{$file};

    return;
}

=pod

=head2 get_config_file($file)

Get a parsed configuration file object from the list of files.

=cut

sub get_config_file {
    my ( $self, $file ) = @_;

    check_param( $file, 'file' );

    croak("file '$file' is not a known configuration file")
      unless exists $self->{'_parsed_config'}{$file};

    return $self->{'_parsed_config'}{$file};
}

=pod

=head2 init()

This method loads and parses the configuration files. It should be called
prior to using the get() method to obtain configuration data. This
method will throw an exception in case there is an invalid
parameter in the configuration.

=cut

sub init {
    my $self = $_[0];

    return if $self->{'_spec'};

    $self->_load_spec();
    $self->_load_config_files();

    return;
}

=pod

=head2 get( $varname )

Returns the configuration value for the $varname configuration
variable. init() should have been called to load the configuration
data before using this method. It will croak() otherwise. If the
$varname is unknown, an exception will also be thrown.

=cut

sub get {
    return shift->get_var( @_ )->as_value();
}

=pod

=head2 get_var( $varname )

Returns the configuration value for the $varname configuration
variable as the configuration object. init() should have been called
to load the configuration data before using this method. It will
croak() otherwise. If the $varname is unknown, an exception will also
be thrown.

=cut

sub get_var {
    my ( $self, $name ) = @_;

    croak( "Configuration queried without initialization" )
      unless $self->{'_spec'};

    croak "No such configuration variable: $name"
      unless $self->{'_spec'}->has_component($name);

    foreach my $file ( reverse $self->config_files() ) {
        my $cfg = $self->{'_parsed_config'}{$file}->global();
        return $cfg->get( $name )
          if ( $cfg && $cfg->is_set( $name ) );
    }

    return $self->{'_defaults'}->get( $name );
}

sub _load_spec {
    my $self = $_[0];

    my $parser = new Lire::Config::SpecParser;
    foreach my $dir ( $self->config_spec_path() ) {
        $parser->merge_specifications_dir( $dir );
    }
    $self->{'_spec'} = $parser->configspec();
    $self->{'_defaults'} = $self->{'_spec'}->instance();

    return;
}

sub _load_config_files {
    my $self = $_[0];

    $self->{'_parsed_config'} = {};
    foreach my $file ( $self->config_files() ) {
        $self->_load_config_file( $file );
    }

    return;
}

sub _load_config_file {
    my ( $self, $file ) = @_;

    my $parser = new Lire::Config::Parser( 'spec' => $self->{'_spec'} );
    $self->{'_parsed_config'}{$file} = $parser->load_config_file( $file );

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 DEBUGGING

One can call this module direct from the commandline, e.g. for debugging
purposes, by doing something like:

 perl -e 'use lib "/path/to/your/share/perl5"; use Lire::Config; \
  use Lire::Program; print Lire::Config->get( "lr_mail_from" ), "\n"'

or

 perl -e 'use Lire::Config; use Lire::Program; \
  $a = Lire::Config->get( lr_converters_init_path );  print "@$a\n"; '

.

=head1 SEE ALSO

Lire::Config::TypeSpec(3pm), Lire::Config::Value(3pm)

=head1 AUTHORS

Wessel Dankers <wsl@logreport.org>
Francis J. Lacoste <flacoste@logreport.org>
Joost van Baal <joostvb@logreport.org>

=head1 VERSION

$Id: Config.pm,v 1.47 2006/07/23 13:16:28 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001-2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut