line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Oro::Driver::SQLite; |
2
|
23
|
|
|
23
|
|
169
|
use warnings; |
|
23
|
|
|
|
|
42
|
|
|
23
|
|
|
|
|
939
|
|
3
|
23
|
|
|
23
|
|
136
|
use strict; |
|
23
|
|
|
|
|
41
|
|
|
23
|
|
|
|
|
566
|
|
4
|
23
|
|
|
23
|
|
122
|
use DBIx::Oro; |
|
23
|
|
|
|
|
44
|
|
|
23
|
|
|
|
|
205
|
|
5
|
|
|
|
|
|
|
our @ISA; |
6
|
23
|
|
|
23
|
|
949
|
BEGIN { @ISA = 'DBIx::Oro' }; |
7
|
|
|
|
|
|
|
|
8
|
23
|
|
|
23
|
|
323
|
use v5.10.1; |
|
23
|
|
|
|
|
77
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# Todo: use 'truncate' for table deletion |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Defaults to 500 for SQLITE_MAX_COMPOUND_SELECT |
13
|
|
|
|
|
|
|
our $MAX_COMP_SELECT; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
BEGIN { |
16
|
23
|
|
|
23
|
|
708
|
$MAX_COMP_SELECT = 500; |
17
|
|
|
|
|
|
|
}; |
18
|
|
|
|
|
|
|
|
19
|
23
|
|
|
23
|
|
145
|
use Carp qw/carp/; |
|
23
|
|
|
|
|
54
|
|
|
23
|
|
|
|
|
1467
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Find and create database file |
22
|
23
|
|
|
23
|
|
145
|
use File::Path; |
|
23
|
|
|
|
|
42
|
|
|
23
|
|
|
|
|
1550
|
|
23
|
23
|
|
|
23
|
|
193
|
use File::Basename; |
|
23
|
|
|
|
|
51
|
|
|
23
|
|
|
|
|
81554
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Default arguments for snippet function |
26
|
|
|
|
|
|
|
my @arguments = |
27
|
|
|
|
|
|
|
qw/start end ellipsis column token/; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $arguments = qr/^(?:start|end|ellipsis|column|token)$/; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my @default = ('', '', '...', -1, -15); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Constructor |
35
|
|
|
|
|
|
|
sub new { |
36
|
27
|
|
|
27
|
1
|
63
|
my $class = shift; |
37
|
27
|
|
|
|
|
112
|
my %param = @_; |
38
|
27
|
|
50
|
|
|
197
|
$param{created} //= 0; |
39
|
|
|
|
|
|
|
|
40
|
27
|
|
|
|
|
44
|
my $autocommit = delete $param{autocommit}; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Bless object with hash |
43
|
27
|
|
|
|
|
61
|
my $self = bless \%param, $class; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Store filename |
46
|
27
|
|
50
|
|
|
197
|
my $file = $self->{file} = $param{file} // ''; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Temporary or memory file |
49
|
27
|
100
|
100
|
|
|
262
|
if (!$file || $file eq ':memory:') { |
|
|
100
|
|
|
|
|
|
50
|
24
|
|
|
|
|
49
|
$self->{created} = 1; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Create path for file - based on ORLite |
54
|
|
|
|
|
|
|
elsif (!-e $file) { |
55
|
|
|
|
|
|
|
|
56
|
2
|
|
|
|
|
519
|
my $dir = File::Basename::dirname($file); |
57
|
2
|
50
|
|
|
|
43
|
unless (-d $dir) { |
58
|
0
|
|
|
|
|
0
|
File::Path::mkpath( $dir, { verbose => 0 } ); |
59
|
|
|
|
|
|
|
}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Touch the file |
62
|
2
|
50
|
|
|
|
202
|
if (open(TOUCH,'>' . $file)) { |
63
|
2
|
|
|
|
|
11
|
$self->{created} = 1; |
64
|
2
|
|
|
|
|
22
|
close(TOUCH); |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
}; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# Data source name |
69
|
27
|
|
|
|
|
93
|
$self->{dsn} = 'dbi:SQLite:dbname=' . $self->{file}; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Attach hash |
72
|
27
|
50
|
|
|
|
104
|
$self->{attached} = {} unless exists $self->{attached}; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Autocommit |
75
|
27
|
|
|
|
|
61
|
${$self->{autocommit}} = |
76
|
27
|
|
|
|
|
57
|
${$self->{_autocounter}} = 0; |
|
27
|
|
|
|
|
88
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Set autocommit |
79
|
27
|
50
|
|
|
|
85
|
$self->autocommit($autocommit) if $autocommit; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# Return object |
82
|
27
|
|
|
|
|
82
|
$self; |
83
|
|
|
|
|
|
|
}; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Initialize database if newly created |
87
|
|
|
|
|
|
|
sub _init { |
88
|
27
|
|
|
27
|
|
70
|
my $self = shift; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Get callback |
91
|
|
|
|
|
|
|
my $cb = delete $self->{init} if $self->{init} && |
92
|
27
|
100
|
50
|
|
|
246
|
(ref $self->{init} || '') eq 'CODE'; |
|
|
|
66
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Import SQL file |
95
|
27
|
|
|
|
|
93
|
my $import = delete $self->{import}; |
96
|
27
|
|
|
|
|
52
|
my $import_cb = delete $self->{import_cb}; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Initialize database if newly created |
99
|
27
|
100
|
66
|
|
|
109
|
if ($self->created && ($import || $cb)) { |
|
|
|
100
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# Start creation transaction |
102
|
6
|
50
|
|
|
|
77
|
unless ( |
103
|
|
|
|
|
|
|
$self->txn( |
104
|
|
|
|
|
|
|
sub { |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# Import SQL file |
107
|
6
|
50
|
|
6
|
|
18
|
if ($import) { |
108
|
0
|
0
|
|
|
|
0
|
$self->import_sql($import, $import_cb) or return -1; |
109
|
|
|
|
|
|
|
}; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Release callback |
112
|
6
|
50
|
|
|
|
24
|
if ($cb) { |
113
|
6
|
|
|
|
|
30
|
local $_ = $self; |
114
|
6
|
|
|
|
|
22
|
return $cb->($self); |
115
|
|
|
|
|
|
|
}; |
116
|
0
|
|
|
|
|
0
|
return 1; |
117
|
|
|
|
|
|
|
}) |
118
|
|
|
|
|
|
|
) { |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# Unlink SQLite database |
121
|
0
|
0
|
|
|
|
0
|
if (index($self->file, ':') != 0) { |
122
|
0
|
|
|
|
|
0
|
unlink $self->file; |
123
|
|
|
|
|
|
|
}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# Not successful |
126
|
0
|
|
|
|
|
0
|
$self = undef; |
127
|
0
|
|
|
|
|
0
|
return; |
128
|
|
|
|
|
|
|
}; |
129
|
|
|
|
|
|
|
}; |
130
|
|
|
|
|
|
|
|
131
|
27
|
|
|
|
|
323
|
return 1; |
132
|
|
|
|
|
|
|
}; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Connect to database |
136
|
|
|
|
|
|
|
sub _connect { |
137
|
30
|
|
|
30
|
|
63
|
my $self = shift; |
138
|
|
|
|
|
|
|
my $dbh = $self->SUPER::_connect( |
139
|
30
|
100
|
|
|
|
213
|
sqlite_unicode => defined $self->{unicode} ? $self->{unicode} : 1 |
140
|
|
|
|
|
|
|
); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# Turn foreign keys on as default |
143
|
30
|
50
|
|
|
|
293
|
$dbh->do('PRAGMA foreign_keys = ON') unless $self->{foreign_keys}; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# Set busy timeout |
146
|
30
|
|
50
|
|
|
1428
|
$dbh->sqlite_busy_timeout( $self->{busy_timeout} || 300 ); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Reattach possibly attached databases |
149
|
30
|
|
|
|
|
71
|
while (my ($db_name, $file) = each %{$self->{attached}}) { |
|
30
|
|
|
|
|
190
|
|
150
|
0
|
|
|
|
|
0
|
$self->prep_and_exec("ATTACH '$file' AS ?", [$db_name]); |
151
|
|
|
|
|
|
|
}; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Return database handle |
154
|
30
|
|
|
|
|
146
|
$dbh; |
155
|
|
|
|
|
|
|
}; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# File of database |
159
|
0
|
|
0
|
0
|
1
|
0
|
sub file { $_[0]->{file} // '' }; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# Database driver |
163
|
1
|
|
|
1
|
1
|
8
|
sub driver { 'SQLite' }; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Database was just created |
167
|
|
|
|
|
|
|
sub created { |
168
|
28
|
|
|
28
|
1
|
68
|
my $self = shift; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Creation state is 0 |
171
|
28
|
100
|
|
|
|
127
|
return 0 unless $self->{created}; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Check for thread id |
174
|
27
|
50
|
33
|
|
|
226
|
if (defined $self->{tid} && $self->{tid} != threads->tid) { |
|
|
50
|
|
|
|
|
|
175
|
0
|
|
|
|
|
0
|
return ($self->{created} = 0); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Check for process id |
179
|
|
|
|
|
|
|
elsif ($self->{pid} != $$) { |
180
|
0
|
|
|
|
|
0
|
return ($self->{created} = 0); |
181
|
|
|
|
|
|
|
}; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Return creation state |
184
|
27
|
|
|
|
|
244
|
return 1; |
185
|
|
|
|
|
|
|
}; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# Explain query plan |
189
|
|
|
|
|
|
|
sub explain { |
190
|
1
|
|
|
1
|
1
|
443
|
my $self = shift; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# Prepare and execute explain query plan |
193
|
1
|
|
|
|
|
11
|
my ($rv, $sth) = $self->prep_and_exec( |
194
|
|
|
|
|
|
|
'EXPLAIN QUERY PLAN ' . shift, @_ |
195
|
|
|
|
|
|
|
); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# Query was not succesfull |
198
|
1
|
50
|
|
|
|
4
|
return unless $rv; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# Create string |
201
|
1
|
|
|
|
|
2
|
my $string; |
202
|
1
|
|
|
|
|
2
|
foreach ( @{ $sth->fetchall_arrayref([]) }) { |
|
1
|
|
|
|
|
23
|
|
203
|
2
|
|
|
|
|
61
|
$string .= sprintf("%3d | %3d | %3d | %-60s\n", @$_); |
204
|
|
|
|
|
|
|
}; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Return query plan string |
207
|
1
|
|
|
|
|
29
|
return $string; |
208
|
|
|
|
|
|
|
}; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# Delete with SQLite feature |
212
|
|
|
|
|
|
|
sub delete { |
213
|
11
|
|
|
11
|
1
|
1628
|
my $self = shift; |
214
|
11
|
|
|
|
|
18
|
my $secure; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Check if -secure parameter is set |
217
|
11
|
100
|
66
|
|
|
96
|
if ($_[-1] && ref $_[-1] && ref $_[-1] eq 'HASH') { |
|
|
|
66
|
|
|
|
|
218
|
5
|
|
50
|
|
|
19
|
$secure = delete $_[-1]->{-secure} || 0; |
219
|
|
|
|
|
|
|
}; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Delete |
222
|
11
|
50
|
|
|
|
29
|
unless ($secure) { |
223
|
|
|
|
|
|
|
|
224
|
11
|
|
|
|
|
91
|
my $rv = $self->SUPER::delete(@_); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Decrement autocommit |
227
|
11
|
100
|
|
|
|
48
|
$self->_decr_commit if $rv; |
228
|
|
|
|
|
|
|
|
229
|
11
|
|
|
|
|
78
|
return $rv; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# Delete securely |
233
|
|
|
|
|
|
|
else { |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# Security value |
236
|
0
|
|
|
|
|
0
|
my $sec_value; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Retrieve secure delete pragma |
239
|
0
|
|
|
|
|
0
|
my ($rv, $sth) = $self->prep_and_exec('PRAGMA secure_delete'); |
240
|
0
|
0
|
|
|
|
0
|
$sec_value = $sth->fetchrow_array if $rv; |
241
|
0
|
|
|
|
|
0
|
$sth->finish; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Set secure_delete pragma |
244
|
0
|
0
|
|
|
|
0
|
$self->do('PRAGMA secure_delete = ON') unless $sec_value; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# Delete |
247
|
0
|
|
|
|
|
0
|
$rv = $self->SUPER::delete(@_); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Decrement autocommit |
250
|
0
|
0
|
|
|
|
0
|
$self->_decr_commit if $rv; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Reset secure_delete pragma |
253
|
0
|
0
|
|
|
|
0
|
$self->do('PRAGMA secure_delete = OFF') unless $sec_value; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Return value |
256
|
0
|
|
|
|
|
0
|
return $rv; |
257
|
|
|
|
|
|
|
}; |
258
|
|
|
|
|
|
|
}; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Insert values to database |
262
|
|
|
|
|
|
|
sub insert { |
263
|
938
|
|
|
938
|
1
|
52555
|
my $self = shift; |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Get table name |
266
|
938
|
50
|
|
|
|
2584
|
my $table = $self->_table_name(\@_) or return; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# No parameters |
269
|
938
|
50
|
|
|
|
1718
|
return unless $_[0]; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# Properties |
272
|
938
|
50
|
66
|
|
|
3429
|
my $prop = shift if ref $_[0] eq 'HASH' && ref $_[1]; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Single insert |
275
|
938
|
100
|
|
|
|
2096
|
if (ref $_[0] eq 'HASH') { |
|
|
50
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Param |
278
|
905
|
|
|
|
|
945
|
my %param = %{ shift(@_) }; |
|
905
|
|
|
|
|
2846
|
|
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Create insert arrays |
281
|
905
|
|
|
|
|
1462
|
my (@keys, @values); |
282
|
905
|
|
|
|
|
2297
|
while (my ($key, $value) = each %param) { |
283
|
|
|
|
|
|
|
# Insert pairs |
284
|
1351
|
50
|
33
|
|
|
8767
|
next if !ref $key && $key !~ $DBIx::Oro::KEY_REGEX; |
285
|
1351
|
|
|
|
|
2234
|
push @keys, $key; |
286
|
1351
|
|
|
|
|
3422
|
push @values, $value; |
287
|
|
|
|
|
|
|
}; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Nothing to insert |
290
|
905
|
50
|
|
|
|
1518
|
return unless @keys; |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# Create insert string |
293
|
905
|
|
|
|
|
1271
|
my $sql = 'INSERT '; |
294
|
|
|
|
|
|
|
|
295
|
905
|
50
|
33
|
|
|
1602
|
if ($prop && (my $oc = $prop->{-on_conflict})) { |
296
|
0
|
0
|
|
|
|
0
|
if ($oc eq 'replace') { |
|
|
0
|
|
|
|
|
|
297
|
0
|
|
|
|
|
0
|
$sql = 'REPLACE ' |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
elsif ($oc eq 'ignore') { |
300
|
0
|
|
|
|
|
0
|
$sql .= 'IGNORE ' |
301
|
|
|
|
|
|
|
}; |
302
|
|
|
|
|
|
|
}; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
$sql .= 'INTO ' . $table . |
305
|
905
|
|
|
|
|
1938
|
' (' . join(', ', map { "`$_`" } @keys) . ') VALUES (' . DBIx::Oro::_q(\@values) . ')'; |
|
1351
|
|
|
|
|
4510
|
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# Prepare and execute |
308
|
905
|
|
|
|
|
2405
|
my $rv = $self->prep_and_exec( $sql, \@values ); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# Decrement autocommit |
311
|
905
|
100
|
|
|
|
3018
|
$self->_decr_commit if $rv; |
312
|
|
|
|
|
|
|
|
313
|
905
|
|
|
|
|
3510
|
return $rv; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
# Multiple inserts |
317
|
|
|
|
|
|
|
elsif (ref($_[0]) eq 'ARRAY') { |
318
|
|
|
|
|
|
|
|
319
|
33
|
100
|
|
|
|
112
|
return unless $_[1]; |
320
|
|
|
|
|
|
|
|
321
|
32
|
|
|
|
|
44
|
my @keys = @{ shift(@_) }; |
|
32
|
|
|
|
|
82
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Default values |
324
|
32
|
|
|
|
|
59
|
my @default = (); |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# Check if keys are defaults |
327
|
32
|
|
|
|
|
63
|
my $i = 0; |
328
|
32
|
|
|
|
|
50
|
my @default_keys; |
329
|
32
|
|
|
|
|
107
|
while ($keys[$i]) { |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# No default - next |
332
|
87
|
100
|
|
|
|
216
|
$i++, next unless ref $keys[$i]; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Has default value |
335
|
7
|
|
|
|
|
11
|
my ($key, $value) = @{ splice( @keys, $i, 1) }; |
|
7
|
|
|
|
|
19
|
|
336
|
7
|
|
|
|
|
15
|
push(@default_keys, $key); |
337
|
7
|
|
|
|
|
16
|
push(@default, $value); |
338
|
|
|
|
|
|
|
}; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
# Unshift default keys to front |
341
|
32
|
|
|
|
|
58
|
unshift(@keys, @default_keys); |
342
|
|
|
|
|
|
|
|
343
|
32
|
|
|
|
|
107
|
my $sql = 'INSERT INTO ' . $table . ' (' . join(', ', map { "`$_`" } @keys) . ') '; |
|
87
|
|
|
|
|
251
|
|
344
|
32
|
|
|
|
|
123
|
my $union = 'SELECT ' . DBIx::Oro::_q(\@keys); |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# Maximum bind variables |
347
|
32
|
|
|
|
|
143
|
my $max = ($MAX_COMP_SELECT / @keys) - @keys; |
348
|
|
|
|
|
|
|
|
349
|
32
|
100
|
|
|
|
98
|
if (scalar @_ <= $max) { |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
# Add data unions |
352
|
29
|
|
|
|
|
135
|
$sql .= $union . ((' UNION ' . $union) x ( scalar(@_) - 1 )); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# Prepare and execute with prepended defaults |
355
|
|
|
|
|
|
|
my @rv = $self->prep_and_exec( |
356
|
|
|
|
|
|
|
$sql, |
357
|
29
|
|
|
|
|
60
|
[ map { (@default, @$_); } @_ ] |
|
144
|
|
|
|
|
437
|
|
358
|
|
|
|
|
|
|
); |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# Decrement autocommit |
361
|
29
|
100
|
|
|
|
202
|
$self->_decr_commit if $rv[0]; |
362
|
|
|
|
|
|
|
|
363
|
29
|
|
|
|
|
546
|
return @rv; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# More than SQLite MAX_COMP_SELECT insertions |
367
|
|
|
|
|
|
|
else { |
368
|
|
|
|
|
|
|
|
369
|
3
|
|
|
|
|
7
|
my ($rv, @v_array); |
370
|
3
|
|
|
|
|
411
|
my @values = @_; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Start transaction |
373
|
|
|
|
|
|
|
$self->txn( |
374
|
|
|
|
|
|
|
sub { |
375
|
3
|
|
|
3
|
|
49
|
while (@v_array = splice(@values, 0, $max - 1)) { |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# Delete undef values |
378
|
28
|
50
|
|
|
|
91
|
@v_array = grep($_, @v_array) unless @_; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# Add data unions |
381
|
28
|
|
|
|
|
410
|
my $sub_sql = $sql . $union . |
382
|
|
|
|
|
|
|
((' UNION ' . $union) x ( scalar(@v_array) - 1 )); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# Prepare and execute |
385
|
|
|
|
|
|
|
my $rv_part = $self->prep_and_exec( |
386
|
|
|
|
|
|
|
$sub_sql, |
387
|
28
|
|
|
|
|
81
|
[ map { (@default, @$_); } @v_array ] |
|
6061
|
|
|
|
|
8361
|
|
388
|
|
|
|
|
|
|
); |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# Rollback transaction |
391
|
28
|
50
|
|
|
|
654
|
return -1 unless $rv_part; |
392
|
28
|
|
|
|
|
368
|
$rv += $rv_part; |
393
|
|
|
|
|
|
|
}; |
394
|
|
|
|
|
|
|
|
395
|
3
|
50
|
|
|
|
44
|
}) or return; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# Decrement autocommit |
398
|
3
|
50
|
|
|
|
45
|
$self->_decr_commit if $rv; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# Everything went fine |
401
|
3
|
|
|
|
|
91
|
return $rv; |
402
|
|
|
|
|
|
|
}; |
403
|
|
|
|
|
|
|
}; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# Unknown query |
406
|
0
|
|
|
|
|
0
|
return; |
407
|
|
|
|
|
|
|
}; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# Update existing values in the database |
411
|
|
|
|
|
|
|
sub update { |
412
|
25
|
|
|
25
|
1
|
1022
|
my $self = shift; |
413
|
|
|
|
|
|
|
|
414
|
25
|
|
|
|
|
115
|
my $rv = $self->SUPER::update(@_); |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# Decrement autocommit |
417
|
25
|
100
|
|
|
|
94
|
$self->_decr_commit if $rv; |
418
|
|
|
|
|
|
|
|
419
|
25
|
|
|
|
|
99
|
return $rv; |
420
|
|
|
|
|
|
|
}; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
sub merge { |
424
|
10
|
|
|
10
|
1
|
20
|
my $self = shift; |
425
|
|
|
|
|
|
|
|
426
|
10
|
|
|
|
|
50
|
my ($rv, $type) = $self->SUPER::merge(@_); |
427
|
|
|
|
|
|
|
|
428
|
10
|
50
|
100
|
|
|
56
|
if ($rv && $type eq 'insert' && ${$self->{autocommit}}) { |
|
4
|
|
66
|
|
|
17
|
|
429
|
0
|
|
|
|
|
0
|
${$self->{_autocounter}}--; |
|
0
|
|
|
|
|
0
|
|
430
|
|
|
|
|
|
|
}; |
431
|
|
|
|
|
|
|
|
432
|
10
|
50
|
|
|
|
69
|
return wantarray ? ($rv, $type) : $rv; |
433
|
|
|
|
|
|
|
}; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# Attach database |
436
|
|
|
|
|
|
|
sub attach { |
437
|
6
|
|
|
6
|
1
|
3583
|
my ($self, $db_name, $file) = @_; |
438
|
|
|
|
|
|
|
|
439
|
6
|
|
100
|
|
|
34
|
$file //= ''; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# Attach file, memory or temporary database |
442
|
6
|
|
|
|
|
46
|
my $rv = scalar $self->prep_and_exec("ATTACH '$file' AS ?", [$db_name]); |
443
|
|
|
|
|
|
|
|
444
|
6
|
|
|
|
|
32
|
$self->{attached}->{$db_name} = $file; |
445
|
|
|
|
|
|
|
|
446
|
6
|
|
|
|
|
28
|
return $rv; |
447
|
|
|
|
|
|
|
}; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# Detach database |
451
|
|
|
|
|
|
|
sub detach { |
452
|
4
|
|
|
4
|
1
|
11
|
my $self = shift; |
453
|
4
|
50
|
|
|
|
13
|
return unless $_[0]; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# Detach all databases |
456
|
4
|
|
|
|
|
11
|
foreach my $db_name (@_) { |
457
|
5
|
|
|
|
|
17
|
delete $self->{attached}->{$db_name}; |
458
|
5
|
100
|
|
|
|
20
|
return unless $self->prep_and_exec('DETACH ?', [$db_name]); |
459
|
|
|
|
|
|
|
}; |
460
|
|
|
|
|
|
|
|
461
|
3
|
|
|
|
|
19
|
return 1; |
462
|
|
|
|
|
|
|
}; |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Wrapper for sqlite last_insert_row_id |
466
|
|
|
|
|
|
|
sub last_insert_id { |
467
|
14
|
|
|
14
|
1
|
88
|
shift->dbh->sqlite_last_insert_rowid; |
468
|
|
|
|
|
|
|
}; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
# Create matchinfo function |
472
|
|
|
|
|
|
|
sub matchinfo { |
473
|
2
|
|
|
2
|
1
|
10847
|
my $self = shift; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# Use no multibyte characters |
476
|
|
|
|
|
|
|
# use bytes; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# Format string |
479
|
2
|
50
|
33
|
|
|
30
|
my $format = lc(shift) if $_[0] && $_[0] =~ /^[pcnalsx]+$/i; |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# Return anonymous subroutine |
482
|
|
|
|
|
|
|
return sub { |
483
|
3
|
|
|
3
|
|
4
|
my $column; |
484
|
3
|
50
|
|
|
|
9
|
if (@_) { |
485
|
3
|
|
50
|
|
|
9
|
$column = shift || 'content'; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# Format string |
488
|
3
|
50
|
33
|
|
|
10
|
$format = lc(shift) if $_[0] && $_[0] =~ /^[pcnalsx]+$/i; |
489
|
|
|
|
|
|
|
}; |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# Sort format for leading 'pc' if needed |
492
|
3
|
50
|
|
|
|
9
|
if ($format) { |
493
|
3
|
|
|
|
|
6
|
for ($format) { |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Sort alphabetically |
496
|
3
|
|
|
|
|
27
|
$_ = join('', sort split('', $_)); |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
# Delete repeating characters |
499
|
3
|
|
|
|
|
20
|
s/(.)\1+/$1/g; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# Prepend 'pc' if necessary |
502
|
3
|
50
|
|
|
|
13
|
if (/[xals]/) { |
503
|
3
|
|
|
|
|
12
|
tr/pc//d; # Delete 'pc' |
504
|
3
|
|
|
|
|
9
|
$_ = 'pc' . $format; # Prepend 'pc' |
505
|
|
|
|
|
|
|
}; |
506
|
|
|
|
|
|
|
}; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# No format given |
510
|
|
|
|
|
|
|
else { |
511
|
0
|
|
|
|
|
0
|
$format = 'pcx'; |
512
|
|
|
|
|
|
|
}; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# Return anonymous subroutine |
515
|
|
|
|
|
|
|
return sub { |
516
|
|
|
|
|
|
|
return |
517
|
3
|
|
|
|
|
17
|
'matchinfo(' . $column . ', "' . $format . '")', |
518
|
|
|
|
|
|
|
\&_matchinfo_return, |
519
|
|
|
|
|
|
|
$format; |
520
|
3
|
|
|
|
|
19
|
}; |
521
|
2
|
|
|
|
|
28
|
}; |
522
|
|
|
|
|
|
|
}; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# Treat matchinfo return |
526
|
|
|
|
|
|
|
sub _matchinfo_return { |
527
|
6
|
|
|
6
|
|
16
|
my ($blob, $format) = @_; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# Get 32-bit blob chunks |
530
|
6
|
|
|
|
|
39
|
my @matchinfo = unpack('l' . (length($blob) * 4), $blob); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# Parse format character |
533
|
6
|
|
|
|
|
10
|
my %match; |
534
|
6
|
|
|
|
|
20
|
foreach (split '', $format) { |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# Characters: p, c, n |
537
|
22
|
100
|
100
|
|
|
117
|
if ($_ eq 'p' or $_ eq 'c' or $_ eq 'n') { |
|
|
100
|
100
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
538
|
14
|
|
|
|
|
30
|
$match{$_} = shift @matchinfo; |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# Characters: a, l, s |
542
|
|
|
|
|
|
|
elsif ($_ eq 'a' or $_ eq 'l' or $_ eq 's') { |
543
|
4
|
|
|
|
|
14
|
$match{$_} = [ splice(@matchinfo, 0, $match{c}) ]; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
# Characters: x |
547
|
|
|
|
|
|
|
elsif ($_ eq 'x') { |
548
|
4
|
|
|
|
|
6
|
my @match; |
549
|
4
|
|
|
|
|
12
|
for (1 .. ($match{p} * $match{c})) { |
550
|
12
|
|
|
|
|
30
|
push(@match, [ splice(@matchinfo, 0, 3) ]); |
551
|
|
|
|
|
|
|
}; |
552
|
|
|
|
|
|
|
|
553
|
4
|
|
|
|
|
11
|
$match{$_} = \@match; |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# Unknown character |
557
|
|
|
|
|
|
|
else { |
558
|
0
|
|
|
|
|
0
|
shift @matchinfo; |
559
|
|
|
|
|
|
|
}; |
560
|
|
|
|
|
|
|
}; |
561
|
6
|
|
|
|
|
26
|
return \%match; |
562
|
|
|
|
|
|
|
}; |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
# Create offsets function |
566
|
|
|
|
|
|
|
sub offsets { |
567
|
3
|
|
|
3
|
1
|
2146
|
my $self = shift; |
568
|
3
|
|
|
|
|
6
|
my $field = shift; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# Use no multibyte characters |
571
|
|
|
|
|
|
|
# use bytes; |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# subroutine |
574
|
|
|
|
|
|
|
return sub { |
575
|
3
|
|
|
3
|
|
9
|
my $column = shift; |
576
|
|
|
|
|
|
|
'offsets(' . ($column // $field // 'content') . ')', |
577
|
|
|
|
|
|
|
sub { |
578
|
4
|
|
|
|
|
10
|
my $blob = shift; |
579
|
4
|
|
|
|
|
7
|
my @offset; |
580
|
4
|
|
|
|
|
43
|
my @array = split(/\s/, $blob); |
581
|
4
|
|
|
|
|
14
|
while (@array) { |
582
|
7
|
|
|
|
|
28
|
push(@offset, [ splice(@array, 0, 4) ]); |
583
|
|
|
|
|
|
|
}; |
584
|
4
|
|
|
|
|
17
|
return \@offset; |
585
|
|
|
|
|
|
|
} |
586
|
3
|
|
33
|
|
|
50
|
}; |
|
3
|
|
50
|
|
|
41
|
|
587
|
|
|
|
|
|
|
}; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# Create snippet function |
591
|
|
|
|
|
|
|
sub snippet { |
592
|
5
|
|
|
5
|
1
|
17
|
my $self = shift; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# Snippet parameters |
595
|
5
|
|
|
|
|
9
|
my @snippet; |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# Parameters are given |
598
|
5
|
100
|
|
|
|
19
|
if ($_[0]) { |
599
|
3
|
|
|
|
|
16
|
my %snippet = (); |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# Parameters are given as a hash |
602
|
3
|
50
|
|
|
|
31
|
if ($_[0] =~ $arguments) { |
603
|
3
|
|
|
|
|
18
|
%snippet = @_; |
604
|
3
|
|
|
|
|
11
|
foreach (keys %snippet) { |
605
|
8
|
50
|
|
|
|
39
|
carp "Unknown snippet parameter '$_'" unless $_ =~ $arguments; |
606
|
|
|
|
|
|
|
}; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
# Parameters are given as an array |
610
|
|
|
|
|
|
|
else { |
611
|
0
|
|
|
|
|
0
|
@snippet{@arguments} = @_; |
612
|
|
|
|
|
|
|
}; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
# Trim parameter array and fill gaps with defaults |
615
|
3
|
|
|
|
|
9
|
my ($s, $i) = (0, 0); |
616
|
3
|
|
|
|
|
8
|
foreach (reverse @arguments) { |
617
|
15
|
100
|
|
|
|
34
|
$s = 1 if defined $snippet{$_}; |
618
|
15
|
100
|
66
|
|
|
62
|
unshift(@snippet, $snippet{$_} // $default[$i]) if $s; |
619
|
15
|
|
|
|
|
27
|
$i++; |
620
|
|
|
|
|
|
|
}; |
621
|
|
|
|
|
|
|
}; |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
# Return anonymous subroutine |
624
|
5
|
|
|
|
|
9
|
my $sub = 'sub { |
625
|
|
|
|
|
|
|
my $column = $_[0] ? shift : \'content\'; |
626
|
|
|
|
|
|
|
my $str = "snippet(" . $column '; |
627
|
|
|
|
|
|
|
|
628
|
5
|
100
|
|
|
|
12
|
if ($snippet[0]) { |
629
|
3
|
|
|
|
|
8
|
$sub .= ' . ", ' . join(',', map { '\"' . $_ . '\"' } @snippet) . '"'; |
|
12
|
|
|
|
|
39
|
|
630
|
|
|
|
|
|
|
}; |
631
|
|
|
|
|
|
|
|
632
|
5
|
|
|
|
|
12
|
$sub .= " . \")\";\n};"; |
633
|
|
|
|
|
|
|
|
634
|
5
|
|
|
|
|
521
|
return eval( $sub ); |
635
|
|
|
|
|
|
|
}; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# New table object |
639
|
|
|
|
|
|
|
sub table { |
640
|
26
|
|
|
26
|
1
|
15503
|
my $self = shift; |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
# Get object from superclass |
643
|
26
|
|
|
|
|
99
|
my $table = $self->SUPER::table(@_); |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# Add autocommit parameters |
646
|
26
|
|
|
|
|
54
|
foreach (qw/autocommit _autocounter |
647
|
|
|
|
|
|
|
foreign_keys/) { |
648
|
78
|
|
|
|
|
150
|
$table->{$_} = $self->{$_}; |
649
|
|
|
|
|
|
|
}; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# Return blessed object |
652
|
26
|
|
|
|
|
65
|
return $table; |
653
|
|
|
|
|
|
|
}; |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
# Set foreign_key pragma |
657
|
|
|
|
|
|
|
sub foreign_keys { |
658
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
# Get pragma |
661
|
0
|
0
|
0
|
|
|
0
|
unless (defined $_[0]) { |
|
|
0
|
|
|
|
|
|
662
|
0
|
|
|
|
|
0
|
return $self->{foreign_keys}; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# Turn foreign keys on |
666
|
0
|
0
|
|
|
|
0
|
elsif ($_[0] && !$self->{foreign_keys}) { |
667
|
0
|
|
|
|
|
0
|
$self->dbh->do('PRAGMA foreign_keys = ON'); |
668
|
0
|
|
|
|
|
0
|
return ($self->{foreign_keys} = 1); |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
# Turn foreign keys off |
672
|
|
|
|
|
|
|
elsif (!$_[0] && $self->{foreign_keys}) { |
673
|
|
|
|
|
|
|
$self->dbh->do('PRAGMA foreign_keys = OFF'); |
674
|
|
|
|
|
|
|
return ($self->{foreign_keys} = 0); |
675
|
|
|
|
|
|
|
}; |
676
|
|
|
|
|
|
|
|
677
|
0
|
|
|
|
|
0
|
return; |
678
|
|
|
|
|
|
|
}; |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
# Set autocommit |
682
|
|
|
|
|
|
|
sub autocommit { |
683
|
14
|
|
|
14
|
1
|
479
|
my $self = shift; |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# Get autocommit |
686
|
14
|
100
|
|
|
|
35
|
unless (defined $_[0]) { |
687
|
5
|
|
50
|
|
|
7
|
return ${$self->{autocommit}} || 0; |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# Set autocommit |
691
|
|
|
|
|
|
|
else { |
692
|
9
|
|
|
|
|
11
|
my $num = shift; |
693
|
9
|
|
|
|
|
23
|
my $dbh = $self->dbh; |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
# Is a number |
696
|
9
|
100
|
66
|
|
|
80
|
if ($num && $num =~ m/^\d+/o) { |
|
|
50
|
|
|
|
|
|
697
|
5
|
50
|
|
|
|
12
|
if ($num > 1) { |
698
|
5
|
|
|
|
|
25
|
$dbh->{AutoCommit} = 0; |
699
|
5
|
|
|
|
|
11
|
${$self->{autocommit}} = |
700
|
5
|
|
|
|
|
10
|
${$self->{_autocounter}} = $num; |
|
5
|
|
|
|
|
23
|
|
701
|
5
|
|
|
|
|
23
|
return 1; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
else { |
705
|
0
|
|
|
|
|
0
|
$dbh->{AutoCommit} = 1; |
706
|
0
|
|
|
|
|
0
|
${$self->{_autocounter}} = |
707
|
0
|
|
|
|
|
0
|
${$self->{autocommit}} = 0; |
|
0
|
|
|
|
|
0
|
|
708
|
0
|
|
|
|
|
0
|
return 1; |
709
|
|
|
|
|
|
|
}; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# Is null |
713
|
|
|
|
|
|
|
elsif (!$num) { |
714
|
4
|
|
|
|
|
17
|
${$self->{autocommit}} = 0; |
|
4
|
|
|
|
|
7
|
|
715
|
4
|
50
|
|
|
|
17
|
if (${$self->{_autocounter}}) { |
|
4
|
|
|
|
|
10
|
|
716
|
4
|
|
|
|
|
9
|
${$self->{_autocounter}} = 0; |
|
4
|
|
|
|
|
5
|
|
717
|
4
|
|
|
|
|
54
|
$dbh->commit; |
718
|
|
|
|
|
|
|
}; |
719
|
4
|
50
|
|
|
|
10
|
$dbh->{AutoCommit} = 1 unless ${$self->{in_txn}}; |
|
4
|
|
|
|
|
30
|
|
720
|
4
|
|
|
|
|
25
|
return 1; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
# Failure |
724
|
|
|
|
|
|
|
else { |
725
|
0
|
|
|
|
|
0
|
return; |
726
|
|
|
|
|
|
|
}; |
727
|
|
|
|
|
|
|
}; |
728
|
|
|
|
|
|
|
}; |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
# Decrement commit counter |
732
|
|
|
|
|
|
|
sub _decr_commit { |
733
|
955
|
|
|
955
|
|
1213
|
my $self = shift; |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# Autocounter is set |
736
|
955
|
100
|
|
|
|
1035
|
if (${$self->{_autocounter}}) { |
|
955
|
|
|
|
|
2326
|
|
737
|
66
|
|
|
|
|
69
|
my $auto = --${$self->{_autocounter}}; |
|
66
|
|
|
|
|
123
|
|
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# Commit is null |
740
|
66
|
100
|
|
|
|
127
|
unless ($auto) { |
741
|
|
|
|
|
|
|
|
742
|
4
|
50
|
|
|
|
9
|
$self->dbh->commit unless ${$self->{in_txn}}; |
|
4
|
|
|
|
|
16
|
|
743
|
4
|
|
|
|
|
11
|
${$self->{_autocounter}} = ${$self->{autocommit}}; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
8
|
|
744
|
|
|
|
|
|
|
}; |
745
|
|
|
|
|
|
|
}; |
746
|
|
|
|
|
|
|
}; |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
1; |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
__END__ |