File Coverage

blib/lib/DBIx/Config.pm

Criterion	Covered	Total	%
statement	73	75	97.3
branch	36	40	90.0
condition	3	6	50.0
subroutine	18	18	100.0
pod	4	10	40.0
total	134	149	89.9

package DBIx::Config;
use 5.005;
use warnings;
use strict;
use DBI;
use File::HomeDir;

our $VERSION = '0.000005'; # 0.0.5
$VERSION = eval $VERSION;

sub new {
    my ( $class, $args ) = @_;

    my $self = bless {
        config_paths => [
            get_env_vars(),
            './dbic',
            './dbi',
            File::HomeDir->my_home . '/.dbic',
            File::HomeDir->my_home . '/.dbi',
            '/etc/dbic',
            '/etc/dbi',
        ],
        config_files => [],
    }, $class;

    for my $arg ( keys %{$args} ) {
        $self->$arg( delete $args->{$arg} ) if $self->can( $arg );
    }

   die "Unknown arguments to the constructor: " . join( " ", keys %$args )
       if keys( %$args );

    return $self;
}

sub get_env_vars {
    if ( exists $ENV{DBIX_CONFIG_DIR} ) {
        return ($ENV{DBIX_CONFIG_DIR}.'/dbic', $ENV{DBIX_CONFIG_DIR}.'/dbi');
    }
    return ();
}

sub connect {
    my ( $self, @info ) = @_;

    if ( ( ! ref($self) ) ||  ( ref($self) ne __PACKAGE__) ) {
        return $self->new->connect(@info);
    }

    return DBI->connect( $self->connect_info(@info) );
}

sub connect_info {
    my ( $self, @info ) = @_;

    if ( ( ! ref($self) ) ||  ( ref($self) ne __PACKAGE__) ) {
        return $self->new->connect_info(@info);
    }

    my $config = $self->_make_config(@info);

    # Take responsibility for passing through normal-looking
    # credentials.
    $config = $self->default_load_credentials($config)
        unless $config->{dsn} =~ /dbi:/i;

    return $self->_dbi_credentials($config);
}

# Normalize arguments into a single hash.  If we get a single hashref,
# return it.
# Check if $user and $pass are hashes to support things like
# ->connect( 'CONFIG_FILE', { hostname => 'db.foo.com' } );

sub _make_config {
    my ( $class, $dsn, $user, $pass, $dbi_attr, $extra_attr ) = @_;
    return $dsn if ref $dsn eq 'HASH';


    return {
        dsn => $dsn,
        %{ref $user eq 'HASH' ? $user : { user => $user }},
        %{ref $pass eq 'HASH' ? $pass : { password => $pass }},
        %{$dbi_attr || {} },
        %{ $extra_attr || {} }
    };
}

# DBI's ->connect expects
# ( "dsn", "user", "password", { option_key => option_value } )
# this function changes our friendly hashref into this format.

sub _dbi_credentials {
    my ( $class, $config ) = @_;

    return (
        delete $config->{dsn},
        delete $config->{user},
        delete $config->{password},
        $config,
    );
}

sub default_load_credentials {
    my ( $self,  $connect_args ) = @_;

    # To allow overriding without subclassing, if you pass a coderef
    # to ->load_credentials, we will replace our default load_credentials
    # without that function.
    if ( $self->load_credentials ) {
        return $self->load_credentials->( $self, $connect_args );
    }

    require Config::Any; # Only loaded if we need to load credentials.

    # While ->connect is responsible for returning normal-looking
    # credential information, we do it here as well so that it can be
    # independently unit tested.
    return $connect_args if $connect_args->{dsn} =~ /^dbi:/i;

    # If we have ->config_files, we'll use those and load_files
    # instead of the default load_stems.
    my %cf_opts = ( use_ext => 1 );
    my $ConfigAny = @{$self->config_files}
        ? Config::Any->load_files({ files => $self->config_files, %cf_opts })
        : Config::Any->load_stems({ stems => $self->config_paths, %cf_opts });

    return $self->default_filter_loaded_credentials(
        $self->_find_credentials( $connect_args, $ConfigAny ),
        $connect_args
    );

}

