The name of the file or subdirectory is used as the first key. So:

    global.conf:
        username : admin
        password : 12345
[download]

would be stored as :

    $Config = {
                global => {
                            username => 'admin',
                            password => '12345',
                          }
              }
[download]

    confdir:
       syndication/
       --data_types/
         --traffic.conf
         --headlines.conf
       --data_types.conf
       syndication.conf
[download]

    confdir:
        db.conf
        local.conf
[download]

    connections:
        default_settings:
            host:       localhost
            table:      abc
            password:   123
[download]

    db:
        connections:
            default_settings:
                password:   456
[download]

    db:
        connections:
            default_settings:
                host:       localhost
                table:      abc
                password:   456
[download]

  file: MyApp/Config.pm:
  ----------------------
      package MyApp::Config;
      use base 'Burro::Config';

  file: (eg) startup.pl:
  ----------------------
      ## package main;
      # this loads the configuration data from the provided directory
      # the dir is only ever specified once
      use MyApp::Config '/path/to/config/dir';

  file: MyApp/Other/Module.pm
  ---------------------------
      package MyApp::Other::Module;

      # this imports the sub C() into the current package to give acce
+ss
      # to the configuration data

      use MyApp::Config;            

      @dbs = C('db.server_pool");
[download]

However, for the purposes of trying the module out, if you would like to avoid creating a separate file to subclass Burro::Config, you could do the following:

    package MyApp::Config; 

        our @ISA=('Burro::Config');
        use Burro::Config();

    package main; 
        use lib ('/path/to/Burro');
        MyApp::Config->import('/opt/apache/sites/iAnnounce/config');

        # normally wouldn't want C() to be exported package main
        # but for testing purposes
        MyApp::Config->import();

        print C('my.config.value');
[download]

package Burro::Config;

use strict;
use warnings FATAL => 'all', NONFATAL => 'redefine';

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

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

use Storable();
use Data::Alias qw(deref);

=head1 NAME

Burro::Config - access configuration data across your application

=head1 SYNOPSIS

  -------------------------
  file: MyApp/Config.pm:
    package MyApp::Config;
    use base 'Burro::Config';

  file: (eg) startup.pl:
      # package main;
      use MyApp::Config '/path/to/config/dir';

  file: MyApp/Other/Module.pm;
      package MyApp::Other::Module;
      use MyApp::Config;

      @dbs = C('db.server_pool");
  -------------------------

  $dbs = MyApp::Config::copy_C('db.server_pool');
  ($value,$label) = MyApp::Config->value_label('uk "United Kingdom");

=head1 DESCRIPTION

Burro::Config is a configuration module which has five aims:

=over

=item *

Store all configuration in an easy to read (see L<YAML>) format with
a flexible structured layout. See L</"Config file layout">

=item *

Provide a simple, easy to read, concise way of accessing the configura
+tion values.
See L</"Using config in applications">

=item *

Specify the location of the configuration files only once per
application, so that it requires minimal effort to relocate.
See L</"Implementing Burro::Config">

=item *

Allow different applications (eg web sites in mod_perl) each to have t
+heir own configuration
data, without having to pass an object around.

=item *

Provide a way for overriding configuration values on a particular
machine, so that differences between (eg) the dev environment and
the live environment do not get copied over accidentally.
See L</"Overriding config locally">

=item *

Load all config at startup so that (eg in the mod_perl environment) th
+e
data is shared between all child processes. See L</"Using config in ap
+plications">

=back

=head2 Implementing Burro::Config

Burro::Config is never used directly by applications.  It should alway
+s
be subclassed.  The configuration data gets stored in the subclassing 
+module.

    package MyApp::Config;
    use base 'Burro::Config';

    package MyApp::Other::Module;
    use MyApp::Config;

Only C<MyApp::Config> uses C<Burro::Config> directly.  All the other
modules which require access to the config data use C<MyApp::Config>.

B<Important :> Whenever either C<Burro::Config> or C<MyApp::Config> ar
+e
'use'd, they should not be followed by empty parentheses.  Their
functionality relies on C<sub import()> being called. So:

    use Burro::Config;

NOT

    use Burro::Config();

=head2 Config file layout

Burro::Config uses L<YAML> for its configuration files.

Configuration files can be stored in their own directory tree
or mixed up with other files (but why would you do this?).  When
loading your config data, Burro::Config starts at the directory
specified at startup (see L</"Using config in applications">) and look
+s
for any file ending in C<.conf> and at any subdirectories.

The name of the file or subdirectory is used as the first key.  So:

    global.conf:
        username : admin
        password : 12345

would be stored as :

    $Config = {
                global => {
                            username => 'admin',
                            password => '12345',
                          }
              }

Subdirectories are processed before the current directory, so
you can have a directory and a config file with the same name,
and the values will be merged into a single hash, 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.

=head2 Overriding config locally

The situation often arises where it is necessary to specify
different config values on different machines. For instance,
the database host on a dev machine may be different from the host
on the live application.

Instead of changing this data during dev and then having to remember
to change it back before putting the new code live, we have a mechanis
+m
for overriding config locally in a C<local.conf> file and then, as lon
+g as
that file never gets uploaded to live, you are protected.

You can put a file called C<local.conf> in any sub-directory, and
the data in this file will be merged with the existing data.

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

=head2 Using config in applications

=over

=item Specifying the config directory

The config directory can only be specified once, the very first time
that C<MyApp::Config> is 'use'd.  For instance:

    use MyApp::Config '/opt/myapp/config';

This statement causes the config files in that directory and sub-direc
+tories
to be loaded.

Every other module which needs access to the config, just needs:

    use MyApp::Config;    # NOTE : no parenthese ()

=item Refering to config

Whenever C<use MyApp::Config;> is used in a module, the function C<C()
+>
is imported into the module's namespace.

The config values can be accessed with dot notation, as in :

    $value = C('key1.key2.keyn');
    $password = C('db.connections.default_settings.password');

C<key> can be the key of a hash, or the index of an array.

    $host3 = C('db.server_pool.2');

The return value is context-sensitive. If a scalar, it will return a s
+calar.
If the value is an array or a hash, then it will return a ref if calle
+d in
scalar context, or the array or hash if called in list context.

    $hosts_array_ref = C('db.server_pool');
    @hosts = C('db.server_pool');

If the specified key is not found, then an error is thrown.

=back

=head1 METHODS

=over

=item C<new()>

    $conf = Burro::Config->new($config_dir);

new() instantiates a config object, loads the config from
the directory specified, and returns the object.

You should never need to call it specifically - this happens
automatically when a subclass inherits from this module.

=cut

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

    my $self = { _memo => {} };
    bless( $self, $class );

    my $dir = shift || '';
    if ( $dir && -d $dir && -r _ ) {

        $dir =~ s|/?$|/|;
        $self->{config_dir} = $dir;
        $self->load_config();

        return $self;
    }
    else {
        $class->error(
            'Configuration directory not specified when creating a new
+ config object'
        );
    }
    return $self;
}

=item C<C()>

  $val = $self->C('key1.key2.keyn');
  $val = $self->C('key1.key2.keyn',$hash_ref);

OR, more usually, in a module that inherits from this

  $val = C('key1.key2.keyn');
  $val = C('key1.key2.keyn',$hash_ref);

C() is used for accessing a configuration value stored either
internally in a hash_ref in the module that inherits from this module,
or passed in in the parameter list.

Normally, the user will only ever use C() as a function and not
as a method, because the modules that end up 'use'ing this module
have the function C() exported to their namespace.

'key1.key2.keyn' is just a simpler way of writing:

  $C->{key1}->{key2}->{keyn}
  $$C{key1}{key2}{keyn}

OR (eg)

  $C->{key1}->[2]->{keyn}
  $$C{key1}[2]{keyn}

The return values are context-sensitive, so if called
in list context, a list will be returned, otherwise an array_ref or
a hash_ref will be returned. A scalar value will always be returned
as a scalar.

So for example:

  $password = C('database.main.password');

  @countries = C('lists.countries');
  $countries_array_ref = C('lists.countries');

  etc

=cut

#==========================================
sub C {
#==========================================
    my $self = shift;
    my $path = shift;
    $path = '' unless defined $path;

    my ( $config, @keys );

    # If a private hash is passed in use that
    if (@_) {
        $config = $_[0];
        @keys   = split( /\./, $path );
        $config = $self->_walk_path( $config, 'PRIVATE', \@keys );
    }

    # Otherwise use the stored config data
    else {

        # Have we previously memoised this?
        if ( exists $self->{_memo}->{$path} ) {
            $config = deref $self->{_memo}->{$path};
        }

        # Not memoised, so get it manually
        else {
            $config = $self->{config};
            (@keys) = split( /\./, $path );
            $config = $self->_walk_path( $config, '', \@keys );
            $self->{_memo}->{$path} = \$config;
        }
    }
    return wantarray && ref $config
        ? ( deref $config)
        : $config

}

=item C<_walk_path()>

=cut

#===================================
sub _walk_path {
#===================================
    my $self = shift;
    my ( $config, $key_path, $keys ) = @_;

    foreach my $key (@$keys) {
        next unless defined $key && length($key);
        if (    ref $config eq 'ARRAY'
             && $key =~ /^[0-9]+/
             && exists $config->[$key] )
        {
            $config = $config->[$key];
            $key_path .= '.' . $key;
            next;
        }
        elsif ( ref $config eq 'HASH' && exists $config->{$key} ) {
            $config = $config->{$key};
            $key_path .= '.' . $key;
            next;
        }
        $self->error("Invalid key '$key' specified for '$key_path'\n")
+;
    }
    return $config;
}

=item C<copy_C()>

This works exactly the same a L</"C()"> but it performs a
deep clone of the data before returning it.

This means that the returned data can be changed without
affecting the data stored in the $conf object;

The data is deep cloned, using Storable, so the bigger the data, the m
+ore
performance hit.  That said, Storable's dclone is very fast.

=cut

#==========================================
sub copy_C {
#==========================================
    my $self = shift;
    my $data = $self->Burro::Config::C(@_);
    return Storable::dclone($data);
}

=item C<value_label()>

    ($value,$label) = MyApp::Config->value_label('value "Label"');

This is a convenience method for storing key/value pairs
in a scalar...  Easier by example:

For instance, when generating a list of values for a
drop down list in a form, there are 3 bits of information:

=over

=item * The descriptive text e.g. 'Spain'

=item * The value e.g. 'es'

=item * The order

=back

So the values for this drop down list could be specified
in YAML as follows:

  countries:
     - eg   "Egypt"
     - es   "Spain"
     - fr   "France"
     - uk

Because, in the above example, 'uk' doesn't have a label
specified, C<value_label('uk')> would return ('uk','uk')

The label must be enclosed between double quotes, and
double quotes can be embedded within the label without escaping
them.

The value (or key) cannot contain double quotes.

=cut

#==========================================
sub value_label {
#==========================================
    my $self = shift;
    my $data = shift || '';
    my ( $value, $label ) = ( $data =~ /^(.*?)\s*(?:"(.+)")?$/ );
    $label ||= $value;
    return ( $value, $label );
}

=item C<load_config()>

Public method for loading (or reloading) the config files located
in the directory specified at object creation (see L</"new()">).

Returns the config hash ref.

=cut

#==========================================
sub load_config {
#==========================================
    my $self = shift;
    return $self->{config} = $self->_load_config();
}

=item C<_load_config()>

    $hash_ref = $self->_load_config([$directory]);

Private method that starts in the config directory specified
at object creation (see L</"new()">) and recurses through all the
sub-directories, looking for C<*.conf> files. Also, see L</"Config fil
+e layout">.

Returns the config hash_ref.

=cut

#==========================================
sub _load_config {
#==========================================
    my $self   = shift;
    my $dir    = shift || $self->{config_dir};
    my $config = {};

    my @config_files
        = sort { $a cmp $b } grep { !/\/local.conf$/ } glob( $dir . "*
+" );
    foreach my $config_file (@config_files) {
        my ( $data, $name );
        if ( -f $config_file && $config_file =~ /\.conf$/ ) {
            $data = $self->_load_config_file($config_file);
            ($name) = ( $config_file =~ m|.*/(.*)\.conf$| );
        }
        elsif ( -d $config_file ) {
            $data = $self->_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 = $self->_load_config_file( $dir . 'local.conf' );
        $config = $self->_merge_local( $config, $data );
    }
    return $config;
}

=item C<_merge_local()>

    $merged_config = $self->_merge_local($config_hash,$local_config_ha
+sh);

Private method used for merging the contents of a C<local.conf> file i
+nto
the main configuration.

Hashes are merged, arrays are overwritten.

=cut

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

=item C<_load_config_file()>

    $config_hash = $self->_load_config_file($filename);

Private method which parses the YAML file and throws an error if it is
+ not
correctly formatted.


=cut

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

    return $data;
}

=item C<import()>

    MyApp::Config->import($config_dir);

C<import()> does all the magic, as follows:

    package MyApp::Config;
    use base 'Burro::Config';

    package main;

    use MyApp::Config '/path/to/config/dir';
    --> The first time that MyApp::Config is used, the config
        dir must be specified.

      * This calls MyApp::Config->new('/path/to/config/dir'),
        which loads the config hash and returns the config object ($co
+nf).
      * $conf is stored in $MyApp::Config::Config.
      * MyApp::Config::C() and MyApp::Config::copy_C() are set up
        as functions which call the related methods, using the config
        object singleton $MyApp::Config::Config
      * C() is exported to the caller package (in this case, 'main')
      * It also sets up the sub MyApp::Config::import()

    package MyApp::Other::Module;
    use MyApp::Config;

      * This calls MyApp::Config::import() automatically, which
        export the function C() to the caller package.

=cut

#==========================================
sub import {
#==========================================
    my $class = shift;
    my $dir = shift || '';

    no strict 'refs';
    my $var = $class . "::Config";
    ${$var} = $class->new($dir);

    # Export C, copy_C to the subclass
    *{ $class . "::C" }
        = eval "sub {return \$$var->Burro::Config::C(\@_)}";
    *{ $class . "::copy_C" }
        = eval "sub {return \$$var->Burro::Config::copy_C(\@_)}";

    # Create a new import sub in the subclass
    *{ $class . "::import" } = eval '
        sub {
            my $callpkg = caller(0);
            no strict \'refs\';
            *{$callpkg."::C"} = \&' . $class . '::C;
        }';

}

# Added basic error method to replace my framework's exception mechani
+sm
# for the purposes of code review on PM
#==========================================
sub error {
#==========================================
    my $proto = shift;
    my $class = ref $proto || $proto;
    my $error = shift;
    die "$class error : $error";
}    

=back

=head1 SEE ALSO

L<Burro::Exception>

=head1 TODO

=over 4

=item *

Add multiple config sources, especially find a way to specify how to
load from databases

=item *

Add optional expiry times, but this negates the idea of sharing the co
+nfig
between child processes

=item *

Add a HUP signal handler or reloading config.  Would also need to add
an interface for modules to register subs to be called when the config
is reloaded.

=item *

Optionally use cache for sharing config between machines.

=back

=head1 BUGS

None known

=head1 AUTHOR

Clinton Gormley, E<lt>clinton@traveljury.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Clinton Gormley

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.


=cut

1
[download]