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; |