UR::ModuleConfig - manage dynamic configuration of modules.

UR documentation Contained in the UR distribution.

Index

Code Index:

NAME

Top

UR::ModuleConfig - manage dynamic configuration of modules.

SYNOPSIS

Top

  package MyModule;
  use base qw(UR::ModuleConfig);

  MyModule->config(%conf);
  $val = MyModule->config('key');
  %conf = MyModule->config;

DESCRIPTION

Top

This module manages the configuration for modules. Configurations can be read from files or set dynamically. Modules wishing to use the configuration methods should inherit from the module.

METHODS

The methods deal with managing configuration.

config
  MyModule->config(%config);
  $val = MyModule->config('key');
  %conf = MyModule->config;

  my $obj = MyModule->new;
  $obj->config(%config);

This method can be called three ways, as either a class or object method. The first method takes a hash as its argument and sets the configuration parameters given in the hash. The second method takes a single argument which should be one of the keys of the hash that set the config parameters and returns the value of that config hash key. The final method takes no arguments and returns the entire configuration hash.

When called as an object method, the config for both the object and all classes in its inheritance hierarchy are referenced, with the object config taking precedence over class methods and class methods closer to the object (first in the @ISA array) taking precendence over those further away (later in the @ISA array). When called as a class method, the same procedure is used, except no object configuration is referenced.

Do not use configuration keys that begin with an underscore (_). These are reserved for internal use.

check_config
  $obj->check_config($key);

This method checks to see if a value is set. Unlike config, it does not issue a warning if the key is not set. If the key is not set, undef is returned. If the key has been set, the value of the key is returned (which may be undef).

default_config
  $class->default_config(%defaults);

This method allows the developer to set configuration values, only if they are not already set.

config_file
  $rv = $class->config_file(path => $path);
  $rv = $class->config_file(handle => $fh);

This method reads in the given file and expects key-value pairs, one per line. The key and value should be separated by an equal sign, =, with optional surrounding space. It currently only handles single value values.

The method returns true upon success, undef on failure.

UR documentation Contained in the UR distribution. 
# Manage dynamic configuration of modules.

package UR::ModuleConfig;


# set up package
require 5.6.0;
use warnings;
use strict;
our $VERSION = $UR::VERSION;;
use base qw(UR::ModuleBase);
use IO::File;


# hash containing all configuration information
our %config;

# create a combined configuration hash from inheritance tree
sub _inherit_config
{
    my $self = shift;
    my $class = ref($self) || $self;

    my %cfg;

    # get all packages inherited from
    my @inheritance = $self->inheritance;

    # reverse loop through inheritance tree and construct config
    foreach my $cls (reverse(@inheritance))
    {
        if (exists($config{$cls}))
        {
            # add hash, overriding previous values
            %cfg = (%cfg, %{$config{$cls}});
        }
    }

    # now add the current class config
    if (exists($config{$class}))
    {
        %cfg = (%cfg, %{$config{$class}});
    }

    # now add the object config
    if (ref($self))
    {
        # add the objects config
        if (exists($config{"$class;$self"}))
        {
            %cfg = (%cfg, %{$config{"$class;$self"}});
        }
    }

    return %cfg;
}


sub config
{
    my $self = shift;
    my $class = ref($self) || $self;

    # handle both object and class configuration
    my $target;
    if (ref($self))
    {
        # object config
        $target = "$class;$self";
    }
    else
    {
        # class config
        $target = $self;
    }

    # lay claim to the modules configuration
    $config{$target}{_Manager} = __PACKAGE__;

    # see if values are being set
    if (@_ > 1)
    {
        # set values in config hash, overriding any current values
        my (%opts) = @_;
        %{$config{$target}} = (%{$config{$target}}, %opts);
        return 1;
    }
    # else they want one key or the whole hash

    # store config for object and inheritance tree
    my %cfg = $self->_inherit_config;

    # see how we were called
    if (@_ == 1)
    {
        # return value of key
        my ($key) = @_;
        # make sure hash key exists
        my $val;
        if (exists($cfg{$key}))
        {
            $self->debug_message("config key $key exists", 4);
            $val = $cfg{$key};
        }
        else
        {
            $self->error_message("config key $key does not exist");
            return;
        }
        return $val;
    }
    # else return the entire config hash
    return %cfg;
}


sub check_config
{
    my $self = shift;

    my ($key) = @_;

    # get config for inheritance tree
    my %cfg = $self->_inherit_config;

    if (exists($cfg{$key}))
    {
        $self->debug_message("configuration key $key set: $cfg{$key}", 4);
        return $cfg{$key};
    }
    # else
    $self->debug_message("configuration key $key not set", 4);
    return;
}


sub default_config
{
    my $self = shift;

    my (%opts) = @_;

    # get config for inheritance tree
    my %cfg = $self->_inherit_config;

    # loop through arguments
    while (my ($k, $v) = each(%opts))
    {
        # see is config value is already set
        if (exists($cfg{$k}))
        {
            $self->debug_message("config $k already set", 5);
            next;
        }
        $self->debug_message("setting default for $k", 5);

        # set config key
        $self->config($k => $v);
    }

    return 1;
}


sub config_file
{
    my $self = shift;

    my (%opts) = @_;

    my $fh;
    if ($opts{path})
    {
        # make sure file is ok
        if (-f $opts{path})
        {
            $self->debug_message("config file exists: $opts{path}", 4);
        }
        else
        {
            $self->error_message("config file does not exist: $opts{path}");
            return;
        }
        if (-r $opts{path})
        {
            $self->debug_message("config file is readable: $opts{path}", 4);
        }
        else
        {
            $self->error_message("config file is not readable: $opts{path}");
            return;
        }

        # open file
        $fh = IO::File->new("<$opts{path}");
        if (defined($fh))
        {
            $self->debug_message("opened config file for reading: $opts{path}",
                                 4);
        }
        else
        {
            $self->error_message("failed to open config file for reading: "
                                 . $opts{path});
            return;
        }
    }
    elsif ($opts{handle})
    {
        $fh = $opts{handle};
    }
    else
    {
        $self->error_message("no config file input specified");
        return;
    }

    # read through file
    my %fconfig;
    while (defined(my $line = $fh->getline))
    {
        # clean up
        chomp($line);
        $line =~ s/\#.*//;
        $line =~ s/^\s*//;
        $line =~ s/\s*$//;
        next unless $line =~ m/\S/;

        # parse
        my ($k, $v) = split(m/\s*=\s*/, $line, 2);
        $fconfig{$k} = $v;
    }
    $fh->close;

    # update config
    return $self->config(%fconfig);
}

1;

#$Header$