# This will look through the data structure returned by Config::Any
# and return the first instance of the database credentials it can
# find.
sub _find_credentials {
    my ( $class, $connect_args, $ConfigAny ) = @_;

    for my $cfile ( @$ConfigAny ) {
        for my $filename ( keys %$cfile ) {
            for my $database ( keys %{$cfile->{$filename}} ) {
                if ( $database eq $connect_args->{dsn} ) {
                    return $cfile->{$filename}->{$database};
                }
            }
        }
    }
}

sub default_filter_loaded_credentials {
    my ( $self, $loaded_credentials,$connect_args ) = @_;
    if ( $self->filter_loaded_credentials ) {
        return $self->filter_loaded_credentials->(
            $self, $loaded_credentials,$connect_args
        );
    }
    return $loaded_credentials;
}

# Assessors
sub config_paths {
    my $self = shift;
    $self->{config_paths} = shift if @_;
    return $self->{config_paths};
}

sub config_files {
    my $self = shift;
    $self->{config_files} = shift if @_;
    return $self->{config_files};
}

sub filter_loaded_credentials {
    my $self = shift;
    $self->{filter_loaded_credentials} = shift if @_;
    return $self->{filter_loaded_credentials};
}

sub load_credentials {
    my $self = shift;
    $self->{load_credentials} = shift if @_;
    return $self->{load_credentials};
}

1;

=head1 NAME

DBIx::Config - Manage credentials for DBI

=head1 DESCRIPTION

DBIx::Config wraps around L to provide a simple way of loading database
credentials from a file.  The aim is make it simpler for operations teams to
manage database credentials.

=head1 SYNOPSIS

Given a file like C, containing:

    MY_DATABASE:
        dsn:            "dbi:Pg:host=localhost;database=blog"
        user:           "TheDoctor"
        password:       "dnoPydoleM"
        TraceLevel:     1

The following code would allow you to connect the database:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config;

    my $dbh = DBIx::Config->connect( "MY_DATABASE" );

Of course, backwards compatibility is kept, so the following would also work:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config;

    my $dbh = DBIx::Config->connect(
        "dbi:Pg:host=localhost;database=blog",
        "TheDoctor",
        "dnoPydoleM",
        {
            TraceLevel => 1,
        },
    );

For cases where you may use something like C, a
method is provided that will simply return the connection credentials:


    !/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Connector;
    use DBIx::Config;

    my $conn = DBIx::Connector->new(DBIx::Config->connect_info("MY_DATABASE"));

=head1 CONFIG FILES

By default the following configuration files are examined, in order listed,
for credentials.  Configuration files are loaded with L.  You
should append the extention that Config::Any will recognize your file in
to the list below.  For instance ./dbic will look for files such as
C<./dbic.yaml>, C<./dbic.conf>, etc.  For documentation on acceptable files
please see L.  The first file which has the given credentials
is used.

=over 4

=item * C<$ENV{DBIX_CONFIG_DIR}> . '/dbic',

C<$ENV{DBIX_CONFIG_DIR}> can be configured at run-time, for instance:

    DBIX_CONFIG_DIR="/var/local/" ./my_program.pl

=item * C<$ENV{DBIX_CONFIG_DIR}> . '/dbi',

C<$ENV{DBIX_CONFIG_DIR}> can be configured at run-time, for instance:

    DBIX_CONFIG_DIR="/var/local/" ./my_program.pl

=item * ./dbic

=item * ./dbi

=item * $HOME/.dbic

=item * $HOME/.dbi

=item * /etc/dbic

=item * /etc/dbi

=item * /etc/dbi

=back

=head1 USE SPECIFIC CONFIG FILES

If you would rather explicitly state the configuration files you
want loaded, you can use the class accessor C
instead.

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config

    my $DBI = DBIx::Config->new( config_files => [
        '/var/www/secret/dbic.yaml',
        '/opt/database.yaml',
    ]);
    my $dbh = $DBI->connect( "MY_DATABASE" );

