File Coverage

blib/lib/CMS/Drupal.pm

Criterion	Covered	Total	%
statement	41	42	97.6
branch	11	18	61.1
condition	1	3	33.3
subroutine	9	9	100.0
pod	1	1	100.0
total	63	73	86.3

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

use strict;
use warnings;

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'} );

  # We want to accept no params if we have the values in the env. But
  # we don't want to use those creds when we are running certain tests
  my $args = (exists $ENV{'DRUPAL_TEST_CREDS'} and ! exists $ENV{'DRUPAL_IGNORE_TEST_CREDS'}) ?
               { split(',', $ENV{'DRUPAL_TEST_CREDS'}) } :
               { @_ };

  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__