package Config;

use strict;
use warnings FATAL => 'all';

use File::Glob qw(:glob);
use YAML::Syck();

BEGIN {
    $YAML::Syck::ImplicitUnicode=1;
}

use Data::Dumper;

=head1 Config;

The first time you use() this module, must be used as:

  use Config '/path/to/config/directory';
  
In all other packages where you want the config available, just use as
+:

  use Config;
  
Always imports the function C() into your package, to allow you 
to access your configuration.

=cut

our $Config_Dir = '';
our $Config;

=head2 C()

Returns a value for the key indicated, or throws an error if
it is not defined.

     print C('namespace[.key1[.keyn]]'[,$config_variable);

The second parameter, if passed, is the config variable to search. If 
+not
passed, then the Config hash built from the config files will be searc
+hed.
     
=cut

#==========================================
sub C {
#==========================================
    my $path = shift||'';
    my ($config,$namespace,@keys);
    if (@_) {
        $config = $_[0];
        $namespace = "PRIVATE";
        @keys = split(/\./,$path);
    } else {
        ($namespace,@keys) = split(/\./,$path);
        $namespace||='';
        die ("Namespace '$namespace' not defined")
            unless $namespace && exists $Config->{$namespace};
        $config = $Config->{$namespace};
    }
    my $key_path = $namespace;
    foreach my $key (@keys) {
        next unless defined $key && length($key);
        if (ref $config eq 'ARRAY' && $key=~/^[0-9]+/ && exists $confi
+g->[$key]) {
            $config = $config->[$key];
            $key_path.='::'.$key;
            next;
        } elsif (ref $config && exists $config->{$key}) {
            $config = $config->{$key};
            $key_path.='::'.$key;
            next;
        }
        die ("Invalid key '$key' specified for $key_path : \n"
                        .Dumper($config));
    }
    
    return wantarray 
            ?   ref $config eq 'ARRAY' 
                ? (@$config)
                : ref $config eq 'HASH'
                    ? (%$config)
                    :  $config
            :   ($config);
                
}
    
=head2 copy_C()

Works just like C() but returns a ref to a private copy of the data ra
+ther than
a reference.  This means the data can be changed without changing the
version stored in Config.

This is not exported.

=cut

#==========================================
sub copy_C {
#==========================================
    my $data = C(@_);
    my $VAR1;
    return eval(Dumper($data));
}
    

=head2 load_config()

Store loaded config in %Config

=cut

#==========================================
sub load_config {
#==========================================
    $Config = _load_config();
}


=head2 _load_config()

Looks at all files called *.conf in the config directory and its
subdirectories and tries to parse them. The configuration in each 
file gets loaded into its own name space. A direcory name is
also considered a name space.

Directories are loaded before config files of the same name, so for
instance, you can have:

    confdir:
       syndication/
       --data_types/
         --traffic.conf
         --headlines.conf
       --data_types.conf
       syndication.conf
       
The config items in syndication.conf will be added to (or overwrite)
the items loaded into the syndication namespace via the subdirectory
called syndication.

In any sub-directory, you can have a file called local.conf which
is used for storing information local to this installation only.

This data will be merged with the existing data, but the namespace
must be specified in the local file.

For instance, if we have:

    confdir:
        db.conf
        local.conf
        
and db.conf has :

    connections:
        default_settings:
            host:       localhost
            table:      abc
            password:   123
            
And in local.conf:

    db:
        connections:
            default_settings:
                password:   456
                
the resulting configuration will look like this:

    db:
        connections:
            default_settings:
                host:       localhost
                table:      abc
                password:   456

=cut

#==========================================
sub _load_config {
#==========================================
    my $dir = shift || $Config_Dir;
    my $config = {};
    
    my @config_files = sort{$a cmp $b} grep {!/\/local.conf$/} glob($d
+ir."*");
    foreach my $config_file (@config_files) {
        my ($data,$name);
        if (-f $config_file && $config_file=~/\.conf$/) {
            $data = _load_config_file ($config_file);
            ($name) = ($config_file=~m|.*/(.*)\.conf$|);
        } elsif (-d $config_file) {
            $data = _load_config ($config_file.'/');
            ($name) = ($config_file=~m|.*/(.*)$|);
        } else {
            next;
        }
        if (exists $config->{$name}) {
            map {$config->{$name}->{$_} = $data->{$_}}
                keys %$data;
        } else {
            $config->{$name} = $data;
        }
    }
    if (-e $dir.'local.conf') {
        my $data = _load_config_file ($dir.'local.conf');
        $config = _merge_local($config,$data);
    }
    return $config;
}

=head2 _merge_local()

Used to merge local.conf files into the configuration.

=cut


#==========================================
sub _merge_local {
#==========================================
    my $config = shift;
    my $local = shift;
    foreach my $key (keys %$local) {
        if (ref $local->{$key} eq 'HASH'
            && exists $config->{$key}) {
            $config->{$key} = _merge_local ($config->{$key},$local->{$
+key});
        } else {
            $config->{$key} = $local->{$key}
        }
    }
    return $config;
}



=head2 _load_config_file()

Parses the YAML file and throws an error if it is not correctly 
formatted


=cut

#==========================================
sub _load_config_file {
#==========================================
    my $config_file = shift;
    my $data;
    eval {
        $data = YAML::Syck::LoadFile($config_file);
    };
    if ($@) {
        die ("Error loading config file $config_file:\n\n"
                        .$@);        
    };

    return $data;
}

=head2 import()

Used to set config directory the first time this module is loaded.
The config directory cannot be changed by subsequent uses;

Also exports the function C() into the namespace in which it
is being used.

=cut

#==========================================
sub import {
#==========================================
    shift;
    
    my $callpkg = caller(0);
    no strict 'refs';
    *{$callpkg."::C"} = \&C;
    use strict;

    # If we have already loaded this module correctly, do nothing
    return 1 if $Config_Dir;
    
 
    my $dir = shift;
    if ($dir && -d $dir && -r _) {
    
        $dir=~s|/?$|/|;
        $Config_Dir = $dir;
        load_config();
            
        return 1;   
    }
    
    my @caller = caller (1);
    
    die <<ERROR
        
FATAL ERROR LOADING Config

    The default configuration directory must be specified the
    first time that Config is loaded.
    
        use Config '/path/to/config_dir';

    Error in : Package "$caller[0]", Filename "$caller[1]", Line $call
+er[2];
    
ERROR
        
}

1
[download]