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