line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
use strict; |
2
|
69
|
|
|
69
|
|
6003939
|
use warnings; |
|
69
|
|
|
|
|
737
|
|
|
69
|
|
|
|
|
1671
|
|
3
|
69
|
|
|
69
|
|
310
|
use Carp (); |
|
69
|
|
|
|
|
99
|
|
|
69
|
|
|
|
|
1476
|
|
4
|
69
|
|
|
69
|
|
286
|
use Class::Load 0.06 (); |
|
69
|
|
|
|
|
104
|
|
|
69
|
|
|
|
|
1680
|
|
5
|
69
|
|
|
69
|
|
25292
|
use DBI 1.33; |
|
69
|
|
|
|
|
1197480
|
|
|
69
|
|
|
|
|
1853
|
|
6
|
69
|
|
|
69
|
|
83724
|
use Scalar::Util; |
|
69
|
|
|
|
|
971097
|
|
|
69
|
|
|
|
|
3785
|
|
7
|
69
|
|
|
69
|
|
561
|
use SQL::Maker::SQLType qw(sql_type); |
|
69
|
|
|
|
|
122
|
|
|
69
|
|
|
|
|
2512
|
|
8
|
69
|
|
|
69
|
|
28035
|
use Teng::Row; |
|
69
|
|
|
|
|
24425
|
|
|
69
|
|
|
|
|
3259
|
|
9
|
69
|
|
|
69
|
|
25077
|
use Teng::Iterator; |
|
69
|
|
|
|
|
161
|
|
|
69
|
|
|
|
|
2006
|
|
10
|
69
|
|
|
69
|
|
24227
|
use Teng::Schema; |
|
69
|
|
|
|
|
198
|
|
|
69
|
|
|
|
|
1972
|
|
11
|
69
|
|
|
69
|
|
23292
|
use DBIx::TransactionManager 1.06; |
|
69
|
|
|
|
|
158
|
|
|
69
|
|
|
|
|
1973
|
|
12
|
69
|
|
|
69
|
|
24017
|
use Teng::QueryBuilder; |
|
69
|
|
|
|
|
55424
|
|
|
69
|
|
|
|
|
1687
|
|
13
|
69
|
|
|
69
|
|
22075
|
use Class::Accessor::Lite 0.05 |
|
69
|
|
|
|
|
192
|
|
|
69
|
|
|
|
|
3076
|
|
14
|
|
|
|
|
|
|
rw => [ qw( |
15
|
69
|
|
|
|
|
483
|
connect_info |
16
|
|
|
|
|
|
|
on_connect_do |
17
|
|
|
|
|
|
|
schema |
18
|
|
|
|
|
|
|
schema_class |
19
|
|
|
|
|
|
|
suppress_row_objects |
20
|
|
|
|
|
|
|
sql_builder |
21
|
|
|
|
|
|
|
sql_comment |
22
|
|
|
|
|
|
|
owner_pid |
23
|
|
|
|
|
|
|
no_ping |
24
|
|
|
|
|
|
|
fields_case |
25
|
|
|
|
|
|
|
apply_sql_types |
26
|
|
|
|
|
|
|
guess_sql_types |
27
|
|
|
|
|
|
|
trace_ignore_if |
28
|
|
|
|
|
|
|
)] |
29
|
|
|
|
|
|
|
; |
30
|
69
|
|
|
69
|
|
446
|
|
|
69
|
|
|
|
|
1282
|
|
31
|
|
|
|
|
|
|
our $VERSION = '0.33'; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
3
|
|
|
my ($class, $pkg, $opt) = @_; |
35
|
|
|
|
|
|
|
$pkg = $pkg =~ s/^\+// ? $pkg : "Teng::Plugin::$pkg"; |
36
|
|
|
|
|
|
|
Class::Load::load_class($pkg); |
37
|
66
|
|
|
66
|
1
|
38511
|
|
38
|
66
|
100
|
|
|
|
399
|
$class = ref($class) if ref($class); |
39
|
66
|
|
|
|
|
262
|
|
40
|
|
|
|
|
|
|
my $alias = delete $opt->{alias} || +{}; |
41
|
66
|
50
|
|
|
|
3028
|
{ |
42
|
|
|
|
|
|
|
no strict 'refs'; |
43
|
66
|
|
100
|
|
|
403
|
for my $method ( @{"${pkg}::EXPORT"} ){ |
44
|
|
|
|
|
|
|
*{$class . '::' . ($alias->{$method} || $method)} = $pkg->can($method); |
45
|
69
|
|
|
69
|
|
17752
|
} |
|
69
|
|
|
|
|
168
|
|
|
69
|
|
|
|
|
267603
|
|
|
66
|
|
|
|
|
110
|
|
46
|
66
|
|
|
|
|
121
|
} |
|
66
|
|
|
|
|
337
|
|
47
|
68
|
|
66
|
|
|
562
|
|
|
68
|
|
|
|
|
558
|
|
48
|
|
|
|
|
|
|
$pkg->init($class, $opt) if $pkg->can('init'); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
66
|
100
|
|
|
|
514
|
my $class = shift; |
52
|
|
|
|
|
|
|
my %args = @_ == 1 ? %{$_[0]} : @_; |
53
|
|
|
|
|
|
|
my $loader = delete $args{loader}; |
54
|
|
|
|
|
|
|
|
55
|
91
|
|
|
91
|
1
|
630534
|
if ( my $mode = delete $args{mode} ) { |
56
|
91
|
100
|
|
|
|
461
|
warn "IMPORTANT: 'mode' option is DEPRECATED AND *WILL* BE REMOVED. PLEASE USE 'no_ping' option.\n"; |
|
77
|
|
|
|
|
383
|
|
57
|
91
|
|
|
|
|
238
|
if ( !exists $args{no_ping} ) { |
58
|
|
|
|
|
|
|
$args{no_ping} = $mode eq 'ping' ? 0 : 1; |
59
|
91
|
100
|
|
|
|
360
|
} |
60
|
2
|
|
|
|
|
181
|
} |
61
|
2
|
50
|
|
|
|
18
|
|
62
|
2
|
100
|
|
|
|
10
|
my $self = bless { |
63
|
|
|
|
|
|
|
schema_class => "$class\::Schema", |
64
|
|
|
|
|
|
|
owner_pid => $$, |
65
|
|
|
|
|
|
|
no_ping => 0, |
66
|
|
|
|
|
|
|
fields_case => 'NAME_lc', |
67
|
|
|
|
|
|
|
boolean_value => {true => 1, false => 0}, |
68
|
|
|
|
|
|
|
trace_ignore_if => $args{trace_ignore_if} || \&_noop, |
69
|
|
|
|
|
|
|
%args, |
70
|
|
|
|
|
|
|
}, $class; |
71
|
|
|
|
|
|
|
|
72
|
91
|
|
50
|
|
|
1731
|
if (!$loader && ! $self->schema) { |
73
|
|
|
|
|
|
|
my $schema_class = $self->{schema_class}; |
74
|
|
|
|
|
|
|
Class::Load::load_class( $schema_class ); |
75
|
|
|
|
|
|
|
my $schema = $schema_class->instance; |
76
|
91
|
100
|
100
|
|
|
832
|
if (! $schema) { |
77
|
86
|
|
|
|
|
855
|
Carp::croak("schema object was not passed, and could not get schema instance from $schema_class"); |
78
|
86
|
|
|
|
|
434
|
} |
79
|
86
|
|
|
|
|
8163
|
$schema->namespace($class); |
80
|
86
|
50
|
|
|
|
472
|
$self->schema( $schema ); |
81
|
0
|
|
|
|
|
0
|
} |
82
|
|
|
|
|
|
|
|
83
|
86
|
|
|
|
|
549
|
unless ($self->connect_info || $self->{dbh}) { |
84
|
86
|
|
|
|
|
660
|
Carp::croak("'dbh' or 'connect_info' is required."); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
91
|
50
|
66
|
|
|
932
|
if ( ! $self->{dbh} ) { |
88
|
0
|
|
|
|
|
0
|
$self->connect; |
89
|
|
|
|
|
|
|
} else { |
90
|
|
|
|
|
|
|
$self->_prepare_from_dbh; |
91
|
91
|
100
|
|
|
|
988
|
} |
92
|
20
|
|
|
|
|
71
|
|
93
|
|
|
|
|
|
|
return $self; |
94
|
71
|
|
|
|
|
412
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
my $self = shift; |
97
|
89
|
|
|
|
|
1894
|
if (@_) { |
98
|
|
|
|
|
|
|
my ($true, $false) = @_; |
99
|
|
|
|
|
|
|
$self->{boolean_value} = {true => $true, false => $false}; |
100
|
|
|
|
|
|
|
} |
101
|
1
|
|
|
1
|
1
|
2788
|
return $self->{boolean_value}; |
102
|
1
|
50
|
|
|
|
4
|
} |
103
|
1
|
|
|
|
|
3
|
|
104
|
1
|
|
|
|
|
6
|
my $self = shift; |
105
|
|
|
|
|
|
|
warn "IMPORTANT: 'mode' option is DEPRECATED AND *WILL* BE REMOVED. PLEASE USE 'no_ping' option.\n"; |
106
|
1
|
|
|
|
|
3
|
|
107
|
|
|
|
|
|
|
if ( @_ ) { |
108
|
|
|
|
|
|
|
my $mode = shift; |
109
|
|
|
|
|
|
|
if ( $mode eq 'ping' ) { |
110
|
0
|
|
|
0
|
1
|
0
|
$self->no_ping(0); |
111
|
0
|
|
|
|
|
0
|
} |
112
|
|
|
|
|
|
|
else { |
113
|
0
|
0
|
|
|
|
0
|
$self->no_ping(1); |
114
|
0
|
|
|
|
|
0
|
} |
115
|
0
|
0
|
|
|
|
0
|
} |
116
|
0
|
|
|
|
|
0
|
|
117
|
|
|
|
|
|
|
return $self->no_ping ? 'no_ping' : 'ping'; |
118
|
|
|
|
|
|
|
} |
119
|
0
|
|
|
|
|
0
|
|
120
|
|
|
|
|
|
|
# forcefully connect |
121
|
|
|
|
|
|
|
my ($self, @args) = @_; |
122
|
|
|
|
|
|
|
|
123
|
0
|
0
|
|
|
|
0
|
$self->in_transaction_check; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
if (@args) { |
126
|
|
|
|
|
|
|
$self->connect_info( \@args ); |
127
|
|
|
|
|
|
|
} |
128
|
28
|
|
|
28
|
1
|
5094
|
my $connect_info = $self->connect_info; |
129
|
|
|
|
|
|
|
$connect_info->[3] = { |
130
|
28
|
|
|
|
|
117
|
# basic defaults |
131
|
|
|
|
|
|
|
AutoCommit => 1, |
132
|
26
|
50
|
|
|
|
90
|
PrintError => 0, |
133
|
0
|
|
|
|
|
0
|
RaiseError => 1, |
134
|
|
|
|
|
|
|
%{ $connect_info->[3] || {} }, |
135
|
26
|
|
|
|
|
60
|
}; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
$self->{dbh} = eval { DBI->connect(@$connect_info) } |
138
|
|
|
|
|
|
|
or Carp::croak("Connection error: " . ($@ || $DBI::errstr)); |
139
|
|
|
|
|
|
|
delete $self->{txn_manager}; |
140
|
|
|
|
|
|
|
|
141
|
26
|
100
|
|
|
|
96
|
$self->owner_pid($$); |
|
26
|
|
|
|
|
151
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$self->_on_connect_do; |
144
|
26
|
100
|
33
|
|
|
61
|
$self->_prepare_from_dbh; |
|
26
|
|
|
|
|
132
|
|
145
|
|
|
|
|
|
|
} |
146
|
25
|
|
|
|
|
93741
|
|
147
|
|
|
|
|
|
|
my $self = shift; |
148
|
25
|
|
|
|
|
163
|
|
149
|
|
|
|
|
|
|
if ( my $on_connect_do = $self->on_connect_do ) { |
150
|
25
|
|
|
|
|
235
|
if (not ref($on_connect_do)) { |
151
|
24
|
|
|
|
|
177
|
$self->do($on_connect_do); |
152
|
|
|
|
|
|
|
} elsif (ref($on_connect_do) eq 'CODE') { |
153
|
|
|
|
|
|
|
$on_connect_do->($self); |
154
|
|
|
|
|
|
|
} elsif (ref($on_connect_do) eq 'ARRAY') { |
155
|
74
|
|
|
74
|
|
121
|
$self->do($_) for @$on_connect_do; |
156
|
|
|
|
|
|
|
} else { |
157
|
74
|
100
|
|
|
|
298
|
Carp::croak('Invalid on_connect_do: '.ref($on_connect_do)); |
158
|
17
|
100
|
|
|
|
110
|
} |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
159
|
4
|
|
|
|
|
13
|
} |
160
|
|
|
|
|
|
|
} |
161
|
8
|
|
|
|
|
23
|
|
162
|
|
|
|
|
|
|
my $self = shift; |
163
|
4
|
|
|
|
|
14
|
|
164
|
|
|
|
|
|
|
$self->in_transaction_check; |
165
|
1
|
|
|
|
|
94
|
|
166
|
|
|
|
|
|
|
my $dbh = $self->{dbh}; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
$self->disconnect(); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
if ( @_ ) { |
171
|
58
|
|
|
58
|
1
|
367216
|
$self->connect(@_); |
172
|
|
|
|
|
|
|
} |
173
|
58
|
|
|
|
|
354
|
else { |
174
|
|
|
|
|
|
|
# Why don't use $dbh->clone({InactiveDestroy => 0}) ? |
175
|
50
|
|
|
|
|
233
|
# because, DBI v1.616 clone with \%attr has bug. |
176
|
|
|
|
|
|
|
# my $dbh2 = $dbh->clone({}); |
177
|
50
|
|
|
|
|
260
|
# my $dbh3 = $dbh2->clone({}); |
178
|
|
|
|
|
|
|
# $dbh2 is ok, but $dbh3 is undef. |
179
|
50
|
50
|
|
|
|
335
|
# --- |
180
|
0
|
|
|
|
|
0
|
# Don't assign $self-{dbh} directry. |
181
|
|
|
|
|
|
|
# Because if $self->{dbh} is undef then reconnect fail always. |
182
|
|
|
|
|
|
|
# https://github.com/nekokak/p5-Teng/pull/98 |
183
|
|
|
|
|
|
|
my $new_dbh = eval { $dbh->clone } |
184
|
|
|
|
|
|
|
or Carp::croak("ReConnection error: " . ($@ || $DBI::errstr)); |
185
|
|
|
|
|
|
|
$self->{dbh} = $new_dbh; |
186
|
|
|
|
|
|
|
$self->{dbh}->{InactiveDestroy} = 0; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$self->owner_pid($$); |
189
|
|
|
|
|
|
|
$self->_on_connect_do; |
190
|
|
|
|
|
|
|
$self->_prepare_from_dbh; |
191
|
|
|
|
|
|
|
} |
192
|
50
|
100
|
33
|
|
|
112
|
} |
|
50
|
|
|
|
|
588
|
|
193
|
|
|
|
|
|
|
|
194
|
49
|
|
|
|
|
23917
|
my $self = shift; |
195
|
49
|
|
|
|
|
196
|
|
196
|
|
|
|
|
|
|
delete $self->{txn_manager}; |
197
|
49
|
|
|
|
|
191
|
if ( my $dbh = $self->{dbh} ) { |
198
|
49
|
|
|
|
|
395
|
if ( $self->owner_pid && ($self->owner_pid != $$) ) { |
199
|
49
|
|
|
|
|
343
|
$dbh->{InactiveDestroy} = 1; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
else { |
202
|
|
|
|
|
|
|
$dbh->disconnect; |
203
|
|
|
|
|
|
|
} |
204
|
52
|
|
|
52
|
1
|
4028
|
} |
205
|
|
|
|
|
|
|
$self->owner_pid(undef); |
206
|
52
|
|
|
|
|
142
|
} |
207
|
52
|
50
|
|
|
|
227
|
|
208
|
52
|
100
|
100
|
|
|
201
|
my $self = shift; |
209
|
3
|
|
|
|
|
648
|
|
210
|
|
|
|
|
|
|
$self->{driver_name} = $self->{dbh}->{Driver}->{Name}; |
211
|
|
|
|
|
|
|
my $builder = $self->{sql_builder}; |
212
|
49
|
|
|
|
|
3549
|
if (! $builder ) { |
213
|
|
|
|
|
|
|
my $sql_builder_class = $self->{sql_builder_class} || 'Teng::QueryBuilder'; |
214
|
|
|
|
|
|
|
$builder = $sql_builder_class->new( |
215
|
52
|
|
|
|
|
462
|
driver => $self->{driver_name}, |
216
|
|
|
|
|
|
|
%{ $self->{sql_builder_args} || {} } |
217
|
|
|
|
|
|
|
); |
218
|
|
|
|
|
|
|
$self->sql_builder( $builder ); |
219
|
144
|
|
|
144
|
|
273
|
} |
220
|
|
|
|
|
|
|
$self->{dbh}->{FetchHashKeyName} = $self->{fields_case}; |
221
|
144
|
|
|
|
|
1939
|
|
222
|
144
|
|
|
|
|
469
|
$self->{schema}->prepare_from_dbh($self->{dbh}) if $self->{schema}; |
223
|
144
|
100
|
|
|
|
571
|
} |
224
|
89
|
|
100
|
|
|
645
|
|
225
|
|
|
|
|
|
|
my $self = shift; |
226
|
|
|
|
|
|
|
|
227
|
89
|
100
|
|
|
|
261
|
if ( !$self->owner_pid || $self->owner_pid != $$ ) { |
|
89
|
|
|
|
|
1535
|
|
228
|
|
|
|
|
|
|
$self->reconnect; |
229
|
89
|
|
|
|
|
3708
|
} |
230
|
|
|
|
|
|
|
elsif ( my $dbh = $self->{dbh} ) { |
231
|
144
|
|
|
|
|
1255
|
if ( !$dbh->FETCH('Active') ) { |
232
|
|
|
|
|
|
|
$self->reconnect; |
233
|
144
|
100
|
|
|
|
2156
|
} |
234
|
|
|
|
|
|
|
elsif ( !$self->no_ping && !$dbh->ping) { |
235
|
|
|
|
|
|
|
$self->reconnect; |
236
|
|
|
|
|
|
|
} |
237
|
726
|
|
|
726
|
|
894
|
} |
238
|
|
|
|
|
|
|
} |
239
|
726
|
100
|
66
|
|
|
1510
|
|
|
|
50
|
|
|
|
|
|
240
|
1
|
|
|
|
|
264
|
my $self = shift; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
$self->_verify_pid; |
243
|
725
|
50
|
100
|
|
|
12352
|
$self->{dbh}; |
|
|
100
|
|
|
|
|
|
244
|
0
|
|
|
|
|
0
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $self = shift; |
247
|
12
|
|
|
|
|
676
|
my $dbh = $self->{dbh}; |
248
|
|
|
|
|
|
|
return $self->owner_pid && $dbh->ping; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
my $self = shift; |
252
|
|
|
|
|
|
|
warn "IMPORTANT: '_execute' method is DEPRECATED AND *WILL* BE REMOVED. PLEASE USE 'execute' method.\n"; |
253
|
659
|
|
|
659
|
1
|
29475
|
return $self->execute(@_); |
254
|
|
|
|
|
|
|
} |
255
|
659
|
|
|
|
|
1462
|
|
256
|
655
|
|
|
|
|
17884
|
our $SQL_COMMENT_LEVEL = 1; |
257
|
|
|
|
|
|
|
my ($self, $sql) = @_; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
my $i = $SQL_COMMENT_LEVEL; # optimize, as we would *NEVER* be called |
260
|
0
|
|
|
0
|
1
|
0
|
while ( my (@caller) = caller($i++) ) { |
261
|
0
|
|
|
|
|
0
|
next if ( $caller[0]->isa( __PACKAGE__ ) ); |
262
|
0
|
|
0
|
|
|
0
|
next if $caller[0] =~ /^Teng::/; # skip Teng::Row, Teng::Plugin::* etc. |
263
|
|
|
|
|
|
|
next if $self->trace_ignore_if->(@caller); |
264
|
|
|
|
|
|
|
my $comment = "$caller[1] at line $caller[2]"; |
265
|
|
|
|
|
|
|
$comment =~ s/\*\// /g; |
266
|
1
|
|
|
1
|
|
7285
|
$sql = "/* $comment */\n$sql"; |
267
|
1
|
|
|
|
|
7
|
last; |
268
|
1
|
|
|
|
|
6
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
return $sql; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
4
|
|
|
4
|
0
|
8
|
my ($self, $sql, $binds) = @_; |
274
|
|
|
|
|
|
|
|
275
|
4
|
|
|
|
|
6
|
if ($ENV{TENG_SQL_COMMENT} || $self->sql_comment) { |
276
|
4
|
|
|
|
|
26
|
$sql = $self->trace_query_set_comment($sql); |
277
|
5
|
50
|
|
|
|
51
|
} |
278
|
5
|
50
|
|
|
|
12
|
|
279
|
5
|
100
|
|
|
|
17
|
my $sth; |
280
|
4
|
|
|
|
|
17
|
eval { |
281
|
4
|
|
|
|
|
8
|
$sth = $self->dbh->prepare($sql); |
282
|
4
|
|
|
|
|
10
|
my $i = 1; |
283
|
4
|
|
|
|
|
10
|
for my $v ( @{ $binds || [] } ) { |
284
|
|
|
|
|
|
|
if (Scalar::Util::blessed($v) && ref($v) eq 'SQL::Maker::SQLType') { |
285
|
|
|
|
|
|
|
$sth->bind_param($i++, ${$v->value_ref}, $v->type); |
286
|
4
|
|
|
|
|
8
|
} else { |
287
|
|
|
|
|
|
|
# allow array ref for using pg_types. e.g. [ $value => { pg_type => PG_BYTEA } ] |
288
|
|
|
|
|
|
|
# ref. https://metacpan.org/pod/DBD::Pg#quote |
289
|
|
|
|
|
|
|
$sth->bind_param( $i++, ref($v) eq 'ARRAY' ? @$v : $v ); |
290
|
419
|
|
|
419
|
1
|
13345
|
} |
291
|
|
|
|
|
|
|
} |
292
|
419
|
100
|
66
|
|
|
1896
|
$sth->execute(); |
293
|
4
|
|
|
|
|
20
|
}; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
if ($@) { |
296
|
419
|
|
|
|
|
2096
|
$self->handle_error($sql, $binds, $@); |
297
|
419
|
|
|
|
|
582
|
} |
298
|
419
|
|
|
|
|
850
|
|
299
|
413
|
|
|
|
|
32971
|
# When the return value is never used, should finish statement handler |
300
|
413
|
100
|
|
|
|
604
|
unless (defined wantarray) { |
|
413
|
|
|
|
|
1314
|
|
301
|
598
|
100
|
100
|
|
|
4044
|
$sth->finish(); |
302
|
327
|
|
|
|
|
505
|
return; |
|
327
|
|
|
|
|
760
|
|
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
return $sth; |
306
|
271
|
50
|
|
|
|
1578
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my ($self, $table_name, $column) = @_; |
309
|
413
|
|
|
|
|
418332
|
|
310
|
|
|
|
|
|
|
my $driver = $self->{driver_name}; |
311
|
|
|
|
|
|
|
if ( $driver eq 'mysql' ) { |
312
|
419
|
100
|
|
|
|
3825
|
return $self->{dbh}->{mysql_insertid}; |
313
|
12
|
|
|
|
|
90
|
} elsif ( $driver eq 'Pg' ) { |
314
|
|
|
|
|
|
|
if (defined $column) { |
315
|
|
|
|
|
|
|
return $self->dbh->last_insert_id( undef, undef, undef, undef,{ sequence => join( '_', $table_name, $column, 'seq' ) } ); |
316
|
|
|
|
|
|
|
} else { |
317
|
407
|
100
|
|
|
|
862
|
return $self->dbh->last_insert_id( undef, undef, $table_name, undef); |
318
|
2
|
|
|
|
|
15
|
} |
319
|
2
|
|
|
|
|
24
|
} elsif ( $driver eq 'SQLite' ) { |
320
|
|
|
|
|
|
|
return $self->dbh->func('last_insert_rowid'); |
321
|
|
|
|
|
|
|
} elsif ( $driver eq 'Oracle' ) { |
322
|
405
|
|
|
|
|
1168
|
return; |
323
|
|
|
|
|
|
|
} else { |
324
|
|
|
|
|
|
|
Carp::croak "Don't know how to get last insert id for $driver"; |
325
|
|
|
|
|
|
|
} |
326
|
27
|
|
|
27
|
|
75
|
} |
327
|
|
|
|
|
|
|
|
328
|
27
|
|
|
|
|
58
|
my ( $self, $table, $args ) = @_; |
329
|
27
|
50
|
|
|
|
142
|
my $bind_args = {}; |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
330
|
0
|
|
|
|
|
0
|
|
331
|
|
|
|
|
|
|
for my $col (keys %{$args}) { |
332
|
0
|
0
|
|
|
|
0
|
# if $args->{$col} is a ref, it is scalar ref or already |
333
|
0
|
|
|
|
|
0
|
# sql type bined parameter. so ignored. |
334
|
|
|
|
|
|
|
$bind_args->{$col} = ref $args->{$col} ? $args->{$col} : sql_type(\$args->{$col}, $table->get_sql_type($col)); |
335
|
0
|
|
|
|
|
0
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
return $bind_args; |
338
|
27
|
|
|
|
|
59
|
} |
339
|
|
|
|
|
|
|
|
340
|
0
|
|
|
|
|
0
|
my ($self, $table_name, $args, $prefix) = @_; |
341
|
|
|
|
|
|
|
|
342
|
0
|
|
|
|
|
0
|
$prefix ||= 'INSERT INTO'; |
343
|
|
|
|
|
|
|
my $table = $self->schema->get_table($table_name); |
344
|
|
|
|
|
|
|
if (! $table) { |
345
|
|
|
|
|
|
|
local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
346
|
|
|
|
|
|
|
Carp::croak( "Table definition for $table_name does not exist (Did you declare it in our schema?)" ); |
347
|
193
|
|
|
193
|
|
370
|
} |
348
|
193
|
|
|
|
|
317
|
|
349
|
|
|
|
|
|
|
for my $col (keys %{$args}) { |
350
|
193
|
|
|
|
|
311
|
$args->{$col} = $table->call_deflate($col, $args->{$col}); |
|
193
|
|
|
|
|
445
|
|
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
my $bind_args = $self->_bind_sql_type_to_args( $table, $args ); |
353
|
337
|
100
|
|
|
|
3851
|
my ($sql, @binds) = $self->{sql_builder}->insert( $table_name, $bind_args, { prefix => $prefix } ); |
354
|
|
|
|
|
|
|
$self->execute($sql, \@binds); |
355
|
|
|
|
|
|
|
} |
356
|
193
|
|
|
|
|
2696
|
|
357
|
|
|
|
|
|
|
my ($self, $table_name, $args, $prefix) = @_; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
my $sth = $self->do_insert($table_name, $args, $prefix); |
360
|
166
|
|
|
166
|
1
|
376
|
|
361
|
|
|
|
|
|
|
# XXX in MySQL 5.7.8 or later, $self->dbh->{mysql_insertid} will always return 0, |
362
|
166
|
|
50
|
|
|
802
|
# so that get mysql_insertid from $sth. (https://bugs.mysql.com/bug.php?id=78778) |
363
|
166
|
|
|
|
|
537
|
return $sth->{mysql_insertid} if defined $sth->{mysql_insertid}; |
364
|
166
|
100
|
|
|
|
450
|
|
365
|
1
|
|
|
|
|
3
|
# XXX in Pg, _last_insert_id has potential failure when inserting to non Serial table or explicitly inserting Serrial id |
366
|
1
|
|
|
|
|
180
|
$self->_last_insert_id($table_name); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
165
|
|
|
|
|
213
|
my ($self, $table_name, $args, $prefix) = @_; |
|
165
|
|
|
|
|
577
|
|
370
|
304
|
|
|
|
|
887
|
|
371
|
|
|
|
|
|
|
my $sth = $self->do_insert($table_name, $args, $prefix); |
372
|
165
|
|
|
|
|
662
|
return unless defined wantarray; |
373
|
165
|
|
|
|
|
1055
|
|
374
|
165
|
|
|
|
|
24078
|
my $table = $self->schema->get_table($table_name); |
375
|
|
|
|
|
|
|
my $pk = $table->primary_keys(); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
my @missing_primary_keys = grep { not defined $args->{$_} } @$pk; |
378
|
7
|
|
|
7
|
1
|
17346
|
if (@missing_primary_keys == 1) { |
379
|
|
|
|
|
|
|
# XXX in MySQL 5.7.8 or later, $self->dbh->{mysql_insertid} will always return 0, |
380
|
7
|
|
|
|
|
20
|
# so that get mysql_insertid from $sth. (https://bugs.mysql.com/bug.php?id=78778) |
381
|
|
|
|
|
|
|
$args->{$missing_primary_keys[0]} = defined $sth->{mysql_insertid} ? $sth->{mysql_insertid} |
382
|
|
|
|
|
|
|
: $self->_last_insert_id($table_name, $missing_primary_keys[0]); |
383
|
|
|
|
|
|
|
} |
384
|
7
|
100
|
|
|
|
80
|
|
385
|
|
|
|
|
|
|
return $args if $self->suppress_row_objects; |
386
|
|
|
|
|
|
|
|
387
|
6
|
|
|
|
|
24
|
my %where; |
388
|
|
|
|
|
|
|
my $refetch = 1; |
389
|
|
|
|
|
|
|
for my $key (@$pk) { |
390
|
|
|
|
|
|
|
if (ref $args->{$key}) { |
391
|
161
|
|
|
161
|
1
|
838180
|
# care references. eg. \'NOW()' |
392
|
|
|
|
|
|
|
$refetch = undef; |
393
|
161
|
|
|
|
|
628
|
last; |
394
|
149
|
100
|
|
|
|
1937
|
} |
395
|
|
|
|
|
|
|
$where{$key} = $args->{$key}; |
396
|
53
|
|
|
|
|
237
|
} |
397
|
53
|
|
|
|
|
224
|
if (%where && $refetch) { |
398
|
|
|
|
|
|
|
# refetch the row for cleanup scalar refs and fill default values |
399
|
53
|
|
|
|
|
255
|
return $self->single($table_name, \%where); |
|
62
|
|
|
|
|
288
|
|
400
|
53
|
100
|
|
|
|
199
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
$table->row_class->new( |
403
|
|
|
|
|
|
|
{ |
404
|
22
|
100
|
|
|
|
331
|
row_data => $args, |
405
|
|
|
|
|
|
|
teng => $self, |
406
|
|
|
|
|
|
|
table_name => $table_name, |
407
|
53
|
100
|
|
|
|
332
|
} |
408
|
|
|
|
|
|
|
); |
409
|
51
|
|
|
|
|
261
|
} |
410
|
51
|
|
|
|
|
91
|
|
411
|
51
|
|
|
|
|
142
|
my ($self, $table_name, $args, $opt) = @_; |
412
|
60
|
50
|
|
|
|
160
|
|
413
|
|
|
|
|
|
|
return unless scalar(@{$args||[]}); |
414
|
0
|
|
|
|
|
0
|
|
415
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
416
|
|
|
|
|
|
|
my $can_multi_insert = $dbh->{Driver}->{Name} eq 'mysql' ? 1 |
417
|
60
|
|
|
|
|
181
|
: $dbh->{Driver}->{Name} eq 'Pg' |
418
|
|
|
|
|
|
|
&& $dbh->{ pg_server_version } >= 82000 ? 1 |
419
|
51
|
50
|
33
|
|
|
288
|
: 0; |
420
|
|
|
|
|
|
|
|
421
|
51
|
|
|
|
|
298
|
if ($can_multi_insert) { |
422
|
|
|
|
|
|
|
my $table = $self->schema->get_table($table_name); |
423
|
|
|
|
|
|
|
if (! $table) { |
424
|
|
|
|
|
|
|
Carp::croak( "Table definition for $table_name does not exist (Did you declare it in our schema?)" ); |
425
|
|
|
|
|
|
|
} |
426
|
0
|
|
|
|
|
0
|
|
427
|
|
|
|
|
|
|
if ( $table->has_deflators ) { |
428
|
|
|
|
|
|
|
for my $row (@$args) { |
429
|
|
|
|
|
|
|
for my $col (keys %{$row}) { |
430
|
|
|
|
|
|
|
$row->{$col} = $table->call_deflate($col, $row->{$col}); |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
2
|
|
|
2
|
1
|
3945
|
|
435
|
|
|
|
|
|
|
my ($sql, @binds) = $self->sql_builder->insert_multi( $table_name, $args, $opt ); |
436
|
2
|
50
|
|
|
|
4
|
$self->execute($sql, \@binds); |
|
2
|
50
|
|
|
|
9
|
|
437
|
|
|
|
|
|
|
} else { |
438
|
2
|
|
|
|
|
7
|
# use transaction for better performance and atomicity. |
439
|
|
|
|
|
|
|
my $txn = $self->txn_scope(); |
440
|
|
|
|
|
|
|
for my $arg (@$args) { |
441
|
2
|
50
|
33
|
|
|
30
|
# do not run trigger for consistency with mysql. |
|
|
50
|
|
|
|
|
|
442
|
|
|
|
|
|
|
$self->insert($table_name, $arg, $opt->{prefix}); |
443
|
|
|
|
|
|
|
} |
444
|
2
|
50
|
|
|
|
7
|
$txn->commit; |
445
|
0
|
|
|
|
|
0
|
} |
446
|
0
|
0
|
|
|
|
0
|
} |
447
|
0
|
|
|
|
|
0
|
|
448
|
|
|
|
|
|
|
my ($self, $table_name, $args, $where) = @_; |
449
|
|
|
|
|
|
|
|
450
|
0
|
0
|
|
|
|
0
|
my ($sql, @binds) = $self->{sql_builder}->update( $table_name, $args, $where ); |
451
|
0
|
|
|
|
|
0
|
my $sth = $self->execute($sql, \@binds); |
452
|
0
|
|
|
|
|
0
|
my $rows = $sth->rows; |
|
0
|
|
|
|
|
0
|
|
453
|
0
|
|
|
|
|
0
|
$sth->finish; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
$rows; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
0
|
my ($self, $table_name, $args, $where) = @_; |
459
|
0
|
|
|
|
|
0
|
|
460
|
|
|
|
|
|
|
my $table = $self->schema->get_table($table_name); |
461
|
|
|
|
|
|
|
if (! $table) { |
462
|
2
|
|
|
|
|
12
|
Carp::croak( "Table definition for $table_name does not exist (Did you declare it in our schema?)" ); |
463
|
2
|
|
|
|
|
143
|
} |
464
|
|
|
|
|
|
|
|
465
|
6
|
|
|
|
|
36
|
for my $col (keys %{$args}) { |
466
|
|
|
|
|
|
|
$args->{$col} = $table->call_deflate($col, $args->{$col}); |
467
|
2
|
|
|
|
|
10
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
$self->do_update($table_name, $self->_bind_sql_type_to_args( $table, $args ), $where); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
28
|
|
|
28
|
1
|
60
|
my ($self, $table_name, $where) = @_; |
473
|
|
|
|
|
|
|
|
474
|
28
|
|
|
|
|
146
|
my ($sql, @binds) = $self->{sql_builder}->delete( $table_name, $where ); |
475
|
28
|
|
|
|
|
5525
|
my $sth = $self->execute($sql, \@binds); |
476
|
28
|
|
|
|
|
163
|
my $rows = $sth->rows; |
477
|
28
|
|
|
|
|
87
|
$sth->finish; |
478
|
|
|
|
|
|
|
|
479
|
28
|
|
|
|
|
327
|
$rows; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------- |
483
|
8
|
|
|
8
|
1
|
5146
|
# for transaction |
484
|
|
|
|
|
|
|
my $self = shift; |
485
|
8
|
|
|
|
|
20
|
$self->_verify_pid; |
486
|
8
|
100
|
|
|
|
19
|
$self->{txn_manager} ||= ($self->{txn_manager_class}) |
487
|
1
|
|
|
|
|
84
|
? $self->{txn_manager_class}->new($self->dbh) |
488
|
|
|
|
|
|
|
: DBIx::TransactionManager->new($self->dbh); |
489
|
|
|
|
|
|
|
} |
490
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
20
|
|
491
|
9
|
|
|
|
|
40
|
my $self = shift; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
return unless $self->{txn_manager}; |
494
|
7
|
|
|
|
|
25
|
|
495
|
|
|
|
|
|
|
if ( my $info = $self->{txn_manager}->in_transaction ) { |
496
|
|
|
|
|
|
|
my $caller = $info->{caller}; |
497
|
|
|
|
|
|
|
my $pid = $info->{pid}; |
498
|
17
|
|
|
17
|
1
|
5635
|
Carp::confess("Detected transaction during a connect operation (last known transaction at $caller->[1] line $caller->[2], pid $pid). Refusing to proceed at"); |
499
|
|
|
|
|
|
|
} |
500
|
17
|
|
|
|
|
77
|
} |
501
|
17
|
|
|
|
|
2317
|
|
502
|
17
|
|
|
|
|
123
|
my $self = shift; |
503
|
17
|
|
|
|
|
65
|
my @caller = caller(); |
504
|
|
|
|
|
|
|
|
505
|
17
|
|
|
|
|
264
|
$self->txn_manager->txn_scope(caller => \@caller); |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my $self = shift; |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
$self->txn_manager->txn_begin; |
511
|
67
|
|
|
67
|
1
|
97
|
} |
512
|
67
|
|
|
|
|
168
|
|
513
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------- |
514
|
65
|
50
|
66
|
|
|
1394
|
|
515
|
|
|
|
|
|
|
my ($self, $sql, $attr, @bind_vars) = @_; |
516
|
|
|
|
|
|
|
my $ret; |
517
|
|
|
|
|
|
|
eval { $ret = $self->dbh->do($sql, $attr, @bind_vars) }; |
518
|
|
|
|
|
|
|
if ($@) { |
519
|
86
|
|
|
86
|
0
|
153
|
$self->handle_error($sql, @bind_vars ? \@bind_vars : '', $@); |
520
|
|
|
|
|
|
|
} |
521
|
86
|
100
|
|
|
|
345
|
$ret; |
522
|
|
|
|
|
|
|
} |
523
|
31
|
100
|
|
|
|
113
|
|
524
|
10
|
|
|
|
|
69
|
my ($self, $table, $opt) = @_; |
525
|
10
|
|
|
|
|
18
|
|
526
|
10
|
|
|
|
|
1335
|
return $opt->{'+columns'} |
527
|
|
|
|
|
|
|
? [@{$table->{escaped_columns}{$self->{driver_name}}}, @{$opt->{'+columns'}}] |
528
|
|
|
|
|
|
|
: ($opt->{columns} || $table->{escaped_columns}{$self->{driver_name}}) |
529
|
|
|
|
|
|
|
; |
530
|
|
|
|
|
|
|
} |
531
|
19
|
|
|
19
|
1
|
10511
|
|
532
|
19
|
|
|
|
|
78
|
my ($self, $table_name, $where, $opt) = @_; |
533
|
|
|
|
|
|
|
|
534
|
19
|
|
|
|
|
69
|
my $table = $self->{schema}->get_table( $table_name ); |
535
|
|
|
|
|
|
|
if (! $table) { |
536
|
|
|
|
|
|
|
Carp::croak("No such table $table_name"); |
537
|
|
|
|
|
|
|
} |
538
|
24
|
|
|
24
|
1
|
15580
|
|
539
|
|
|
|
|
|
|
my ($sql, @binds) = $self->{sql_builder}->select( |
540
|
24
|
|
|
|
|
88
|
$table_name, |
541
|
|
|
|
|
|
|
$self->_get_select_columns($table, $opt), |
542
|
12
|
|
|
12
|
1
|
7059
|
$where, |
543
|
12
|
|
|
12
|
1
|
862
|
$opt |
544
|
0
|
|
|
0
|
1
|
0
|
); |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
$self->search_by_sql($sql, \@binds, $table_name); |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
|
549
|
21
|
|
|
21
|
1
|
10294
|
my ($self, $sql, $args ) = @_; |
550
|
21
|
|
|
|
|
32
|
|
551
|
21
|
|
|
|
|
30
|
my @bind; |
|
21
|
|
|
|
|
64
|
|
552
|
21
|
100
|
|
|
|
70773
|
$sql =~ s{:([A-Za-z_][A-Za-z0-9_]*)}{ |
553
|
1
|
50
|
|
|
|
7
|
Carp::croak("'$1' does not exist in bind hash") if !exists $args->{$1}; |
554
|
|
|
|
|
|
|
if ( ref $args->{$1} && ref $args->{$1} eq "ARRAY" ) { |
555
|
20
|
|
|
|
|
77
|
push @bind, @{ $args->{$1} }; |
556
|
|
|
|
|
|
|
my $tmp = join ',', map { '?' } @{ $args->{$1} }; |
557
|
|
|
|
|
|
|
"( $tmp )"; |
558
|
|
|
|
|
|
|
} else { |
559
|
178
|
|
|
178
|
|
436
|
push @bind, $args->{$1}; |
560
|
|
|
|
|
|
|
'?' |
561
|
|
|
|
|
|
|
} |
562
|
4
|
|
|
|
|
48
|
}ge; |
|
4
|
|
|
|
|
20
|
|
563
|
|
|
|
|
|
|
|
564
|
178
|
100
|
66
|
|
|
1668
|
return ($sql, \@bind); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
my ($self, $sql, $args, $table_name) = @_; |
568
|
35
|
|
|
35
|
1
|
51285
|
|
569
|
|
|
|
|
|
|
$self->search_by_sql($self->_bind_named($sql, $args), $table_name); |
570
|
35
|
|
|
|
|
135
|
} |
571
|
35
|
100
|
|
|
|
90
|
|
572
|
1
|
|
|
|
|
116
|
my ($self, $table_name, $where, $opt) = @_; |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
$opt->{limit} = 1; |
575
|
|
|
|
|
|
|
|
576
|
34
|
|
|
|
|
102
|
my $table = $self->{schema}->get_table( $table_name ); |
577
|
|
|
|
|
|
|
Carp::croak("No such table $table_name") unless $table; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
my ($sql, @binds) = $self->{sql_builder}->select( |
580
|
|
|
|
|
|
|
$table_name, |
581
|
|
|
|
|
|
|
$self->_get_select_columns($table, $opt), |
582
|
34
|
|
|
|
|
11874
|
$where, |
583
|
|
|
|
|
|
|
$opt |
584
|
|
|
|
|
|
|
); |
585
|
|
|
|
|
|
|
my $sth = $self->execute($sql, \@binds); |
586
|
5
|
|
|
5
|
|
13
|
|
587
|
|
|
|
|
|
|
# When the return value is never used, should not create row object |
588
|
5
|
|
|
|
|
8
|
# case example: use `FOR UPDATE` query for global locking |
589
|
5
|
|
|
|
|
39
|
unless (defined wantarray) { |
590
|
7
|
100
|
|
|
|
162
|
$sth->finish(); |
591
|
6
|
100
|
66
|
|
|
23
|
return; |
592
|
1
|
|
|
|
|
3
|
} |
|
1
|
|
|
|
|
3
|
|
593
|
1
|
|
|
|
|
2
|
|
|
3
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
3
|
|
594
|
1
|
|
|
|
|
5
|
my $row = $sth->fetchrow_hashref($self->{fields_case}); |
595
|
|
|
|
|
|
|
|
596
|
5
|
|
|
|
|
13
|
return undef unless $row; ## no critic |
597
|
5
|
|
|
|
|
15
|
return $row if $self->{suppress_row_objects}; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
$table->{row_class}->new( |
600
|
|
|
|
|
|
|
{ |
601
|
4
|
|
|
|
|
25
|
sql => $sql, |
602
|
|
|
|
|
|
|
row_data => $row, |
603
|
|
|
|
|
|
|
teng => $self, |
604
|
|
|
|
|
|
|
table => $table, |
605
|
4
|
|
|
4
|
1
|
10469
|
table_name => $table_name, |
606
|
|
|
|
|
|
|
} |
607
|
4
|
|
|
|
|
52
|
); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
my ($self, $sql, $bind, $table_name) = @_; |
611
|
138
|
|
|
138
|
1
|
2242191
|
|
612
|
|
|
|
|
|
|
$table_name ||= $self->_guess_table_name( $sql ); |
613
|
138
|
|
|
|
|
406
|
my $sth = $self->execute($sql, $bind); |
614
|
|
|
|
|
|
|
|
615
|
138
|
|
|
|
|
612
|
# When the return value is never used, should not create iterator object |
616
|
138
|
50
|
|
|
|
384
|
# case example: use `FOR UPDATE` query for global locking |
617
|
|
|
|
|
|
|
unless (defined wantarray) { |
618
|
|
|
|
|
|
|
$sth->finish(); |
619
|
138
|
|
|
|
|
631
|
return; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
my $itr = Teng::Iterator->new( |
623
|
|
|
|
|
|
|
teng => $self, |
624
|
138
|
|
|
|
|
64180
|
sth => $sth, |
625
|
|
|
|
|
|
|
sql => $sql, |
626
|
|
|
|
|
|
|
row_class => $self->{schema}->get_row_class($table_name), |
627
|
|
|
|
|
|
|
table => $self->{schema}->get_table( $table_name ), |
628
|
138
|
50
|
|
|
|
373
|
table_name => $table_name, |
629
|
0
|
|
|
|
|
0
|
apply_sql_types => $self->{apply_sql_types} || $self->{guess_sql_types}, |
630
|
0
|
|
|
|
|
0
|
guess_sql_types => $self->{guess_sql_types}, |
631
|
|
|
|
|
|
|
suppress_object_creation => $self->{suppress_row_objects}, |
632
|
|
|
|
|
|
|
); |
633
|
138
|
|
|
|
|
4954
|
return wantarray ? $itr->all : $itr; |
634
|
|
|
|
|
|
|
} |
635
|
138
|
100
|
|
|
|
837
|
|
636
|
122
|
50
|
|
|
|
416
|
my ($self, $sql, $bind, $table_name) = @_; |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
$table_name ||= $self->_guess_table_name( $sql ); |
639
|
|
|
|
|
|
|
my $table = $self->{schema}->get_table( $table_name ); |
640
|
122
|
|
|
|
|
1353
|
Carp::croak("No such table $table_name") unless $table; |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
my $sth = $self->execute($sql, $bind); |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# When the return value is never used, should not create row object |
645
|
|
|
|
|
|
|
# case example: use `FOR UPDATE` query for global locking |
646
|
|
|
|
|
|
|
unless (defined wantarray) { |
647
|
|
|
|
|
|
|
$sth->finish(); |
648
|
|
|
|
|
|
|
return; |
649
|
|
|
|
|
|
|
} |
650
|
56
|
|
|
56
|
1
|
29368
|
|
651
|
|
|
|
|
|
|
my $row = $sth->fetchrow_hashref($self->{fields_case}); |
652
|
56
|
|
100
|
|
|
278
|
|
653
|
56
|
|
|
|
|
154
|
return unless $row; |
654
|
|
|
|
|
|
|
return $row if $self->{suppress_row_objects}; |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
$table->{row_class}->new( |
657
|
55
|
50
|
|
|
|
133
|
{ |
658
|
0
|
|
|
|
|
0
|
sql => $sql, |
659
|
0
|
|
|
|
|
0
|
row_data => $row, |
660
|
|
|
|
|
|
|
teng => $self, |
661
|
|
|
|
|
|
|
table => $table, |
662
|
|
|
|
|
|
|
table_name => $table_name, |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
); |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
my ($self, $table_name, $data, $sql) = @_; |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
my $table = $self->{schema}->get_table( $table_name ); |
670
|
|
|
|
|
|
|
Carp::croak("No such table $table_name") unless $table; |
671
|
|
|
|
|
|
|
|
672
|
55
|
|
66
|
|
|
343
|
return $data if $self->{suppress_row_objects}; |
673
|
55
|
100
|
|
|
|
298
|
|
674
|
|
|
|
|
|
|
$table->{row_class}->new( |
675
|
|
|
|
|
|
|
{ |
676
|
|
|
|
|
|
|
sql => $sql || do { |
677
|
2
|
|
|
2
|
1
|
1686
|
my @caller = caller(0); |
678
|
|
|
|
|
|
|
my $level = 0; |
679
|
2
|
|
33
|
|
|
14
|
while ($caller[0] eq __PACKAGE__ || $caller[0] eq ref $self) { |
680
|
2
|
|
|
|
|
8
|
@caller = caller(++$level); |
681
|
2
|
50
|
|
|
|
5
|
} |
682
|
|
|
|
|
|
|
sprintf '/* DUMMY QUERY %s->new_row_from_hash created from %s line %d */', ref $self, $caller[1], $caller[2]; |
683
|
2
|
|
|
|
|
6
|
}, |
684
|
|
|
|
|
|
|
row_data => $data, |
685
|
|
|
|
|
|
|
teng => $self, |
686
|
|
|
|
|
|
|
table => $table, |
687
|
2
|
50
|
|
|
|
6
|
table_name => $table_name, |
688
|
0
|
|
|
|
|
0
|
} |
689
|
0
|
|
|
|
|
0
|
); |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
2
|
|
|
|
|
141
|
my ($self, $sql, $args, $table_name) = @_; |
693
|
|
|
|
|
|
|
|
694
|
2
|
50
|
|
|
|
11
|
$self->single_by_sql($self->_bind_named($sql, $args), $table_name); |
695
|
2
|
50
|
|
|
|
7
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
my ($class, $sql) = @_; |
698
|
|
|
|
|
|
|
|
699
|
2
|
|
|
|
|
46
|
if ($sql =~ /\sfrom\s+["`]?([\w]+)["`]?\s*/si) { |
700
|
|
|
|
|
|
|
return $1; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
return; |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
my ($self, $stmt, $bind, $reason) = @_; |
706
|
|
|
|
|
|
|
require Data::Dumper; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
local $Data::Dumper::Maxdepth = 2; |
709
|
4
|
|
|
4
|
1
|
2608
|
$stmt =~ s/\n/\n /gm; |
710
|
|
|
|
|
|
|
Carp::croak sprintf <<"TRACE", $reason, $stmt, Data::Dumper::Dumper($bind); |
711
|
4
|
|
|
|
|
15
|
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
712
|
4
|
50
|
|
|
|
8
|
@@@@@ Teng 's Exception @@@@@ |
713
|
|
|
|
|
|
|
Reason : %s |
714
|
4
|
50
|
|
|
|
9
|
SQL : %s |
715
|
|
|
|
|
|
|
BIND : %s |
716
|
|
|
|
|
|
|
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ |
717
|
|
|
|
|
|
|
TRACE |
718
|
4
|
|
66
|
|
|
11
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
my $self = shift; |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
if ( $self->owner_pid and $self->owner_pid != $$ and my $dbh = $self->{dbh} ) { |
723
|
|
|
|
|
|
|
$dbh->{InactiveDestroy} = 1; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
1; |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=head1 NAME |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Teng - very simple DBI wrapper/ORMapper |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=head1 SYNOPSIS |
734
|
|
|
|
|
|
|
|
735
|
1
|
|
|
1
|
1
|
1302
|
my $db = MyDB->new({ connect_info => [ 'dbi:SQLite:' ] }); |
736
|
|
|
|
|
|
|
my $row = $db->insert( 'table' => { |
737
|
1
|
|
|
|
|
5
|
col1 => $value |
738
|
|
|
|
|
|
|
} ); |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=head1 DESCRIPTION |
741
|
27
|
|
|
27
|
|
1288
|
|
742
|
|
|
|
|
|
|
Teng is very simple DBI wrapper and simple O/R Mapper. |
743
|
27
|
100
|
|
|
|
178
|
It aims to be lightweight, with minimal dependencies so it's easier to install. |
744
|
26
|
|
|
|
|
118
|
|
745
|
|
|
|
|
|
|
=head1 BASIC USAGE |
746
|
1
|
|
|
|
|
3
|
|
747
|
|
|
|
|
|
|
create your db model base class. |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
package Your::Model; |
750
|
13
|
|
|
13
|
1
|
52
|
use parent 'Teng'; |
751
|
13
|
|
|
|
|
4215
|
1; |
752
|
|
|
|
|
|
|
|
753
|
13
|
|
|
|
|
40653
|
create your db schema class. |
754
|
13
|
|
|
|
|
68
|
See Teng::Schema for docs on defining schema class. |
755
|
13
|
|
|
|
|
51
|
|
756
|
|
|
|
|
|
|
package Your::Model::Schema; |
757
|
|
|
|
|
|
|
use Teng::Schema::Declare; |
758
|
|
|
|
|
|
|
table { |
759
|
|
|
|
|
|
|
name 'user'; |
760
|
|
|
|
|
|
|
pk 'id'; |
761
|
|
|
|
|
|
|
columns qw( foo bar baz ); |
762
|
|
|
|
|
|
|
}; |
763
|
|
|
|
|
|
|
1; |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
in your script. |
766
|
87
|
|
|
87
|
|
138502
|
|
767
|
|
|
|
|
|
|
use Your::Model; |
768
|
87
|
100
|
100
|
|
|
382
|
|
|
|
|
66
|
|
|
|
|
769
|
1
|
|
|
|
|
59
|
my $teng = Your::Model->new(\%args); |
770
|
|
|
|
|
|
|
# insert new record. |
771
|
|
|
|
|
|
|
my $row = $teng->insert('user', |
772
|
|
|
|
|
|
|
{ |
773
|
|
|
|
|
|
|
id => 1, |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
); |
776
|
|
|
|
|
|
|
$row->update({name => 'nekokak'}); # same do { $row->name('nekokak'); $row->update; } |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
$row = $teng->single_by_sql(q{SELECT id, name FROM user WHERE id = ?}, [ 1 ]); |
779
|
|
|
|
|
|
|
$row->delete(); |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=head1 ARCHITECTURE |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
Teng classes are comprised of three distinct components: |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head2 MODEL |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
The C<model> is where you say |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
package MyApp::Model; |
790
|
|
|
|
|
|
|
use parent 'Teng'; |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
This is the entry point to using Teng. You connect, insert, update, delete, select stuff using this object. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head2 SCHEMA |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
The C<schema> is a simple class that describes your table definitions. Note that this is different from DBIx::Class terms. |
797
|
|
|
|
|
|
|
DBIC's schema is equivalent to Teng's model + schema, where the actual schema information is scattered across the result classes. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
In Teng, you simply use Teng::Schema's domain specific language to define a set of tables |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
package MyApp::Model::Schema; |
802
|
|
|
|
|
|
|
use Teng::Schema::Declare; |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
table { |
805
|
|
|
|
|
|
|
name $table_name; |
806
|
|
|
|
|
|
|
pk $primary_key_column; |
807
|
|
|
|
|
|
|
columns qw( |
808
|
|
|
|
|
|
|
column1 |
809
|
|
|
|
|
|
|
column2 |
810
|
|
|
|
|
|
|
column3 |
811
|
|
|
|
|
|
|
); |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
... and other tables ... |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head2 ROW |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
Unlike DBIx::Class, you don't need to have a set of classes that represent a row type (i.e. "result" classes in DBIC terms). |
819
|
|
|
|
|
|
|
In Teng, the row objects are blessed into anonymous classes that inherit from Teng::Row, |
820
|
|
|
|
|
|
|
so you don't have to create these classes if you just want to use some simple queries. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
If you want to define methods to be performed by your row objects, simply create a row class like so: |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
package MyApp::Model::Row::Camelizedtable_name; |
825
|
|
|
|
|
|
|
use parent qw(Teng::Row); |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
Note that your table name will be camelized. |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=head1 METHODS |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Teng provides a number of methods to all your classes, |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=over |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item $teng = Teng->new(\%args) |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
Creates a new Teng instance. |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# connect new database connection. |
840
|
|
|
|
|
|
|
my $db = Your::Model->new( |
841
|
|
|
|
|
|
|
connect_info => [ $dsn, $username, $password, \%connect_options ] |
842
|
|
|
|
|
|
|
); |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
Arguments can be: |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
=over |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=item * C<connect_info> |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
Specifies the information required to connect to the database. |
851
|
|
|
|
|
|
|
The argument should be a reference to a array in the form: |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
[ $dsn, $user, $password, \%options ] |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
You must pass C<connect_info> or C<dbh> to the constructor. |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=item * C<dbh> |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Specifies the database handle to use. |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * C<no_ping> |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
By default, ping before each executing query. |
864
|
|
|
|
|
|
|
If it affect performance then you can set to true for ping stopping. |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=item * C<fields_case> |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
specific DBI.pm's FetchHashKeyName. |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=item * C<schema> |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
Specifies the Teng::Schema instance to use. |
873
|
|
|
|
|
|
|
If not specified, the value specified in C<schema_class> is loaded and |
874
|
|
|
|
|
|
|
instantiated for you. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
=item * C<schema_class> |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
Specifies the schema class to use. |
879
|
|
|
|
|
|
|
By default {YOUR_MODEL_CLASS}::Schema is used. |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item * C<txn_manager_class> |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
Specifies the transaction manager class. |
884
|
|
|
|
|
|
|
By default DBIx::TransactionManager is used. |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=item * C<suppress_row_objects> |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
Specifies the row object creation mode. By default this value is C<false>. |
889
|
|
|
|
|
|
|
If you specifies this to a C<true> value, no row object will be created when |
890
|
|
|
|
|
|
|
a C<SELECT> statement is issued.. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=item * C<force_deflate_set_column> |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
Specifies C<set_column>, C<set_columns> and column name method behaviour. By default this value is C<false>. |
895
|
|
|
|
|
|
|
If you specifies this to a C<true> value, C<set_column> or column name method will deflate argument. |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=item * C<sql_builder> |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Speficies the SQL builder object. By default SQL::Maker is used, and as such, |
900
|
|
|
|
|
|
|
if you provide your own SQL builder the interface needs to be compatible |
901
|
|
|
|
|
|
|
with SQL::Maker. |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=item * C<sql_builder_class> : Str |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
Speficies the SQL builder class name. By default SQL::Maker is used, and as such, |
906
|
|
|
|
|
|
|
if you provide your own SQL builder the interface needs to be compatible |
907
|
|
|
|
|
|
|
with SQL::Maker. |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
Specified C<sql_builder_class> is instantiated with following: |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
$sql_builder_class->new( |
912
|
|
|
|
|
|
|
driver => $teng->{driver_name}, |
913
|
|
|
|
|
|
|
%{ $teng->{sql_builder_args} } |
914
|
|
|
|
|
|
|
) |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
This is not used when C<sql_builder> is specified. |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=item * C<sql_builder_args> : HashRef |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
Speficies the arguments for constructor of C<sql_builder_class>. This is not used when C<sql_builder> is specified. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=item * C<trace_ignore_if> : CodeRef |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
Ignore to inject the SQL comment when trace_ignore_if's return value is true. |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
=back |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=item C<$row = $teng-E<gt>insert($table_name, \%row_data)> |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
Inserts a new record. Returns the inserted row object. |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
my $row = $teng->insert('user',{ |
933
|
|
|
|
|
|
|
id => 1, |
934
|
|
|
|
|
|
|
name => 'nekokak', |
935
|
|
|
|
|
|
|
}); |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
If a primary key is available, it will be fetched after the insert -- so |
938
|
|
|
|
|
|
|
an INSERT followed by SELECT is performed. If you do not want this, use |
939
|
|
|
|
|
|
|
C<fast_insert>. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item C<$last_insert_id = $teng-E<gt>fast_insert($table_name, \%row_data);> |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
insert new record and get last_insert_id. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
no creation row object. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=item C<< $teng->do_insert >> |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
Internal method called from C<insert> and C<fast_insert>. You can hook it on your responsibility. |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item C<$teng-E<gt>bulk_insert($table_name, \@rows_data, \%opt)> |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
Accepts either an arrayref of hashrefs. |
954
|
|
|
|
|
|
|
each hashref should be a structure suitable |
955
|
|
|
|
|
|
|
for submitting to a Your::Model->insert(...) method. |
956
|
|
|
|
|
|
|
The second argument is an arrayref of hashrefs. All of the keys in these hashrefs must be exactly the same. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
insert many record by bulk. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
example: |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
Your::Model->bulk_insert('user',[ |
963
|
|
|
|
|
|
|
{ |
964
|
|
|
|
|
|
|
id => 1, |
965
|
|
|
|
|
|
|
name => 'nekokak', |
966
|
|
|
|
|
|
|
}, |
967
|
|
|
|
|
|
|
{ |
968
|
|
|
|
|
|
|
id => 2, |
969
|
|
|
|
|
|
|
name => 'yappo', |
970
|
|
|
|
|
|
|
}, |
971
|
|
|
|
|
|
|
{ |
972
|
|
|
|
|
|
|
id => 3, |
973
|
|
|
|
|
|
|
name => 'walf443', |
974
|
|
|
|
|
|
|
}, |
975
|
|
|
|
|
|
|
]); |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
You can specify C<$opt> like C<< { prefix => 'INSERT IGNORE INTO' } >> or C<< { update => { name => 'updated' } } >> optionally, which will be passed to query builder. |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
=item C<$update_row_count = $teng-E<gt>update($table_name, \%update_row_data, [\%update_condition])> |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
Calls UPDATE on C<$table_name>, with values specified in C<%update_ro_data>, and returns the number of rows updated. You may optionally specify C<%update_condition> to create a conditional update query. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
my $update_row_count = $teng->update('user', |
984
|
|
|
|
|
|
|
{ |
985
|
|
|
|
|
|
|
name => 'nomaneko', |
986
|
|
|
|
|
|
|
}, |
987
|
|
|
|
|
|
|
{ |
988
|
|
|
|
|
|
|
id => 1 |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
); |
991
|
|
|
|
|
|
|
# Executes UPDATE user SET name = 'nomaneko' WHERE id = 1 |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
You can also call update on a row object: |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
my $row = $teng->single('user',{id => 1}); |
996
|
|
|
|
|
|
|
$row->update({name => 'nomaneko'}); |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
You can use the set_column method: |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
my $row = $teng->single('user', {id => 1}); |
1001
|
|
|
|
|
|
|
$row->set_column( name => 'yappo' ); |
1002
|
|
|
|
|
|
|
$row->update; |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
you can column update by using column method: |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
my $row = $teng->single('user', {id => 1}); |
1007
|
|
|
|
|
|
|
$row->name('yappo'); |
1008
|
|
|
|
|
|
|
$row->update; |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=item C<$updated_row_count = $teng-E<gt>do_update($table_name, \%set, \%where)> |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
This is low level API for UPDATE. Normally, you should use update method instead of this. |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
This method does not deflate \%args. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=item C<$delete_row_count = $teng-E<gt>delete($table, \%delete_condition)> |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
Deletes the specified record(s) from C<$table> and returns the number of rows deleted. You may optionally specify C<%delete_condition> to create a conditional delete query. |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
my $rows_deleted = $teng->delete( 'user', { |
1021
|
|
|
|
|
|
|
id => 1 |
1022
|
|
|
|
|
|
|
} ); |
1023
|
|
|
|
|
|
|
# Executes DELETE FROM user WHERE id = 1 |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
You can also call delete on a row object: |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
my $row = $teng->single('user', {id => 1}); |
1028
|
|
|
|
|
|
|
$row->delete |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=item C<$itr = $teng-E<gt>search($table_name, [\%search_condition, [\%search_attr]])> |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
simple search method. |
1033
|
|
|
|
|
|
|
search method get Teng::Iterator's instance object. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
see L<Teng::Iterator> |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
get iterator: |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
my $itr = $teng->search('user',{id => 1},{order_by => 'id'}); |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
get rows: |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
my @rows = $teng->search('user',{id => 1},{order_by => 'id'}); |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item C<$row = $teng-E<gt>single($table_name, \%search_condition)> |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
get one record. |
1048
|
|
|
|
|
|
|
give back one case of the beginning when it is acquired plural records by single method. |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
my $row = $teng->single('user',{id =>1}); |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=item C<$row = $teng-E<gt>new_row_from_hash($table_name, \%row_data, [$sql])> |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
create row object from data. (not fetch from db.) |
1055
|
|
|
|
|
|
|
It's useful in such as testing. |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
my $row = $teng->new_row_from_hash('user', { id => 1, foo => "bar" }); |
1058
|
|
|
|
|
|
|
say $row->foo; # say bar |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=item C<$itr = $teng-E<gt>search_named($sql, [\%bind_values, [$table_name]])> |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
execute named query |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
my $itr = $teng->search_named(q{SELECT * FROM user WHERE id = :id}, {id => 1}); |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
If you give ArrayRef to value, that is expanded to "(?,?,?,?)" in SQL. |
1067
|
|
|
|
|
|
|
It's useful in case use IN statement. |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
# SELECT * FROM user WHERE id IN (?,?,?); |
1070
|
|
|
|
|
|
|
# bind [1,2,3] |
1071
|
|
|
|
|
|
|
my $itr = $teng->search_named(q{SELECT * FROM user WHERE id IN :ids}, {ids => [1, 2, 3]}); |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
If you give table_name. It is assumed the hint that makes Teng::Row's Object. |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=item C<$itr = $teng-E<gt>search_by_sql($sql, [\@bind_values, [$table_name]])> |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
execute your SQL |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
my $itr = $teng->search_by_sql(q{ |
1080
|
|
|
|
|
|
|
SELECT |
1081
|
|
|
|
|
|
|
id, name |
1082
|
|
|
|
|
|
|
FROM |
1083
|
|
|
|
|
|
|
user |
1084
|
|
|
|
|
|
|
WHERE |
1085
|
|
|
|
|
|
|
id = ? |
1086
|
|
|
|
|
|
|
},[ 1 ]); |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
If $table is specified, it set table information to result iterator. |
1089
|
|
|
|
|
|
|
So, you can use table row class to search_by_sql result. |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=item C<$row = $teng-E<gt>single_by_sql($sql, [\@bind_values, [$table_name]])> |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
get one record from your SQL. |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
my $row = $teng->single_by_sql(q{SELECT id,name FROM user WHERE id = ? LIMIT 1}, [1], 'user'); |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
This is a shortcut for |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
my $row = $teng->search_by_sql(q{SELECT id,name FROM user WHERE id = ? LIMIT 1}, [1], 'user')->next; |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
But optimized implementation. |
1102
|
|
|
|
|
|
|
|
1103
|
|
|
|
|
|
|
=item C<$row = $teng-E<gt>single_named($sql, [\%bind_values, [$table_name]])> |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
get one record from execute named query |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
my $row = $teng->single_named(q{SELECT id,name FROM user WHERE id = :id LIMIT 1}, {id => 1}, 'user'); |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
This is a shortcut for |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
my $row = $teng->search_named(q{SELECT id,name FROM user WHERE id = :id LIMIT 1}, {id => 1}, 'user')->next; |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
But optimized implementation. |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=item C<$sth = $teng-E<gt>execute($sql, [\@bind_values])> |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
execute query and get statement handler. |
1118
|
|
|
|
|
|
|
and will be inserted caller's file and line as a comment in the SQL if $ENV{TENG_SQL_COMMENT} or sql_comment is true value. |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=item C<$teng-E<gt>txn_scope> |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
Creates a new transaction scope guard object. |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
do { |
1125
|
|
|
|
|
|
|
my $txn = $teng->txn_scope; |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
$row->update({foo => 'bar'}); |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
$txn->commit; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
If an exception occurs, or the guard object otherwise leaves the scope |
1133
|
|
|
|
|
|
|
before C<< $txn->commit >> is called, the transaction will be rolled |
1134
|
|
|
|
|
|
|
back by an explicit L</txn_rollback> call. In essence this is akin to |
1135
|
|
|
|
|
|
|
using a L</txn_begin>/L</txn_commit> pair, without having to worry |
1136
|
|
|
|
|
|
|
about calling L</txn_rollback> at the right places. Note that since there |
1137
|
|
|
|
|
|
|
is no defined code closure, there will be no retries and other magic upon |
1138
|
|
|
|
|
|
|
database disconnection. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=item C<$txn_manager = $teng-E<gt>txn_manager> |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
Create the transaction manager instance with specified C<txn_manager_class>. |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item C<$teng-E<gt>txn_begin> |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
start new transaction. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=item C<$teng-E<gt>txn_commit> |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
commit transaction. |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=item C<$teng-E<gt>txn_rollback> |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
rollback transaction. |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item C<$teng-E<gt>txn_end> |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
finish transaction. |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=item C<$teng-E<gt>do($sql, [\%option, @bind_values])> |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
Execute the query specified by C<$sql>, using C<%option> and C<@bind_values> as necessary. This pretty much a wrapper around L<http://search.cpan.org/dist/DBI/DBI.pm#do> |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
=item C<$teng-E<gt>dbh> |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
get database handle. |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=item C<$teng-E<gt>connect(\@connect_info)> |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
connect database handle. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
connect_info is [$dsn, $user, $password, $options]. |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
If you give \@connect_info, create new database connection. |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item C<$teng-E<gt>disconnect()> |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
Disconnects from the currently connected database. |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=item C<$teng-E<gt>suppress_row_objects($flag)> |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
set row object creation mode. |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
=item C<$teng-E<gt>apply_sql_types($flag)> |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
set SQL type application mode. |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
see apply_sql_types in L<Teng::Iterator/METHODS> |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
=item C<$teng-E<gt>guess_sql_types($flag)> |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
set SQL type guessing mode. |
1193
|
|
|
|
|
|
|
this implies apply_sql_types true. |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
see guess_sql_types in L<Teng::Iterator/METHODS> |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
=item C<$teng-E<gt>set_boolean_value($true, $false)> |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
set scalar to correspond boolean. |
1200
|
|
|
|
|
|
|
this is ignored when apply_sql_types is not true. |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
$teng->set_boolean_value(JSON::XS::true, JSON::XS::false); |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=item C<$teng-E<gt>load_plugin();> |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
$teng->load_plugin($plugin_class, $options); |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
This imports plugin class's methods to C<$teng> class |
1209
|
|
|
|
|
|
|
and it calls $plugin_class's init method if it has. |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
$plugin_class->init($teng, $options); |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
If you want to change imported method name, use C<alias> option. |
1214
|
|
|
|
|
|
|
for example: |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
YourDB->load_plugin('BulkInsert', { alias => { bulk_insert => 'isnert_bulk' } }); |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
BulkInsert's "bulk_insert" method is imported as "insert_bulk". |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=item C<$teng-E<gt>handle_error> |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
handling error method. |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
=item C<< $teng->connected >> |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
check connected or not. |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=item C<< $teng->reconnect >> |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
reconnect database |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
=item C<< $teng->mode >> |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
DEPRECATED AND *WILL* BE REMOVED. PLEASE USE C< no_ping > option. |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=item How do you use display the profiling result? |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
use L<Devel::KYTProf>. |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
=back |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
=head1 TRIGGERS |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
Teng does not support triggers (NOTE: do not confuse it with SQL triggers - we're talking about Perl level triggers). If you really want to hook into the various methods, use something like L<Moose>, L<Mouse>, and L<Class::Method::Modifiers>. |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
=head1 SEE ALSO |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
=head2 Fork |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
This module was forked from L<DBIx::Skinny>, around version 0.0732. |
1251
|
|
|
|
|
|
|
many incompatible changes have been made. |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
No bugs have been reported. |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=head1 AUTHORS |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
Atsushi Kobayashi C<< <nekokak __at__ gmail.com> >> |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
Tokuhiro Matsuno E<lt>tokuhirom@gmail.comE<gt> |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
Daisuke Maki C<< <daisuke@endeworks.jp> >> |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=head1 SUPPORT |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
irc: #dbix-skinny@irc.perl.org |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
ML: http://groups.google.com/group/dbix-skinny |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
=head1 REPOSITORY |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
git clone git://github.com/nekokak/p5-teng.git |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
Copyright (c) 2010, the Teng L</AUTHOR>. All rights reserved. |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
1280
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. See L<perlartistic>. |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
=cut |
1283
|
|
|
|
|
|
|
|