File Coverage

blib/lib/SQL/Abstract/Plugin/InsertMulti.pm

Criterion	Covered	Total	%
statement	92	102	90.2
branch	12	14	85.7
condition	5	8	62.5
subroutine	15	18	83.3
pod	2	2	100.0
total	126	144	87.5

package SQL::Abstract::Plugin::InsertMulti;

use strict;
use warnings;

our $VERSION = '0.05';

use Carp ();
use Sub::Exporter -setup => +{
    into    => 'SQL::Abstract',
    exports => [
        qw/insert_multi update_multi _insert_multi _insert_multi_HASHREF _insert_multi_ARRAYREF _insert_multi_values _insert_multi_process_args/
    ],
    groups => +{
        default => [
            qw/insert_multi update_multi _insert_multi _insert_multi_HASHREF _insert_multi_ARRAYREF _insert_multi_values _insert_multi_process_args/
        ]
    },
};

sub insert_multi {
    my $self  = shift;
    my $table = $self->_table(shift);
    my ( $data, $opts, $fields ) = $self->_insert_multi_process_args(@_);
    my ( $sql, @bind ) = $self->_insert_multi( $table, $data, $opts );
    return wantarray ? ( $sql, @bind ) : $sql;
}

sub _insert_multi {
    my ( $self, $table, $data, $opts ) = @_;

    my $method = $self->_METHOD_FOR_refkind( '_insert_multi', $data->[0] );
    my ( $sql, @bind ) = $self->$method( $data, $opts );
    $sql = '( '
      . join( ', ', ( map { $self->_quote($_) } @{ $opts->{fields} } ) ) . ' ) '
      . $sql;

    $sql = join ' ' => grep { defined $_ } (
        $self->_sqlcase('insert'),
        $opts->{option},
        $self->_sqlcase( ( $opts->{ignore} ) ? 'ignore' : 'into' ),
        $table, $sql,
    );

    if ($opts->{returning}) {
        my ($s, @b) = $self->_insert_returning($opts);
        $sql .= $s;
        push @bind, @b;
    }

    return ( $sql, @bind );
}

sub _insert_multi_HASHREF {
    my ( $self, $data, $opts ) = @_;
    my ( $sql, @bind ) = $self->_insert_multi_values( $data, $opts );
    return ( $sql, @bind );
}

sub _insert_multi_ARRAYREF {
    my ( $self, $data, $opts ) = @_;
    my ( $sql, @bind ) = $self->_insert_multi_values(
        [
            map {
                my %h;
                @h{ @{ $opts->{fields} } } = @$_;
                \%h;
              } @$data
        ],
        $opts
    );
    return ( $sql, @bind );
}

sub _insert_multi_values {
    my ( $self, $data, $opts ) = @_;

    my ( @value_sqls, @all_bind );

    for my $d (@$data) {
        my @values;
        for my $column ( @{$opts->{fields}} ) {
            my $v = $d->{$column};

            $self->_SWITCH_refkind(
                $v,
                {
                    ARRAYREFREF => sub {    # literal SQL with bind
                        my ( $sql, @bind ) = @${$v};

                        # $self->_assert_bindval_matches_bindtype(@bind);
                        push @values,   $sql;
                        push @all_bind, @bind;
                    },

                    # THINK : anything useful to do with a HASHREF ?
                    HASHREF => sub { # (nothing, but old SQLA passed it through)
                                     #TODO in SQLA >= 2.0 it will die instead
                        push @values, '?';
                        push @all_bind, $self->_bindtype( $column, $v );
                    },
                    SCALARREF => sub {    # literal SQL without bind
                        push @values, $$v;
                    },
                    SCALAR_or_UNDEF => sub {
                        push @values, '?';
                        push @all_bind, $self->_bindtype( $column, $v );
                    },
                }
            );
        }
        push( @value_sqls, '( ' . join( ', ' => @values ) . ' )' );
    }

    my $sql = $self->_sqlcase('values') . ' ' . join( ', ' => @value_sqls );

    if ( $opts->{update} ) {
        my @set;

        for my $k ( sort keys %{ $opts->{update} } ) {
            my $v     = $opts->{update}{$k};
            my $r     = ref $v;
            my $label = $self->_quote($k);

            $self->_SWITCH_refkind(
                $v,
                {
                    ARRAYREFREF => sub {    # literal SQL with bind
                        my ( $sql, @bind ) = @${$v};
                        push @set,      "$label = $sql";
                        push @all_bind, @bind;
                    },
                    SCALARREF => sub {      # literal SQL without bind
                        push @set, "$label = $$v";
                    },
                    SCALAR_or_UNDEF => sub {
                        push @set, "$label = ?";
                        push @all_bind, $self->_bindtype( $k, $v );
                    },
                }
            );
        }

        $sql .=
          $self->_sqlcase(' on duplicate key update ') . join( ', ', @set );
    }

    return ( $sql, @all_bind );
}

sub _insert_multi_process_args {
    my $self = shift;
    my ( $data, $opts, $fields );

    if ( ref $_[0] eq 'ARRAY' && !ref $_[0]->[0] ) {
        $fields = shift;
    }
    else {
        $fields = [ sort keys %{ $_[0]->[0] } ];
    }

    ( $data, $opts ) = @_;

    $opts ||= +{};
    $opts->{fields} ||= $fields;

    return ( $data, $opts );
}

sub update_multi {
    my $self  = shift;
    my $table = $self->_table(shift);
    my ( $data, $opts ) = $self->_insert_multi_process_args(@_);

    my %ignore;
    if ($opts->{update_ignore_fields}) {
        @ignore{@{$opts->{update_ignore_fields}}} = map { 1 } @{$opts->{update_ignore_fields}};
    }

    $opts->{update} = +{
        map {
            my ( $k, $v ) = ( $_, $self->_sqlcase('values( ') . $_ . ' )' );
            ( $k, \$v );
        }
        grep { !exists $ignore{$_} }
        @{ $opts->{fields} }
    };

    my ( $sql, @bind ) = $self->_insert_multi( $table, $data, $opts );
    return wantarray ? ( $sql, @bind ) : $sql;
}

1;
__END__