File Coverage

blib/lib/CMS/Drupal.pm

Criterion	Covered	Total	%
statement	38	45	84.4
branch	6	16	37.5
condition			n/a
subroutine	10	10	100.0
pod	1	1	100.0
total	55	72	76.3

package CMS::Drupal;
$CMS::Drupal::VERSION = '0.091';
# ABSTRACT: Perl interface to the Drupal CMS

use strict;
use warnings;
use 5.010;

use Moo;
use Types::Standard    qw/ Optional Maybe Str Int slurpy Dict /;
use CMS::Drupal::Types qw/ DBName DBDriver DBUsername DBPassword DBHost DBPort DBPrefix /;
use Type::Params       qw/ compile /;

use DBI;
use Carp qw/ confess croak /;

sub dbh {
  my $self = shift;
  return $self->{'_dbh'} if defined( $self->{'_dbh'} );

  my $args = { @_ };

  confess "Fatal error! No database name provided! " unless exists $args->{'database'};
  confess "Fatal error! No dbi:driver provided! "    unless exists $args->{'driver'};

  my %types = (
    database => DBName,
    driver   => DBDriver,
    username => DBUsername,
    password => DBPassword,
    host     => DBHost,
    port     => DBPort,
    prefix   => DBPrefix,
  );

  for ( keys %{$args} ) {
    next unless exists $types{ $_ }; # throw away unknown params
    my $validate = compile( slurpy Dict [ $_ => $types{$_} ]);
    my ($param) = $validate->( $_ => $args->{$_} );
  }

  my $dsn = join(':', 'dbi', $args->{'driver'}, $args->{'database'});
  exists $args->{'host'} and $dsn .= (';host=' . $args->{'host'});
  exists $args->{'port'} and $dsn .= (';port=' . $args->{'port'});
  my $username = (exists $args->{'username'} ? $args->{'username'} : '');
  my $password = (exists $args->{'password'} ? $args->{'password'} : '');
  $self->{'_dbh'} = DBI->connect( $dsn, $username, $password, { 'RaiseError' => 1 } );

  return $self->{'_dbh'};
}

1; ## return true to end package CMS::Drupal
__END__