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


line stmt bran cond sub pod time code
1             package SQL::Abstract::Plugin::InsertMulti;
2              
3 3     3   226106 use strict;
  3         29  
  3         91  
4 3     3   18 use warnings;
  3         6  
  3         119  
5              
6             our $VERSION = '0.05';
7              
8 3     3   16 use Carp ();
  3         6  
  3         150  
9 3         36 use Sub::Exporter -setup => +{
10             into => 'SQL::Abstract',
11             exports => [
12             qw/insert_multi update_multi _insert_multi _insert_multi_HASHREF _insert_multi_ARRAYREF _insert_multi_values _insert_multi_process_args/
13             ],
14             groups => +{
15             default => [
16             qw/insert_multi update_multi _insert_multi _insert_multi_HASHREF _insert_multi_ARRAYREF _insert_multi_values _insert_multi_process_args/
17             ]
18             },
19 3     3   1620 };
  3         35848  
20              
21             sub insert_multi {
22 6     6 1 19644 my $self = shift;
23 6         22 my $table = $self->_table(shift);
24 6         399 my ( $data, $opts, $fields ) = $self->_insert_multi_process_args(@_);
25 6         21 my ( $sql, @bind ) = $self->_insert_multi( $table, $data, $opts );
26 5 50       43 return wantarray ? ( $sql, @bind ) : $sql;
27             }
28              
29             sub _insert_multi {
30 9     9   20 my ( $self, $table, $data, $opts ) = @_;
31              
32 9         45 my $method = $self->_METHOD_FOR_refkind( '_insert_multi', $data->[0] );
33 9         303 my ( $sql, @bind ) = $self->$method( $data, $opts );
34             $sql = '( '
35 7         15 . join( ', ', ( map { $self->_quote($_) } @{ $opts->{fields} } ) ) . ' ) '
  38         355  
  7         20  
36             . $sql;
37              
38 35         120 $sql = join ' ' => grep { defined $_ } (
39             $self->_sqlcase('insert'),
40             $opts->{option},
41 7 100       95 $self->_sqlcase( ( $opts->{ignore} ) ? 'ignore' : 'into' ),
42             $table, $sql,
43             );
44              
45 7 100       20 if ($opts->{returning}) {
46 1         5 my ($s, @b) = $self->_insert_returning($opts);
47 1         80 $sql .= $s;
48 1         3 push @bind, @b;
49             }
50              
51 7         36 return ( $sql, @bind );
52             }
53              
54             sub _insert_multi_HASHREF {
55 8     8   20 my ( $self, $data, $opts ) = @_;
56 8         21 my ( $sql, @bind ) = $self->_insert_multi_values( $data, $opts );
57 6         25 return ( $sql, @bind );
58             }
59              
60             sub _insert_multi_ARRAYREF {
61 1     1   2 my ( $self, $data, $opts ) = @_;
62             my ( $sql, @bind ) = $self->_insert_multi_values(
63             [
64             map {
65 1         4 my %h;
  4         6  
66 4         8 @h{ @{ $opts->{fields} } } = @$_;
  4         12  
67 4         12 \%h;
68             } @$data
69             ],
70             $opts
71             );
72 1         8 return ( $sql, @bind );
73             }
74              
75             sub _insert_multi_values {
76 9     9   19 my ( $self, $data, $opts ) = @_;
77              
78 9         17 my ( @value_sqls, @all_bind );
79              
80 9         19 for my $d (@$data) {
81 28         63 my @values;
82 28         41 for my $column ( @{$opts->{fields}} ) {
  28         61  
83 150         769 my $v = $d->{$column};
84              
85             $self->_SWITCH_refkind(
86             $v,
87             {
88             ARRAYREFREF => sub { # literal SQL with bind
89 0     0   0 my ( $sql, @bind ) = @${$v};
  0         0  
90              
91             # $self->_assert_bindval_matches_bindtype(@bind);
92 0         0 push @values, $sql;
93 0         0 push @all_bind, @bind;
94             },
95              
96             # THINK : anything useful to do with a HASHREF ?
97             HASHREF => sub { # (nothing, but old SQLA passed it through)
98             #TODO in SQLA >= 2.0 it will die instead
99 0     0   0 push @values, '?';
100 0         0 push @all_bind, $self->_bindtype( $column, $v );
101             },
102             SCALARREF => sub { # literal SQL without bind
103 54     54   1716 push @values, $$v;
104             },
105             SCALAR_or_UNDEF => sub {
106 94     94   2327 push @values, '?';
107 94         203 push @all_bind, $self->_bindtype( $column, $v );
108             },
109             }
110 150         951 );
111             }
112 26         223 push( @value_sqls, '( ' . join( ', ' => @values ) . ' )' );
113             }
114              
115 7         20 my $sql = $self->_sqlcase('values') . ' ' . join( ', ' => @value_sqls );
116              
117 7 100       54 if ( $opts->{update} ) {
118 3         5 my @set;
119              
120 3         5 for my $k ( sort keys %{ $opts->{update} } ) {
  3         17  
121 9         18 my $v = $opts->{update}{$k};
122 9         16 my $r = ref $v;
123 9         20 my $label = $self->_quote($k);
124              
125             $self->_SWITCH_refkind(
126             $v,
127             {
128             ARRAYREFREF => sub { # literal SQL with bind
129 0     0   0 my ( $sql, @bind ) = @${$v};
  0         0  
130 0         0 push @set, "$label = $sql";
131 0         0 push @all_bind, @bind;
132             },
133             SCALARREF => sub { # literal SQL without bind
134 8     8   261 push @set, "$label = $$v";
135             },
136             SCALAR_or_UNDEF => sub {
137 1     1   27 push @set, "$label = ?";
138 1         4 push @all_bind, $self->_bindtype( $k, $v );
139             },
140             }
141 9         156 );
142             }
143              
144             $sql .=
145 3         18 $self->_sqlcase(' on duplicate key update ') . join( ', ', @set );
146             }
147              
148 7         52 return ( $sql, @all_bind );
149             }
150              
151             sub _insert_multi_process_args {
152 9     9   25 my $self = shift;
153 9         19 my ( $data, $opts, $fields );
154              
155 9 100 66     57 if ( ref $_[0] eq 'ARRAY' && !ref $_[0]->[0] ) {
156 1         3 $fields = shift;
157             }
158             else {
159 8         17 $fields = [ sort keys %{ $_[0]->[0] } ];
  8         55  
160             }
161              
162 9         21 ( $data, $opts ) = @_;
163              
164 9   100     33 $opts ||= +{};
165 9   33     42 $opts->{fields} ||= $fields;
166              
167 9         24 return ( $data, $opts );
168             }
169              
170             sub update_multi {
171 3     3 1 12274 my $self = shift;
172 3         11 my $table = $self->_table(shift);
173 3         177 my ( $data, $opts ) = $self->_insert_multi_process_args(@_);
174              
175 3         7 my %ignore;
176 3 100       11 if ($opts->{update_ignore_fields}) {
177 1         2 @ignore{@{$opts->{update_ignore_fields}}} = map { 1 } @{$opts->{update_ignore_fields}};
  1         4  
  4         9  
  1         3  
178             }
179            
180             $opts->{update} = +{
181             map {
182 9         23 my ( $k, $v ) = ( $_, $self->_sqlcase('values( ') . $_ . ' )' );
183 9         57 ( $k, \$v );
184             }
185 13         28 grep { !exists $ignore{$_} }
186 3         7 @{ $opts->{fields} }
  3         9  
187             };
188              
189 3         12 my ( $sql, @bind ) = $self->_insert_multi( $table, $data, $opts );
190 2 50       18 return wantarray ? ( $sql, @bind ) : $sql;
191             }
192              
193             1;
194             __END__