File Coverage

blib/lib/Config/DB.pm

Criterion	Covered	Total	%
statement	52	72	72.2
branch	22	38	57.8
condition	3	3	100.0
subroutine	10	12	83.3
pod	3	4	75.0
total	90	129	69.7

package Config::DB;

$Config::DB::VERSION = '0.2';

use strict;
use warnings;

use Carp;
use Config::DB::Record;
use Config::DB::Table;
use DBI;

sub new {
    my ( $class, %pars ) = @_;
    my $self = { %pars, read => 0, values => {} };

    croak __PACKAGE__ . "::new: wrong call" if !defined $class || $class eq '';

    eval {
        die
          if $class->check_Config_DB_hineritance ne
              'check_Config_DB_hineritance';
    };
    croak __PACKAGE__ . "::new: '$class' does not hinerit 'Config::DB'"
      if $@ ne '';

    croak __PACKAGE__ . "::new: missing 'connect' paramenter"
      if !defined $self->{connect};
    croak __PACKAGE__
      . "::new: 'connect' paramenter is not a reference to ARRAY"
      if ref $self->{connect} ne 'ARRAY';
    croak __PACKAGE__ . "::new: missing 'tables' paramenter"
      if !defined $self->{tables};
    croak __PACKAGE__ . "::new: 'tables' paramenter is not a reference to HASH"
      if ref $self->{tables} ne 'HASH';
    croak __PACKAGE__ . "::new: no tables defined"
      if 0 == scalar keys %{ $self->{tables} };

    return bless $self, $class;
}

our $AUTOLOAD;

sub AUTOLOAD {
    my ( $self, @pars ) = @_;
    my $name = $AUTOLOAD;

    $name =~ s/.*://;

    croak "Can't locate object method \"$name\" via package \""
      . __PACKAGE__ . '"'
      unless $name =~ /^_/;

    $name =~ s/^_//;

    return $self->get( $name, @pars );
}

sub DESTROY {
}

sub check_Config_DB_hineritance {
    return 'check_Config_DB_hineritance';
}

sub get {
    my ( $self, $table, $key, $field ) = @_;

    $self->read unless $self->{read};

    croak __PACKAGE__ . "::get: missing table parameter" unless defined $table;
    croak __PACKAGE__ . "::get: unknown configuration table '$table'"
      unless exists $self->{values}->{$table};

    return $self->{values}->{$table} unless defined $key;

    croak __PACKAGE__
      . "::get: missing key '$key' in configuration table '$table'"
      unless exists $self->{values}->{$table}->{$key};

    return $self->{values}->{$table}->{$key} unless defined $field;

    croak __PACKAGE__
      . "::get: unknown field '$field' for configuration table '$table'"
      unless exists $self->{values}->{$table}->{$key}->{$field};

    return $self->{values}->{$table}->{$key}->{$field};
}

sub read {
    my ($self) = @_;
    my @connect = @{ $self->{connect} };
    my %attr = %{ $connect[3] || {} };
    my $dbh;

    $attr{PrintError} = 0;
    $attr{RaiseError} = 1;
    $connect[3]       = \%attr;

    eval { $dbh = DBI->connect(@connect); };
    croak "$@\n" . __PACKAGE__ . "::read: can't connect" if $@;

    foreach my $table ( keys %{ $self->{tables} } ) {
        my $t;

        eval {
            $t = $dbh->selectall_hashref(
"SELECT $self->{tables}->{$table} AS dbcfg_key, $table.* FROM $table",
                'dbcfg_key'
            );
        };
        croak "$@\n" . __PACKAGE__ . "::read: reading '$table' table" if $@;
        $self->{values}->{$table} = $t;

        foreach my $key ( keys %$t ) {
            delete $t->{$key}->{dbcfg_key};
            bless $t->{$key}, 'Config::DB::Record';
        }

        bless $t, 'Config::DB::Table';
    }

    $self->{read} = 1;
}

1;

__END__