view release on metacpan or  search on metacpan

lib/Config/Merge.pm  view on Meta::CPAN

    OO:
       @hosts     = $config->('db.hosts.session');
       $hosts_ref = $config->('db.hosts.session');
       $host_1    = $config->('db.hosts.session.0');

    Functional:
       @hosts     = C('db.hosts.session');
       $hosts_ref = C('db.hosts.session');
       $host_1    = C('db.hosts.session.0');

These lookups are memo'ised, so lookups are fast.

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

=head1 MINIMISING MEMORY USE

The more configuration data you load, the more memory you use. In order to
keep the memory use as low as possible for mod_perl (or other forking
applications), the configuration data should be loaded at startup in the
parent process.

As long as the data is never changed by the children, the configuration hash
will be stored in shared memory, rather than there being a separate copy in each
child process.

(See L<http://search.cpan.org/~pgollucci/mod_perl-2.0.3/docs/user/performance/mpm.pod>)

=head1 METHODS

=over

=item C<new()>

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

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

=cut

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

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

    my $params
        = @_ > 1              ? {@_}
        : ref $_[0] eq 'HASH' ? shift()
        :                       { path => shift() };

    # Emit debug messages
    $self->{debug} = $params->{debug} ? 1 : 0;

    die "Parameter 'sort' must be a coderef"
        if exists $params->{sort} && ref $params->{sort} ne 'CODE';

    # Setup callbacks
    $self->_init_callback( $_, $params->{$_} )
        foreach qw(skip is_local load_as sort);

    my $path = $params->{path}
        or die( "Configuration directory not specified when creating a new "
            . "'$class' object" );

    if ( $path && -d $path && -r _ ) {

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

        return $self;
    }
    else {
        die( "Configuration directory '$path' not readable when creating a new "
                . "'$class' object" );
    }
    return $self;
}

=item C<C()>

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

C<Config::Merge> objects are overloaded so that this also works:

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

Or, if used in the functional style (see L</"USING Config::Merge">):

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

C<key1> etc can be keys in a hash, or indexes of an array.

C<C('key1.key2.keyn')> returns everything from C<keyn> down,
so you can use the return value just as you would any normal Perl variable.

The return values are context-sensitive, so if called
in list context, an array ref or hash ref will be returned as lists.
Scalar values, code refs, regexes and blessed objects will always be returned
as themselves.

So for example:

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

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

  etc

If called with a hash ref as the second parameter, then that hash ref will be
examined, rather than the C<$config> data.

lib/Config/Merge.pm  view on Meta::CPAN

the file / dir. By default, it returns the C<$name> for main
config files, or C<''> for local files.

The decision is made based on the name of the file / dir, without
any extension.

If C<load_as()> returns an empty string, then each key in the file/tree
is merged separately. This is how the C<local.*> files work by default.
See L</"OVERRIDING CONFIG LOCALLY">.

For instance:

   main.yaml:
     key1:  value
     key2:  value

   db.yaml:
     key3:  value
     key4:  value

   local.yaml:
     main:
        key1: new_value
     db:
        key4: new_value

To use C<load_as()>, you can either subclass it, or pass in a parameter
to new:

=over

=item C<qr/(regex)/>

The regex will be checked against the file/dir name, and if it matches
then it returns the string captured in the regex, otherwise it returns
the original name.

=item C<sub {}> or subclassed C<is_local>

   sub {
       my ($self,$name,$is_local) = @_;
       ...make decision...
       return 'string';   # string is used as the keyname
       return '';         # acts like local.* (see above)
       return undef;      # don't load this file/dir
   }

=back

Also, see L</"EXAMPLE USING is_local() AND load_as()">.

=cut

#===================================
sub load_as {
#===================================
    my ( $self, $filename, $local ) = @_;
    return $local ? '' : $filename;
}

my %callbacks = (
    CODE  => \&_init_code_callback,
    HASH  => \&_init_hash_callback,
    ARRAY => \&_init_array_callback,
);

