File Coverage

blib/lib/Test/DBIx/Class/SchemaManager.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Test::DBIx::Class::SchemaManager;

use Moose;
use MooseX::Attribute::ENV;
use Moose::Util;
use Test::More ();
use List::MoreUtils qw(uniq);
use Test::DBIx::Class::Types qw(
    TestBuilder SchemaManagerClass FixtureClass ConnectInfo
);

has 'force_drop_table' => (
    traits=>['ENV'],
    is=>'rw',
    isa=>'Bool',
    required=>1,
    default=>0,
);

has [qw/keep_db tdbic_debug/] => (
    traits=>['ENV'],
    is=>'ro',
    isa=>'Bool',
    required=>1,
    default=>0,
);

has 'deploy_db' => (
    traits=>['ENV'],
    is=>'ro',
    isa=>'Bool',
    required=>1,
    default=>1,
);

has 'builder' => (
    is => 'ro',
    isa => TestBuilder,
    required => 1,
);

has 'schema_class' => (
    traits => ['ENV'],
    is => 'ro',
    isa => SchemaManagerClass,
    required => 1,
    coerce => 1,
);

has 'schema' => (
    is => 'ro',
    lazy_build => 1,
);

has 'connect_info' => (
    is => 'ro',
    isa => ConnectInfo,
    coerce => 1,
    lazy_build => 1,
);

has 'connect_opts' => (
    is => 'ro',
    isa => 'HashRef',
);

has 'deploy_opts' => (
    is => 'ro',
    isa => 'HashRef',
    default => sub { {} },
);

has 'connect_info_with_opts' => (
    is => 'ro',
    isa => 'HashRef',
    lazy_build => 1,
);

has 'fixture_class' => (
    traits => ['ENV'],
    is => 'ro',
    isa => FixtureClass,
    required => 1,
    coerce => 1,
    default => '::Populate',
);

has 'fixture_command' => (
    is => 'ro',
    init_arg => undef,
    lazy_build => 1,
);

has 'fixture_sets' => (
    is => 'ro',
    isa => 'HashRef',
);

has 'last_statement' => (
    is=>'rw',
    isa=>'Str',
);

sub get_fixture_sets {
    my ($self, @sets) = @_;
    my @return;
    foreach my $set (@sets) {
        if(my $fixture = $self->fixture_sets->{$set}) {
            push @return, $fixture;
        }
    }
    return @return;
}

sub _build_schema {
    my $self = shift @_;
    my $schema_class = $self->schema_class;
    my $connect_info = $self->connect_info_with_opts;

    return unless $schema_class;

    $schema_class = $self->prepare_schema_class($schema_class);

    return $schema_class->connect($connect_info);
}

sub _build_connect_info {
    my ($self) = @_;
    if(my $default = $self->can('get_default_connect_info') ) {
        return $self->$default;
    } else {
        Test::More::fail("Can't build a default connect info");
    }
}

sub _build_connect_info_with_opts{
    my ($self) = @_;
    return { %{$self->connect_info}, %{$self->connect_opts || {}} };
}

sub _build_fixture_command {
    my $self = shift @_;
    return $self->fixture_class->new(schema_manager=>$self);
}

sub prepare_schema_class {
    my ($self, $schema_class) = @_;
    return $schema_class;
}

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

    my @traits = ();
    if(defined $config->{traits}) {
        @traits = ref $config->{traits} ? @{$config->{traits}} : ($config->{traits});
    }

    if(my $connect_info = $config->{connect_info}) {
        $connect_info = to_ConnectInfo($connect_info);
        my ($driver) = $connect_info->{dsn} =~ /dbi:([^:]+):/i;
                    if(lc $driver eq "sqlite") {
                        push @traits, 'SQLite';
                    }
                    # Don't assume mysql means we want Testmysqld; we may
                    # want to connect to a real mysql server to test.
    } else {
        push @traits, 'SQLite'
          unless @traits;
    }
    @traits = map { __PACKAGE__."::Trait::$_"} uniq @traits;
    $config->{traits} = \@traits;

    my $self = Moose::Util::with_traits($class, @traits)->new($config)
        or return;

    $self->schema->storage->ensure_connected;
    $self->setup if $self->deploy_db;

    return $self;
}

## TODO we need to fix DBIC to allow debug levels and channels
sub _setup_debug {
    my $self = shift @_;
    my $cb = $self->schema->storage->debugcb;

    $self->schema->storage->debug(1);
    $self->schema->storage->debugcb(sub {
        $cb->(@_) if $cb;
        $self->last_statement($_[1]);
    });
}

sub setup {
    my $self = shift @_;
    my $deploy_opts = {%{$self->deploy_opts}, $self->force_drop_table ? (add_drop_table => 1) : ()};
    if(my $schema = $self->schema) {
        eval {
            $schema->deploy($deploy_opts);
        };if($@) {
            Test::More::fail("Error Deploying Schema: $@");
        }
        return $self;
    }
    return;
}

sub cleanup {
    my $self = shift @_;
    my $schema = $self->schema;

    return unless $schema;
    return unless $schema->storage;

    unless ($self->keep_db) {
        $schema->storage->with_deferred_fk_checks(sub {
            foreach my $source ($schema->sources) {
                my $tablesource = $schema->source($source);
                next unless $tablesource;
                my $table = $tablesource->name;
                $schema->storage->dbh->do($self->drop_table_sql($table))
                    if !($schema->source($source)->can('is_virtual') &&
                        $schema->source($source)->is_virtual);
            }
        });
    }

    $self->schema->storage->disconnect;
}

# this has been pushed out to a method so that it can be overriden
# by the traits.
sub drop_table_sql
{
    my $self = shift;
    my $table = shift;
    return "drop table $table";
}

sub reset {
    my $self = shift @_;
    $self->cleanup;
    $self->setup;
}

sub install_fixtures {
    my ($self, @args) = @_;
    my $fixture_command = $self->fixture_command;
    if(
        (!ref($args[0]) && ($args[0]=~m/^::/))
        or (ref $args[0] eq 'HASH' && $args[0]->{command}) ) {
        my $arg = ref $args[0] ?  $args[0]->{command} : $args[0];
        my $fixture_class = to_FixtureClass($arg);
        $self->builder->diag("Override default FixtureClass '".$self->fixture_class."' with $fixture_class") if $self->tdbic_debug;
        $fixture_command = $fixture_class->new(schema_manager=>$self);
        shift(@args);
    }
    return $self->schema->txn_do( sub {
        $fixture_command->install_fixtures(@args);
    });
}

sub DEMOLISH {
    my $self = shift @_;
    if(defined $self) {
        $self->cleanup;
    }
}

__PACKAGE__->meta->make_immutable;

__END__