line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Fast; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
12857
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings FATAL => 'all'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
48
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
443
|
use Moo; |
|
1
|
|
|
|
|
11064
|
|
|
1
|
|
|
|
|
6
|
|
9
|
1
|
|
|
1
|
|
1207
|
use DBIx::Connector; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use DateTime::Format::MySQL; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
has db => ( is => 'rw' ); |
13
|
|
|
|
|
|
|
has sql => ( is => 'rw' ); |
14
|
|
|
|
|
|
|
has p => ( is => 'rw' ); |
15
|
|
|
|
|
|
|
has last_id => ( is => 'rw'); |
16
|
|
|
|
|
|
|
has results => ( is => 'rw'); |
17
|
|
|
|
|
|
|
has errors => ( is => 'rw'); |
18
|
|
|
|
|
|
|
has dbd => ( is => 'rwp'); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub set_error { |
21
|
|
|
|
|
|
|
my $self = shift; |
22
|
|
|
|
|
|
|
my $error = { |
23
|
|
|
|
|
|
|
id => shift, |
24
|
|
|
|
|
|
|
error => shift |
25
|
|
|
|
|
|
|
}; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $Errors = $self->errors; |
28
|
|
|
|
|
|
|
push @{$Errors} ,$error; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$self->errors($Errors); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub BUILD { |
34
|
|
|
|
|
|
|
my ($self,$args) = @_; |
35
|
|
|
|
|
|
|
my $dsn; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $dbi_args = { |
38
|
|
|
|
|
|
|
RaiseError => 0, |
39
|
|
|
|
|
|
|
PrintError => 0, |
40
|
|
|
|
|
|
|
AutoCommit => 1, |
41
|
|
|
|
|
|
|
}; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
$args->{host} = '127.0.0.1' unless $args->{host}; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
$args->{host} eq 'sqlite' ? $self->_set_dbd('sqlite') : |
46
|
|
|
|
|
|
|
$self->_set_dbd('mysql'); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
if ( $self->dbd eq 'sqlite' ) { |
49
|
|
|
|
|
|
|
$dsn = 'dbi:SQLite:'.$args->{db}; |
50
|
|
|
|
|
|
|
$self->db(DBIx::Connector->new( $dsn, $args->{user}, $args->{passwd}, |
51
|
|
|
|
|
|
|
$dbi_args )); |
52
|
|
|
|
|
|
|
} else { |
53
|
|
|
|
|
|
|
$dsn= 'dbi:mysql:database='.$args->{db}.':'.$args->{host}; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$self->db(DBIx::Connector->new( $dsn, $args->{user}, $args->{passwd}, |
56
|
|
|
|
|
|
|
$dbi_args )); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$self->db->mode('ping'); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
$self->db->dbh->{HandleError} = sub { |
62
|
|
|
|
|
|
|
$self->set_error($DBI::err,$DBI::errstr); |
63
|
|
|
|
|
|
|
}; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
$self->db->dbh->trace($args->{trace},'dbix-fast-trace') if $args->{trace}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$self->profile($args->{profile}) if $args->{profile}; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head2 profile |
71
|
|
|
|
|
|
|
Save profile with the PID |
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
sub profile { |
74
|
|
|
|
|
|
|
my $self = shift; |
75
|
|
|
|
|
|
|
my $stat = shift."/DBI::ProfileDumper/"; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$stat .= qq{File:dbix-fast-$$.prof}; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$self->db->dbh->{Profile} = $stat; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head2 Compatibility |
83
|
|
|
|
|
|
|
scalar @_ > 1 ? $self->execute(@_,'arrayref') : |
84
|
|
|
|
|
|
|
$self->execute(@_,undef,'arrayref'); |
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
sub all { |
87
|
|
|
|
|
|
|
my $self = shift; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$self->q(@_); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my $res = $self->db->dbh->selectall_arrayref($self->sql, |
92
|
|
|
|
|
|
|
{ Slice => {} },@{$self->p}); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
$self->results($res) unless $DBI::err; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub hash { |
98
|
|
|
|
|
|
|
my $self = shift; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
$self->q(@_); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
my $sth = $self->db->dbh->prepare($self->sql); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
$sth->execute(@{$self->p}); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my $res = $sth->fetchrow_hashref; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$self->results($res) unless $DBI::err; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 val |
112
|
|
|
|
|
|
|
Return one value |
113
|
|
|
|
|
|
|
=cut |
114
|
|
|
|
|
|
|
sub val { |
115
|
|
|
|
|
|
|
my $self = shift; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$self->q(@_); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
return $self->db->dbh->selectrow_array($self->sql, undef, @{$self->p}); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 array |
123
|
|
|
|
|
|
|
Return array |
124
|
|
|
|
|
|
|
=cut |
125
|
|
|
|
|
|
|
sub array { |
126
|
|
|
|
|
|
|
my $self = shift; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
$self->q(@_); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $sth = $self->db->dbh->prepare($self->sql); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
$sth->execute(@{$self->p}); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my @rows = @{ $self->db->dbh->selectcol_arrayref( |
135
|
|
|
|
|
|
|
$self->sql, undef, @{ $self->p } ) }; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
$self->results(\@rows) unless $DBI::err; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub count { |
141
|
|
|
|
|
|
|
my $self = shift; |
142
|
|
|
|
|
|
|
my $table = shift; |
143
|
|
|
|
|
|
|
my $skeel = shift; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$self->sql("SELECT COUNT(*) FROM $table"); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
unless ( $skeel ) { |
148
|
|
|
|
|
|
|
return $self->db->dbh->selectrow_array($self->sql); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
$self->_make_where($skeel); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
return $self->db->dbh->selectrow_array($self->sql, undef, @{$self->p}); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub _make_where { |
157
|
|
|
|
|
|
|
my $self = shift; |
158
|
|
|
|
|
|
|
my $skeel = shift; |
159
|
|
|
|
|
|
|
my @p; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my $sql = " WHERE "; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
for my $K ( keys %{$skeel} ) { |
164
|
|
|
|
|
|
|
#my $key = each %{$skeel->{$K}}; |
165
|
|
|
|
|
|
|
my $key = (keys %{$skeel->{$K}})[0]; |
166
|
|
|
|
|
|
|
push @p,$skeel->{$K}->{$key}; |
167
|
|
|
|
|
|
|
$sql .= qq{$K $key ? }; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
$sql =~ s/,$//; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
$self->sql($self->sql.$sql); |
173
|
|
|
|
|
|
|
$self->p(\@p); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub execute { |
177
|
|
|
|
|
|
|
my $self = shift; |
178
|
|
|
|
|
|
|
my $sql = shift; |
179
|
|
|
|
|
|
|
my $extra = shift; |
180
|
|
|
|
|
|
|
my $type = shift // 'arrayref'; |
181
|
|
|
|
|
|
|
my $res; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
$self->sql($sql); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
## Extra Arguments |
186
|
|
|
|
|
|
|
$self->make_sen($extra) if $extra; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
if ( $type eq 'hash' ) { |
189
|
|
|
|
|
|
|
my $sth = $self->db->dbh->prepare($self->sql); |
190
|
|
|
|
|
|
|
if ( $self->p ) { |
191
|
|
|
|
|
|
|
$sth->execute(@{$self->p}); |
192
|
|
|
|
|
|
|
} else { |
193
|
|
|
|
|
|
|
$sth->execute; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
$res = $sth->fetchrow_hashref; |
196
|
|
|
|
|
|
|
} else { |
197
|
|
|
|
|
|
|
if ($self->p ) { |
198
|
|
|
|
|
|
|
$res = $self->db->dbh->selectall_arrayref($self->sql, |
199
|
|
|
|
|
|
|
{ Slice => {} },@{$self->p}); |
200
|
|
|
|
|
|
|
} else { |
201
|
|
|
|
|
|
|
$res = $self->db->dbh->selectall_arrayref($self->sql, |
202
|
|
|
|
|
|
|
{ Slice => {} } ); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
unless ( $DBI::err ) { |
207
|
|
|
|
|
|
|
$self->results($res); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub update { |
213
|
|
|
|
|
|
|
my $self = shift; |
214
|
|
|
|
|
|
|
my $table = shift; |
215
|
|
|
|
|
|
|
my $skeel = shift; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
$skeel->{sen} = $self->extra_args($skeel->{sen},@_) if scalar @_ > 0; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
my @p; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my $sql = "UPDATE $table SET "; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
for ( keys %{$skeel->{sen}} ) { |
224
|
|
|
|
|
|
|
push @p,$skeel->{sen}->{$_}; |
225
|
|
|
|
|
|
|
$sql .= $_.' = ? ,'; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$sql =~ s/,$//; |
229
|
|
|
|
|
|
|
$sql .= 'WHERE '; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
for my $K ( keys %{$skeel->{where}} ) { |
232
|
|
|
|
|
|
|
push @p,$skeel->{where}->{$K}; |
233
|
|
|
|
|
|
|
$sql .= $K.' = ? ,'; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
$sql =~ s/,$//; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$self->sql($sql); |
239
|
|
|
|
|
|
|
$self->execute_prepare(@p); |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub insert { |
243
|
|
|
|
|
|
|
my $self = shift; |
244
|
|
|
|
|
|
|
my $table = shift; |
245
|
|
|
|
|
|
|
my $skeel = shift; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
$skeel = $self->extra_args($skeel,@_) if scalar @_ > 0; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
my @p; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
my $sql= "INSERT INTO $table ( "; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
for ( keys %{$skeel} ) { |
254
|
|
|
|
|
|
|
push @p,$skeel->{$_}; |
255
|
|
|
|
|
|
|
$sql .= $_.','; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
$sql =~ s/,$/ )/; |
259
|
|
|
|
|
|
|
$sql .= ' VALUES ( '.join(',', ('?') x @p).' )'; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
$self->sql($sql); |
262
|
|
|
|
|
|
|
$self->execute_prepare(@p); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
if ( $self->dbd eq 'mysql' ) { |
265
|
|
|
|
|
|
|
$self->last_id($self->db->dbh->{mysql_insertid}); |
266
|
|
|
|
|
|
|
} elsif ( $self->dbd eq 'sqlite' ) { |
267
|
|
|
|
|
|
|
$self->last_id($self->db->dbh->sqlite_last_insert_rowid()); |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub delete { |
273
|
|
|
|
|
|
|
my $self = shift; |
274
|
|
|
|
|
|
|
my $table = shift; |
275
|
|
|
|
|
|
|
my $skeel = shift; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
$self->sql("DELETE FROM $table"); |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
#unless ( $skeel ) { |
280
|
|
|
|
|
|
|
# return $self->db->dbh->selectrow_array($self->sql); |
281
|
|
|
|
|
|
|
#} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
$self->_make_where($skeel); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my $sth = $self->db->dbh->prepare($self->sql); |
286
|
|
|
|
|
|
|
$sth->execute(@{$self->p}); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=head2 function |
290
|
|
|
|
|
|
|
Extra Args : |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
time : NOW() |
293
|
|
|
|
|
|
|
=cut |
294
|
|
|
|
|
|
|
sub extra_args { |
295
|
|
|
|
|
|
|
my $self = shift; |
296
|
|
|
|
|
|
|
my $skeel = shift; |
297
|
|
|
|
|
|
|
my %args = @_; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
$skeel->{$args{time}} = DateTime::Format::MySQL->format_datetime(DateTime->now) |
300
|
|
|
|
|
|
|
if $args{time}; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
return $skeel; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
## FIXME : Hacer con execute_prepare |
306
|
|
|
|
|
|
|
sub make_sen { |
307
|
|
|
|
|
|
|
my $self = shift; |
308
|
|
|
|
|
|
|
my $skeel = shift; |
309
|
|
|
|
|
|
|
my $sql = $self->sql(); |
310
|
|
|
|
|
|
|
my @p; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
## Ha de encontrar resultados por el orden de entrada parsear debidamente |
313
|
|
|
|
|
|
|
for ( keys %{$skeel} ) { |
314
|
|
|
|
|
|
|
my $arg = ':'.$_; |
315
|
|
|
|
|
|
|
push @p,$skeel->{$_}; |
316
|
|
|
|
|
|
|
$sql =~ s/$arg/\?/; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
$sql =~ s/,$//; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
$self->sql($sql); |
322
|
|
|
|
|
|
|
$self->p(\@p); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub q { |
326
|
|
|
|
|
|
|
my $self = shift; |
327
|
|
|
|
|
|
|
my $sql = shift; |
328
|
|
|
|
|
|
|
my @p; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
map { push @p,$_ } @_; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
$self->sql($sql); |
333
|
|
|
|
|
|
|
$self->p(\@p); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub execute_prepare { |
337
|
|
|
|
|
|
|
my $self = shift; |
338
|
|
|
|
|
|
|
my @p = @_; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
my $sth = $self->db->dbh->prepare($self->sql); |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
$sth->execute(@p); |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head1 NAME |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
DBIx::Fast |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head1 SYNOPSIS |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
$db = DBIx::Fast->new( db => 'test' , user => 'test' , passwd => 'test'); |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$db = DBIx::Fast->new( db => 'test' , user => 'test' , passwd => 'test', |
354
|
|
|
|
|
|
|
trace => '1' , profile => '!Statement:!MethodName' ); |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head1 DESCRIPTION |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
1; |