=item EXAMPLE USING C<is_local()> AND C<load_as()>

For instance, instead of using C<local.*> files, you may want to
keep versioned copies of local configs for different machines, and so use:

   app.yaml
   app-(dev1.domain.com).yaml
   app-(dev2.domain.com).yaml

You would implement this as follows:

    my $config = Config::Merge->new(
        path        => '/path/to/config',

        # If matches 'xxx-(yyy)'
        is_local    => sub {
            my ( $self, $name ) = @_;
            return $name=~/- [(] .+ [)]/x ? 1 : 0;
        },

        # If local and matches 'xxx-(hostname)', return xxx
        load_as => sub {
            my ( $self, $name, $is_local ) = @_;
            if ($is_local) {
                if ( $name=~/(.*) - [(] ($hostname) [)] /x ) {
                    return  $1;
                }
                return undef;
            }
            return $name;
        }
    );

See C<examples/advanced.pl> for a working illustration.

=item C<sort()>

    $c = Config::Merge->new(
            path   => '/path/to/config',
            sort   => sub {}
    );

By default, directory entries are sorted alphabetically, with
directories before filenames.

This would be the order for these directory entries:

  api/
  api-(dev1)/
  api.yaml
  api-(dev1).yaml

To override this, you can subclass C<sort()> or pass it in as a
parameter to new:

   sub {
       my ($self,$names_array_ref) = @_
       ...sort...
       return $names_array_ref;
   }

=cut

#===================================
sub sort {
#===================================
    my ( $self, $names ) = @_;
    s/[.]([^.]+$)/ .$1/ foreach @$names;
    $names = [ sort { $a cmp $b } @$names ];
    s/ [.]([^.]+$)/.$1/ foreach @$names;
    return $names;
}

=item C<debug()>

    my $config = Config::Merge->new(
        path        => '/path/to/config',
        debug       => 1 | 0
    );

If C<debug> is true, then Config::Merge prints out an explanation
of what it is doing on STDERR.

=back

=cut

#===================================
sub debug {
#===================================
    my $self = shift;
    print STDERR ( join( "\n", @_, '' ) )
        if $self->{debug};
    return 1;
}

#===================================
sub _init_callback {
#===================================
    my ( $self, $callback, $check ) = @_;

    # If nothing set, use default or subclassed version
    unless ($check) {
        $self->{$callback} = $self->can($callback);
        $self->debug("Using default or subclassed $callback()");
        return;
    }

    $check = [$check]
        unless exists $callbacks{ ref $check };

    $self->debug( 'Using ' . ( ref $check ) . " handler for $callback()" );

    $self->{$callback} = $callbacks{ ref $check }->( $check, $callback );
    return;
}

#===================================
sub _init_code_callback {
#===================================
    return $_[0];
}

#===================================
sub _init_hash_callback {
#===================================
    my ( $check, $callback ) = @_;
    die "load_as() cannot be a hashref"
        if $callback eq 'load_as';
    return sub {
        my $self  = shift;
        my $param = shift;
        return exists $check->{$param};
    };
}

#===================================
sub _init_array_callback {
#===================================
    my ( $check, $callback ) = @_;
    if ( $callback eq 'load_as' ) {
        die "load_as() must contain a single regex"
            unless @$check == 1;
        my $regex = $check->[0];
        return sub {
            my $self     = shift;
            my $filename = shift;
            return $filename =~ m/$regex/
                ? $1
                : $filename;
        };
    }

    foreach my $value (@$check) {
        $value ||= '';
        die "'$value' is not a regular expression"
            unless ref $value eq 'Regexp';
    }
    return sub {
        my $self  = shift;
        my $value = shift;
        foreach my $regex (@$check) {
            return 1 if $value =~ m/$regex/;
        }
        return 0;
    };
}

=head1 SEE ALSO

L<Storable>, L<Config::Any>, L<Config::Any::YAML>,
L<Config::Any::JSON>, L<Config::Any::INI>, L<Config::Any::XML>,
L<Config::Any::General>