| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# The contents of this file are Copyright (c) 2010 Daniel Norman |
|
2
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
|
3
|
|
|
|
|
|
|
# modify it under the terms of the GNU General Public License as |
|
4
|
|
|
|
|
|
|
# published by the Free Software Foundation. |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
########################################### |
|
7
|
|
|
|
|
|
|
package DBR::Query::Insert; |
|
8
|
|
|
|
|
|
|
|
|
9
|
18
|
|
|
18
|
|
116
|
use strict; |
|
|
18
|
|
|
|
|
46
|
|
|
|
18
|
|
|
|
|
783
|
|
|
10
|
18
|
|
|
18
|
|
123
|
use base 'DBR::Query'; |
|
|
18
|
|
|
|
|
38
|
|
|
|
18
|
|
|
|
|
1949
|
|
|
11
|
18
|
|
|
18
|
|
112
|
use Carp; |
|
|
18
|
|
|
|
|
37
|
|
|
|
18
|
|
|
|
|
22111
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
497
|
|
|
497
|
|
1972
|
sub _params { qw (sets tables where limit quiet_error) } |
|
14
|
497
|
|
|
497
|
|
2185
|
sub _reqparams { qw (sets tables) } |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub sets{ |
|
17
|
497
|
|
|
497
|
0
|
1279
|
my $self = shift; |
|
18
|
497
|
0
|
0
|
|
|
1771
|
exists( $_[0] ) or return wantarray?( @$self->{sets} ) : $self->{sets} || undef; |
|
|
|
50
|
|
|
|
|
|
|
19
|
497
|
|
|
|
|
4033
|
my @sets = $self->_arrayify(@_); |
|
20
|
497
|
50
|
|
|
|
1948
|
scalar(@sets) || croak('must provide at least one set'); |
|
21
|
|
|
|
|
|
|
|
|
22
|
497
|
|
|
|
|
1266
|
for (@sets){ |
|
23
|
2030
|
50
|
|
|
|
8306
|
ref($_) eq 'DBR::Query::Part::Set' || croak('arguments must be Sets'); |
|
24
|
|
|
|
|
|
|
} |
|
25
|
|
|
|
|
|
|
|
|
26
|
497
|
|
|
|
|
1411
|
$self->{sets} = \@sets; |
|
27
|
|
|
|
|
|
|
|
|
28
|
497
|
|
|
|
|
1728
|
$self->_check_fields; |
|
29
|
|
|
|
|
|
|
|
|
30
|
497
|
|
|
|
|
1726
|
return 1; |
|
31
|
|
|
|
|
|
|
} |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub _check_fields{ |
|
34
|
994
|
|
|
994
|
|
2067
|
my $self = shift; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Make sure we have sets for all required fields |
|
37
|
|
|
|
|
|
|
# It may be slightly more efficient to enforce this in ::Interface::Object->insert, but it seems more correct here. |
|
38
|
|
|
|
|
|
|
|
|
39
|
994
|
100
|
66
|
|
|
7082
|
return 0 unless $self->{sets} && $self->{tables}; |
|
40
|
|
|
|
|
|
|
|
|
41
|
497
|
|
|
|
|
17849
|
my %fids = map { $_->field->field_id => 1 } grep { defined $_->field->field_id } @{ $self->{sets} }; |
|
|
5
|
|
|
|
|
15
|
|
|
|
2030
|
|
|
|
|
7532
|
|
|
|
497
|
|
|
|
|
1313
|
|
|
42
|
|
|
|
|
|
|
|
|
43
|
497
|
|
|
|
|
2626
|
my $reqfields = $self->primary_table->req_fields(); |
|
44
|
497
|
|
|
|
|
1066
|
my @missing; |
|
45
|
497
|
|
|
|
|
1694
|
foreach my $field ( grep { !$fids{ $_->field_id } } @$reqfields ){ |
|
|
4
|
|
|
|
|
16
|
|
|
46
|
1
|
50
|
|
|
|
7
|
if ( defined ( my $v = $field->default_val ) ){ |
|
47
|
0
|
0
|
|
|
|
0
|
my $value = $field->makevalue( $v ) or croak "failed to build value object for " . $field->name; |
|
48
|
0
|
0
|
|
|
|
0
|
my $set = DBR::Query::Part::Set->new($field,$value) or confess 'failed to create set object'; |
|
49
|
0
|
|
|
|
|
0
|
push @{ $self->{sets} }, $set; |
|
|
0
|
|
|
|
|
0
|
|
|
50
|
|
|
|
|
|
|
}else{ |
|
51
|
1
|
|
|
|
|
5
|
push @missing, $field; |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
} |
|
55
|
497
|
100
|
|
|
|
1472
|
if(@missing){ |
|
56
|
1
|
|
|
|
|
5
|
croak "Invalid insert. Missing fields (" . |
|
57
|
1
|
|
|
|
|
4
|
join(', ', map { $_->name } @missing) . ")"; |
|
58
|
|
|
|
|
|
|
} |
|
59
|
496
|
|
|
|
|
5667
|
$self->{_fields_checked} = 1; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _validate_self{ |
|
63
|
497
|
|
|
497
|
|
1399
|
my $self = shift; |
|
64
|
|
|
|
|
|
|
|
|
65
|
497
|
50
|
|
|
|
740
|
@{$self->{tables}} == 1 or croak "Must have exactly one table"; |
|
|
497
|
|
|
|
|
2600
|
|
|
66
|
497
|
50
|
|
|
|
5582
|
$self->{sets} or croak "Must have at least one set"; |
|
67
|
|
|
|
|
|
|
|
|
68
|
497
|
50
|
|
|
|
2298
|
$self->_check_fields unless $self->{_fields_checked}; |
|
69
|
|
|
|
|
|
|
|
|
70
|
496
|
|
|
|
|
1850
|
return 1; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub sql{ |
|
74
|
496
|
|
|
496
|
0
|
854
|
my $self = shift; |
|
75
|
|
|
|
|
|
|
|
|
76
|
496
|
50
|
|
|
|
1470
|
my $conn = $self->instance->connect('conn') or return $self->_error('failed to connect'); |
|
77
|
496
|
|
|
|
|
965
|
my $sql; |
|
78
|
496
|
|
|
|
|
781
|
my $tables = join(',', map {$_->sql} @{$self->{tables}} ); |
|
|
496
|
|
|
|
|
1685
|
|
|
|
496
|
|
|
|
|
2098
|
|
|
79
|
|
|
|
|
|
|
|
|
80
|
496
|
|
|
|
|
882
|
my @fields; |
|
81
|
|
|
|
|
|
|
my @values; |
|
82
|
496
|
|
|
|
|
1035
|
for ( @{$self->{sets}} ) { |
|
|
496
|
|
|
|
|
1671
|
|
|
83
|
2029
|
|
|
|
|
19416
|
push @fields, $_->field->sql( $conn ); |
|
84
|
2029
|
|
|
|
|
6389
|
push @values, $_->value->sql( $conn ); |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
|
|
87
|
496
|
|
|
|
|
3960
|
$sql = "INSERT INTO $tables (" . join (', ', @fields) . ') values (' . join (', ', @values) . ')'; |
|
88
|
|
|
|
|
|
|
|
|
89
|
496
|
50
|
|
|
|
1676
|
$sql .= ' WHERE ' . $self->{where}->sql( $conn ) if $self->{where}; |
|
90
|
496
|
50
|
|
|
|
1745
|
$sql .= ' FOR UPDATE' if $self->{lock}; |
|
91
|
496
|
50
|
|
|
|
1337
|
$sql .= ' LIMIT ' . $self->{limit} if $self->{limit}; |
|
92
|
|
|
|
|
|
|
|
|
93
|
496
|
|
|
|
|
2917
|
$self->_logDebug2( $sql ); |
|
94
|
496
|
|
|
|
|
3897
|
return $sql; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub run{ |
|
98
|
496
|
|
|
496
|
0
|
882
|
my $self = shift; |
|
99
|
496
|
|
|
|
|
862
|
my %params = @_; |
|
100
|
|
|
|
|
|
|
|
|
101
|
496
|
50
|
|
|
|
3632
|
my $conn = $self->instance->connect('conn') or return $self->_error('failed to connect'); |
|
102
|
|
|
|
|
|
|
|
|
103
|
496
|
100
|
|
|
|
2379
|
$conn->quiet_next_error if $self->quiet_error; |
|
104
|
496
|
50
|
|
|
|
2060
|
$conn->prepSequence() or confess 'Failed to prepare sequence'; |
|
105
|
|
|
|
|
|
|
|
|
106
|
496
|
50
|
|
|
|
1787
|
my $rows = $conn->do( $self->sql ) or return $self->_error("Insert failed"); |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Tiny optimization: if we are being executed in a void context, then we |
|
109
|
|
|
|
|
|
|
# don't care about the sequence value. save the round trip and reduce latency. |
|
110
|
496
|
50
|
|
|
|
2110
|
return 1 if $params{void}; |
|
111
|
|
|
|
|
|
|
|
|
112
|
496
|
|
|
|
|
2702
|
my ($sequenceval) = $conn->getSequenceValue(); |
|
113
|
|
|
|
|
|
|
|
|
114
|
496
|
|
|
|
|
16445
|
return $sequenceval; |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
1; |