File Coverage

blib/lib/DBIx/FixtureLoader.pm

Criterion	Covered	Total	%
statement	27	120	22.5
branch	0	78	0.0
condition	0	29	0.0
subroutine	9	14	64.2
pod	1	1	100.0
total	37	242	15.2

package DBIx::FixtureLoader;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.12";

use Carp qw/croak/;
use DBIx::TransactionManager;
use File::Basename qw/basename/;

use SQL::Maker;
SQL::Maker->load_plugin('InsertMulti');
SQL::Maker->load_plugin('InsertOnDuplicate');

use Moo;

has dbh => (
    is       => 'ro',
    isa      => sub { shift->isa('DBI::db') },
    required => 1,
);

has transaction_manager => (
    is => 'lazy',
    default => sub {
        DBIx::TransactionManager->new(shift->dbh);
    },
);

has bulk_insert => (
    is      => 'lazy',
    default => sub {
        my $self = shift;
        return undef if $self->skip_null_column;

        my $driver_name = $self->_driver_name;
        my $dbh         = $self->dbh;
        $driver_name eq 'mysql'                                      ? 1 :
        $driver_name eq 'Pg' && $dbh->{ pg_server_version } >= 82000 ? 1 :
                                                                       0 ;
    },
);

has update => (
    is      => 'ro',
    default => sub { undef },
);

has ignore => (
    is      => 'ro',
    default => sub { undef },
);

has delete => (
    is      => 'ro',
    default => sub { undef },
);

has skip_null_column => (
    is      => 'ro',
    default => sub { undef },
);

has csv_option => (
    is      => 'ro',
    isa     => sub { ref $_[0] eq 'HASH' },
    default => sub { {} },
);

has _driver_name => (
    is      => 'lazy',
    default => sub {
        shift->dbh->{Driver}{Name};
    },
);

has _sql_builder => (
    is      => 'lazy',
    default => sub {
        SQL::Maker->new(
            driver => shift->_driver_name,
        );
    }
);

no Moo;

sub load_fixture {
    my $self = shift;
    my $file = shift;
    my %opts = ref $_[0] ? %{$_[0]} : @_;

    my $update = $opts{update};
    my $ignore = $opts{ignore};
    croak '`update` and `ignore` are exclusive argument' if $update && $ignore;

    if (ref($file) =~ /^(?:ARRAY|HASH)$/) {
        return $self->_load_fixture_from_data(data => $file, %opts);
    }

    my $table  = $opts{table};
    my $format = lc($opts{format} || '');

    unless ($table) {
        my $basename = basename($file);
        ($table) = $basename =~ /^([_A-Za-z0-9]+)/;
    }

    unless ($format) {
        ($format) = $file =~ /\.([^.]*$)/;
    }

    my $rows;
    if ($format eq 'csv' || $format eq 'tsv') {
        $rows = $self->_get_data_from_csv($file, $format);
    }
    else {
        if ($format eq 'json') {
            require JSON;
            my $content = do {
                local $/;
                open my $fh, '<', $file or die $!;
                <$fh>;
            };
            $rows = JSON::decode_json($content);
        }
        elsif ($format =~ /ya?ml/) {
            require YAML::Tiny;
            $rows = YAML::Tiny->read($file) or croak( YAML::Tiny->errstr );
            $rows = $rows->[0];
        }
    }

    $self->load_fixture($rows,
        table  => $table,
        %opts,
    );
}

sub _get_data_from_csv {
    my ($self, $file, $format) = @_;
    require Text::CSV;

    my $csv = Text::CSV->new({
        binary         => 1,
        blank_is_undef => 1,
        sep_char => $format eq 'tsv' ? "\t" : ',',
        %{ $self->csv_option },
    }) or croak( Text::CSV->error_diag );

    open my $fh, '<', $file or die "$!";
    my $columns = $csv->getline($fh);
    my @records;
    while ( my $row = $csv->getline($fh) ){
        my %cols = map { $columns->[$_] => $row->[$_] } 0..$#$columns;
        push @records, \%cols;
    }
    \@records;
}

sub _load_fixture_from_data {
    my ($self, %args) = @_;
    my ($table, $data) = @args{qw/table data/};

    croak '`update` and `ignore` are exclusive option' if $args{update} && $args{ignore};

    my $update = $self->update;
    my $ignore = $self->ignore;
    croak '`update` and `ignore` are exclusive option' if $update && $ignore;

    my $bulk_insert      = $self->bulk_insert;
    my $skip_null_column = $self->skip_null_column;
    croak '`bulk_insert` and `skip_null_column` are exclusive option' if $bulk_insert && $skip_null_column;

    # The $args has priority. So default object property is ignored.
    if (exists $args{update}) {
        $update = $args{update};
        $ignore = undef if $update;
    }
    if (exists $args{ignore}) {
        $ignore = $args{ignore};
        $update = undef if $ignore;
    }

    if ($update && $self->_driver_name ne 'mysql') {
        croak '`update` option only support mysql'
    }
    my $delete = $self->delete || $args{delete};

    $data = $self->_normalize_data($data);
    return unless @$data;

    my $dbh = $self->dbh;
    # needs limit ?
    my $txn = $self->transaction_manager->txn_scope or croak $dbh->errstr;

    if ($delete) {
        my ($sql, @binds) = $self->_sql_builder->delete($table);
        $dbh->do($sql, undef, @binds);
    }

    my $opt; $opt->{prefix} = 'INSERT IGNORE INTO' if $ignore;
    if ($bulk_insert) {
        $opt->{update} = _build_on_duplicate(keys %{$data->[0]}) if $update;

        my ($sql, @binds) = $self->_sql_builder->insert_multi($table, $data, $opt ? $opt : ());

        $dbh->do( $sql, undef, @binds ) or croak $dbh->errstr;
    }
    else {
        my $method = $update ? 'insert_on_duplicate' : 'insert';
        for my $row_orig (@$data) {
            my $row = !$skip_null_column ? $row_orig : {map {
                defined $row_orig->{$_} ? ($_ => $row_orig->{$_}) : ()
            } keys %$row_orig};
            $opt = _build_on_duplicate(keys %$row) if $update;
            my ($sql, @binds) = $self->_sql_builder->$method($table, $row, $opt ? $opt : ());

            $dbh->do( $sql, undef, @binds ) or croak $dbh->errstr;
        }
    }
    $txn->commit or croak $dbh->errstr;
}

sub _build_on_duplicate {
    +{ map {($_ => \"VALUES(`$_`)")} @_ };
}

sub _normalize_data {
    my ($self, $data) = @_;
    my @ret;
    if (ref $data eq 'HASH') {
        push @ret, $data->{$_} for keys %$data;
    }
    elsif (ref $data eq 'ARRAY') {
        if ($data->[0] && $data->[0]{data} && ref $data->[0]{data} eq 'HASH') {
            @ret = map { $_->{data} } @$data;
        }
        else {
            @ret = @$data;
        }
    }
    \@ret;
}

1;
__END__