File Coverage

blib/lib/DBIx/Connect/FromConfig.pm

Criterion	Covered	Total	%
statement	18	56	32.1
branch	2	40	5.0
condition	0	4	0.0
subroutine	6	7	85.7
pod	1	1	100.0
total	27	108	25.0

package DBIx::Connect::FromConfig;
use strict;
use warnings;
use Carp;
use DBI ();


{
    no strict;
    $VERSION = '0.07';
}


#
# import()
# ------
sub import {
    if (grep { /^-in_dbi$/i } @_) {
        *DBI::connect_from_config = \&connect
    }
}


#
# connect()
# -------
sub connect {
    my ($class, @args) = @_;
    croak "error: No parameter given" unless @args;
    croak "error: Odd number of arguments" if @args % 2 != 0;

    my %args = @args;
    my @params = qw<
        driver host port database options username password attributes
    >;

    my %db = ();
    my %db_param_name = (
        CSV         => 'f_dir',
        DB2         => 'DATABASE',
        Excel       => 'file',
        InterBase   => 'database',
        Mock        => 'dbname',
        mysql       => 'database',
        mysqlPP     => 'database',
        Oracle      => 'sid',
        Pg          => 'dbname',
        PgLite      => 'dbname',
        PgPP        => 'dbname',
        SQLite      => 'dbname',
        SQLite2     => 'dbname',
        Sybase      => 'database',
    );

    my $section_name = $args{section} || 'database';

    my $config = $args{config};

    # configuration in a Config::IniFiles object
    if (eval { $config->isa('Config::IniFiles') }) {
        for my $param (@params) {
            $db{$param} = $config->val($section_name => $param)
        }
    }
    # configuration in a Config::Simple object
    elsif (eval { $config->isa('Config::Simple') }) {
        my $block = $config->get_block($section_name);

        for my $param (@params) {
            $db{$param} = $block->{$param};
        }
    }
    # configuration in a Config::Tiny object
    elsif (eval { $config->isa('Config::Tiny') }) {
        for my $param (@params) {
            $db{$param} = $config->{$section_name}{$param};
        }
    }
    # configuration in a hashref
    elsif (ref $config eq 'HASH') {
        for my $param (@params) {
            $db{$param} = $config->{$param}
        }
    }
    else {
        croak "error: Unknown type of configuration"
    }

    # check mandatory values
    $db{driver} or croak "error: Database driver not specified";
    exists $db_param_name{$db{driver}}
        or croak "error: Database driver \Q$db{driver}\E not supported";

    # default values
    $db{database}   = "" unless defined $db{database};
    $db{host}       = "" unless defined $db{host};
    $db{port}       = "" unless defined $db{port};
    $db{options}    = "" unless defined $db{options};
    $db{username}   = "" unless defined $db{username};
    $db{password}   = "" unless defined $db{password};
    $db{attributes} ||= {};

    # handle DBI attributes
    if (ref $db{attributes}) {
        croak "error: DBI attributes must be given as a hashref or a string"
            unless ref $db{attributes} eq "HASH";
    }
    else {
        # copied from DBI::parse_dsn()
        $db{attributes} = { split /\s*=>?\s*|\s*,\s*/, $db{attributes}, -1 };
    }

    # construct the DSN
    my $dsn = sprintf "dbi:$db{driver}:%s%s%s=%s%s",
        ( $db{host} ? "host=$db{host};" : '' ),
        ( $db{port} ? "port=$db{port};" : '' ),
        $db_param_name{$db{driver}}, $db{database},
        ( $db{options} ? ";$db{options}" : '' );

    my $dbh = DBI->connect($dsn, $db{username}, $db{password}, $db{attributes});

    return $dbh
}


1; # End of DBIx::Connect::FromConfig


__END__