This will check the files, C,
and C in the same way as C,
however it will only check the specific files, instead of checking
for each extension that L supports.  You MUST use the
extension that corresponds to the file type you are loading.
See L for information on supported file types and
extension mapping.

=head1 OVERRIDING

=head2 config_files

The configuration files may be changed by setting an accessor:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config

    my $DBI = DBIx::Config->new(config_paths => ['./dbcreds', '/etc/dbcreds']);
    my $dbh = $DBI->connect( "MY_DATABASE" );

This would check, in order, C in the current directory, and then C,
checking for valid configuration file extentions appended to the given file.

=head2 filter_loaded_credentials

You may want to change the credentials that have been loaded, before they are used
to connect to the DB.  A coderef is taken that will allow you to make programatic
changes to the loaded credentials, while giving you access to the origional data
structure used to connect.

    DBIx::Config->new(
        filter_loaded_credentials => sub {
            my ( $self, $loaded_credentials, $connect_args ) = @_;
            ...
            return $loaded_credentials;
        }
    )

Your coderef will take three arguments.

=over 4

=item * C<$self>, the instance of DBIx::Config your code was called from. C

=item * C<$loaded_credentials>, the credentials loaded from the config file.

=item * C<$connect_args>, the normalized data structure of the inital C call.

=back

Your coderef should return the same structure given by C<$loaded_credentials>.

As an example, the following code will use the credentials from C, but
use its a hostname defined in the code itself.

C (note C):

    MY_DATABASE:
        dsn: "DBI:mysql:database=students;host=%s;port=3306"
        user: "WalterWhite"
        password: "relykS"

The Perl script:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config;

    my $dbh = DBIx::Config->new(
        # If we have %s, replace it with a hostname.
        filter_loaded_credentials => sub {
            my ( $self, $loaded_credentials, $connect_args ) = @_;

                if ( $loaded_credentials->{dsn} =~ /\%s/ ) {
                    $loaded_credentials->{dsn} = sprintf(
                        $loaded_credentials->{dsn}, $connect_args->{hostname}
                    );
                }
                return $loaded_credentials;
            }
        )->connect( "MY_DATABASE", { hostname => "127.0.0.1" } );

=head2 load_credentials

Override this function to change the way that DBIx::Config loads credentials.
The function takes the class name, as well as a hashref.

If you take the route of having ->connect('DATABASE') used as a key for whatever
configuration you are loading, DATABASE would be $config->{dsn}

    $obj->connect(
        "SomeTarget",
        "Yuri",
        "Yawny",
        {
            TraceLevel => 1
        }
    );

Would result in the following data structure as $config in load_credentials($self, $config):

    {
        dsn             => "SomeTarget",
        user            => "Yuri",
        password        => "Yawny",
        TraceLevel      => 1,
    }

Currently, load_credentials will NOT be called if the first argument to ->connect()
looks like a valid DSN. This is determined by match the DSN with /^dbi:/i.

The function should return the same structure. For instance:

    #!/usr/bin/perl
    use warnings;
    use strict;
    use DBIx::Config;
    use LWP::Simple;
    use JSON;

    my $DBI = DBIx::Config->new(
        load_credentials => sub {
            my ( $self, $config ) = @_;

            return decode_json(
                get( "http://someserver.com/v1.0/database?name=" . $config->{dsn} )
            );
        }
    )

    my $dbh = $DBI->connect( "MAGIC_DATABASE" );

=head1 SEE ALSO

=over 4

=item * L

=back

=head1 AUTHOR

=over 4

=item * Kaitlyn Parkhurst (SymKat) [e-mail]> (L)

=back

=head1 CONTRIBUTORS

=over 4

=item * Matt S. Trout (mst) [e-mail]>

=back

=head1 COPYRIGHT

Copyright (c) 2012 the DBIx::Config L and L as listed
above.

=head1 LICENSE

This library is free software and may be distributed under the same terms as
perl itself.

=head1 AVAILABILITY

The latest version of this software is available at
L