| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# -*- perl -*- |
|
2
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
3
|
|
|
|
|
|
|
## Database Object Interface - ~/lib/DB/Object/Statement.pm |
|
4
|
|
|
|
|
|
|
## Version v0.4.2 |
|
5
|
|
|
|
|
|
|
## Copyright(c) 2022 DEGUEST Pte. Ltd. |
|
6
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
|
7
|
|
|
|
|
|
|
## Created 2017/07/19 |
|
8
|
|
|
|
|
|
|
## Modified 2023/03/24 |
|
9
|
|
|
|
|
|
|
## All rights reserved |
|
10
|
|
|
|
|
|
|
## |
|
11
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
|
12
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
|
13
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
14
|
|
|
|
|
|
|
## This package's purpose is to automatically terminate the statement object and |
|
15
|
|
|
|
|
|
|
## separate them from the connection object (DB::Object). |
|
16
|
|
|
|
|
|
|
## Connection object last longer than statement objects |
|
17
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
|
18
|
|
|
|
|
|
|
package DB::Object::Statement; |
|
19
|
|
|
|
|
|
|
BEGIN |
|
20
|
0
|
|
|
|
|
0
|
{ |
|
21
|
1
|
|
|
1
|
|
1777
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
34
|
|
|
22
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
28
|
|
|
23
|
1
|
|
|
1
|
|
5
|
use parent qw( DB::Object ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
5
|
|
|
24
|
1
|
|
|
1
|
|
62
|
use vars qw( $VERSION $VERBOSE $DEBUG ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
53
|
|
|
25
|
1
|
|
|
1
|
|
6
|
use Class::Struct qw( struct ); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
8
|
|
|
26
|
1
|
|
|
1
|
|
113
|
use Want; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
60
|
|
|
27
|
1
|
|
|
1
|
|
57
|
$VERSION = 'v0.4.2'; |
|
28
|
1
|
|
|
|
|
1
|
$VERBOSE = 0; |
|
29
|
1
|
|
|
|
|
19
|
$DEBUG = 0; |
|
30
|
1
|
|
|
1
|
|
6
|
use Devel::Confess; |
|
|
1
|
|
|
|
|
12
|
|
|
|
1
|
|
|
|
|
8
|
|
|
31
|
|
|
|
|
|
|
}; |
|
32
|
|
|
|
|
|
|
|
|
33
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
35
|
|
|
34
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
1872
|
|
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub as_string |
|
37
|
|
|
|
|
|
|
{ |
|
38
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
39
|
|
|
|
|
|
|
# my $q = $self->_query_object_current; |
|
40
|
|
|
|
|
|
|
# used by select, insert, update, delete to flag that we need to reformat the query |
|
41
|
0
|
|
|
|
|
|
$self->{as_string}++; |
|
42
|
0
|
0
|
|
|
|
|
if( my $qo = $self->query_object ) |
|
43
|
|
|
|
|
|
|
{ |
|
44
|
0
|
|
|
|
|
|
$qo->final(1); |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
# return( $self->{sth}->{Statement} ); |
|
47
|
|
|
|
|
|
|
# Same: |
|
48
|
|
|
|
|
|
|
# return( $q->as_string ); |
|
49
|
0
|
|
|
|
|
|
return( $self->{query} ); |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub bind_param |
|
53
|
|
|
|
|
|
|
{ |
|
54
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
55
|
0
|
|
|
|
|
|
my( $pack, $file, $line ) = caller(); |
|
56
|
0
|
|
|
|
|
|
my $sub = ( caller(1) )[3]; |
|
57
|
0
|
|
|
|
|
|
$self->{pack} = $pack; |
|
58
|
0
|
|
|
|
|
|
$self->{file} = $file; |
|
59
|
0
|
|
|
|
|
|
$self->{line} = $line; |
|
60
|
0
|
|
|
|
|
|
$self->{sub} = $sub; |
|
61
|
|
|
|
|
|
|
my $rc = |
|
62
|
|
|
|
|
|
|
eval |
|
63
|
0
|
|
|
|
|
|
{ |
|
64
|
0
|
|
|
|
|
|
$self->{sth}->bind_param( @_ ); |
|
65
|
|
|
|
|
|
|
}; |
|
66
|
0
|
0
|
|
|
|
|
if( $@ ) |
|
|
|
0
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
{ |
|
68
|
0
|
|
|
|
|
|
my $err = $self->errstr(); |
|
69
|
0
|
|
|
|
|
|
$err =~ s/ at line \d+.*$//; |
|
70
|
|
|
|
|
|
|
# printf( STDERR "%s in %s at line %d within sub '%s'.\n", $err, $self->{file}, $self->{line}, $self->{sub} ); |
|
71
|
|
|
|
|
|
|
# exit(1); |
|
72
|
0
|
|
|
|
|
|
return( $self->error( $err ) ); |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
elsif( $rc ) |
|
75
|
|
|
|
|
|
|
{ |
|
76
|
0
|
|
|
|
|
|
return( $rc ); |
|
77
|
|
|
|
|
|
|
} |
|
78
|
|
|
|
|
|
|
else |
|
79
|
|
|
|
|
|
|
{ |
|
80
|
0
|
|
0
|
|
|
|
my $err = $@ = $self->{sth}->errstr() || "Unknown error while binding parameters to query."; |
|
81
|
0
|
|
|
|
|
|
return( $self->error( $err ) ); |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
} |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub commit |
|
86
|
|
|
|
|
|
|
{ |
|
87
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
88
|
0
|
0
|
0
|
|
|
|
if( $self->{sth} && $self->param( 'autocommit' ) ) |
|
89
|
|
|
|
|
|
|
{ |
|
90
|
0
|
|
0
|
|
|
|
my $sth = $self->prepare( 'COMMIT' ) || return( $self->pass_error ); |
|
91
|
0
|
0
|
|
|
|
|
$sth->execute() || return( $self->error( "An error occurred while executing query: ", $sth->error ) ); |
|
92
|
0
|
|
|
|
|
|
$sth->finish(); |
|
93
|
|
|
|
|
|
|
} |
|
94
|
0
|
|
|
|
|
|
return( $self ); |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
|
|
97
|
0
|
|
|
0
|
1
|
|
sub database_object { return( shift->_set_get_object_without_init( 'dbo', 'DB::Object', @_ ) ); } |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub distinct |
|
100
|
|
|
|
|
|
|
{ |
|
101
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
102
|
|
|
|
|
|
|
my $query = $self->{query} || |
|
103
|
0
|
|
0
|
|
|
|
return( $self->error( "No query to set as to be ignored." ) ); |
|
104
|
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
|
my $type = uc( ( $query =~ /^\s*(\S+)\s+/ )[0] ); |
|
106
|
|
|
|
|
|
|
# ALTER for table alteration statements (DB::Object::Tables |
|
107
|
0
|
|
|
|
|
|
my @allowed = qw( SELECT ); |
|
108
|
0
|
|
|
|
|
|
my $allowed = CORE::join( '|', @allowed ); |
|
109
|
0
|
0
|
|
|
|
|
if( !scalar( grep{ /^$type$/i } @allowed ) ) |
|
|
0
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
{ |
|
111
|
0
|
|
|
|
|
|
return( $self->error( "You may not flag statement of type \U$type\E to be distinct:\n$query" ) ); |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
# Incompatible. Do not bother going further |
|
114
|
0
|
0
|
|
|
|
|
return( $self ) if( $query =~ /^\s*(?:$allowed)\s+(?:DISTINCT|DISTINCTROW|ALL)\s+/i ); |
|
115
|
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
$query =~ s/^(\s*)($allowed)(\s+)/$1$2 DISTINCT /; |
|
117
|
|
|
|
|
|
|
# my $sth = $self->prepare( $query ) || |
|
118
|
|
|
|
|
|
|
# $self->{ 'query' } = $query; |
|
119
|
|
|
|
|
|
|
# saving parameters to bind later on must have been done previously |
|
120
|
0
|
|
0
|
|
|
|
my $sth = $self->_cache_this( $query ) || |
|
121
|
|
|
|
|
|
|
return( $self->error( "Error while preparing new ignored query:\n$query" ) ); |
|
122
|
0
|
0
|
|
|
|
|
if( !defined( wantarray() ) ) |
|
123
|
|
|
|
|
|
|
{ |
|
124
|
0
|
0
|
|
|
|
|
$sth->execute() || |
|
125
|
|
|
|
|
|
|
return( $self->error( "Error while executing new ignored query:\n$query" ) ); |
|
126
|
|
|
|
|
|
|
} |
|
127
|
0
|
|
|
|
|
|
return( $sth ); |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub dump |
|
131
|
|
|
|
|
|
|
{ |
|
132
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
133
|
0
|
|
|
|
|
|
my $file = shift( @_ ); |
|
134
|
0
|
0
|
|
|
|
|
if( $file ) |
|
|
|
0
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
{ |
|
136
|
|
|
|
|
|
|
# Used to be handled by SQL server |
|
137
|
|
|
|
|
|
|
# my $query = $self->as_string(); |
|
138
|
|
|
|
|
|
|
# $query =~ s/(\s+FROM\s+)/ INTO OUTFILE '$file'$1/; |
|
139
|
|
|
|
|
|
|
# my $sth = $self->prepare( $query ) || |
|
140
|
|
|
|
|
|
|
# return( $self->error( "Error while preparing query to dump result on select:\n$query" ) ); |
|
141
|
|
|
|
|
|
|
# $sth->execute() || |
|
142
|
|
|
|
|
|
|
# return( $self->error( "Error while executing query to dump result on select:\n$query" ) ); |
|
143
|
0
|
0
|
|
|
|
|
$self->_load_class( 'DateTime' ) || return( $self->pass_error ); |
|
144
|
0
|
|
|
|
|
|
my $fields = $self->{_fields}; |
|
145
|
0
|
|
|
|
|
|
my @header = sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ); |
|
|
0
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# new_file is inherited from Module::Generic |
|
147
|
0
|
|
|
|
|
|
$file = $self->new_file( $file ); |
|
148
|
0
|
|
0
|
|
|
|
my $io = $file->open( '>', { binmode => 'utf8' }) || |
|
149
|
|
|
|
|
|
|
return( $self->error( "Unable to open file '$file' in write mode: ", $file->error ) ); |
|
150
|
0
|
|
|
|
|
|
my $date = DateTime->now; |
|
151
|
0
|
|
|
|
|
|
my $table = $self->{table}; |
|
152
|
0
|
|
|
|
|
|
$io->printf( "## Generated on %s for table $table\n", $date->strftime( '%c' ) ); |
|
153
|
0
|
|
|
|
|
|
$io->print( "## ", CORE::join( "\t", @header ), "\n" ); |
|
154
|
0
|
|
|
|
|
|
my @data = (); |
|
155
|
0
|
|
|
|
|
|
while( @data = $self->fetchrow() ) |
|
156
|
|
|
|
|
|
|
{ |
|
157
|
0
|
|
|
|
|
|
print( $io CORE::join( "\t", @data ), "\n" ); |
|
158
|
|
|
|
|
|
|
} |
|
159
|
0
|
|
|
|
|
|
$io->close; |
|
160
|
0
|
|
|
|
|
|
$self->finish; |
|
161
|
0
|
|
|
|
|
|
return( $self ); |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
elsif( exists( $self->{sth} ) ) |
|
164
|
|
|
|
|
|
|
{ |
|
165
|
|
|
|
|
|
|
# my $fields = $self->{ '_fields' }; |
|
166
|
0
|
|
|
|
|
|
my @fields = @{ $self->{sth}->FETCH( 'NAME' ) }; |
|
|
0
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
my $max = 0; |
|
168
|
|
|
|
|
|
|
# foreach my $field ( keys( %$fields ) ) |
|
169
|
0
|
|
|
|
|
|
foreach my $field ( @fields ) |
|
170
|
|
|
|
|
|
|
{ |
|
171
|
0
|
0
|
|
|
|
|
$max = length( $field ) if( length( $field ) > $max ); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
0
|
|
|
|
|
|
my $template = ''; |
|
174
|
|
|
|
|
|
|
## foreach my $field ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) ) |
|
175
|
0
|
|
|
|
|
|
foreach my $field ( @fields ) |
|
176
|
|
|
|
|
|
|
{ |
|
177
|
0
|
|
|
|
|
|
$template .= "$field" . ( '.' x ( $max - length( $field ) ) ) . ": %s\n"; |
|
178
|
|
|
|
|
|
|
} |
|
179
|
0
|
|
|
|
|
|
$template .= "\n"; |
|
180
|
0
|
|
|
|
|
|
my @data = (); |
|
181
|
0
|
|
|
|
|
|
while( @data = $self->fetchrow() ) |
|
182
|
|
|
|
|
|
|
{ |
|
183
|
0
|
|
|
|
|
|
printf( STDERR $template, @data ); |
|
184
|
|
|
|
|
|
|
} |
|
185
|
0
|
|
|
|
|
|
$self->finish; |
|
186
|
0
|
|
|
|
|
|
return( $self ); |
|
187
|
|
|
|
|
|
|
} |
|
188
|
|
|
|
|
|
|
else |
|
189
|
|
|
|
|
|
|
{ |
|
190
|
0
|
|
|
|
|
|
return( $self->error( "No query to dump." ) ); |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
|
|
194
|
0
|
|
|
0
|
1
|
|
sub exec { return( shift->execute( @_ ) ); } |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub execute |
|
197
|
|
|
|
|
|
|
{ |
|
198
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
199
|
0
|
|
|
|
|
|
my( $pack, $file, $line ) = caller(); |
|
200
|
0
|
|
|
|
|
|
my $sub = ( caller(1) )[3]; |
|
201
|
|
|
|
|
|
|
# What we want is to get the point from where we were originatly called |
|
202
|
0
|
0
|
|
|
|
|
if( $pack =~ /^DB::Object/ ) |
|
203
|
|
|
|
|
|
|
{ |
|
204
|
0
|
|
|
|
|
|
for( my $i = 1; $i < 5; $i++ ) |
|
205
|
|
|
|
|
|
|
{ |
|
206
|
0
|
|
|
|
|
|
( $pack, $file, $line ) = caller( $i ); |
|
207
|
0
|
|
|
|
|
|
$sub = ( caller( $i + 1 ) )[3]; |
|
208
|
0
|
0
|
|
|
|
|
last if( $pack !~ /^DB::Object/ ); |
|
209
|
|
|
|
|
|
|
} |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
# my $sub = ( caller( 1 ) )[ 3 ]; |
|
212
|
0
|
|
|
|
|
|
$self->{pack} = $pack; |
|
213
|
0
|
|
|
|
|
|
$self->{file} = $file; |
|
214
|
0
|
|
|
|
|
|
$self->{line} = $line; |
|
215
|
0
|
|
|
|
|
|
$self->{sub} = $sub; |
|
216
|
0
|
|
|
|
|
|
$self->{executed}++; |
|
217
|
0
|
|
|
|
|
|
my $q = $self->query_object; |
|
218
|
0
|
0
|
|
|
|
|
$q->final(1) if( $q ); |
|
219
|
0
|
|
|
|
|
|
my @binded = (); |
|
220
|
0
|
|
|
|
|
|
my @binded_types = (); |
|
221
|
0
|
0
|
0
|
|
|
|
if( $q && $q->binded_types->length ) |
|
222
|
|
|
|
|
|
|
{ |
|
223
|
0
|
|
|
|
|
|
my $types = $q->binded_types_as_param; |
|
224
|
0
|
|
|
|
|
|
@binded_types = @$types; |
|
225
|
|
|
|
|
|
|
} |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# if( $q && ( $self->{bind} || |
|
228
|
|
|
|
|
|
|
# ( |
|
229
|
|
|
|
|
|
|
# ( $q->_query_type eq 'insert' || $q->_query_type eq 'update' ) && |
|
230
|
|
|
|
|
|
|
# $q->binded_types->length ) |
|
231
|
|
|
|
|
|
|
# ) ) |
|
232
|
0
|
0
|
0
|
|
|
|
if( $q && $self->{bind} ) |
|
233
|
|
|
|
|
|
|
{ |
|
234
|
|
|
|
|
|
|
# if( @_ && ( $self->_is_hash( $_[0] ) ) ) |
|
235
|
0
|
0
|
0
|
|
|
|
if( @_ && |
|
|
|
0
|
0
|
|
|
|
|
|
236
|
|
|
|
|
|
|
( |
|
237
|
|
|
|
|
|
|
# hash reference |
|
238
|
|
|
|
|
|
|
( @_ == 1 && $self->_is_hash( $_[0] ) ) || |
|
239
|
|
|
|
|
|
|
# key => value pairs |
|
240
|
|
|
|
|
|
|
( !( @_ % 2 ) && ref( $_[0] ) ne 'HASH' ) |
|
241
|
|
|
|
|
|
|
) |
|
242
|
|
|
|
|
|
|
) |
|
243
|
|
|
|
|
|
|
{ |
|
244
|
0
|
|
|
|
|
|
my $vals = {}; |
|
245
|
0
|
0
|
|
|
|
|
if( $self->_is_hash( $_[0] ) ) |
|
246
|
|
|
|
|
|
|
{ |
|
247
|
0
|
|
|
|
|
|
$vals = shift( @_ ); |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
else |
|
250
|
|
|
|
|
|
|
{ |
|
251
|
0
|
|
|
|
|
|
$vals = { @_ }; |
|
252
|
|
|
|
|
|
|
} |
|
253
|
|
|
|
|
|
|
# This is the list of fields as they appear in the order in insert or update query |
|
254
|
|
|
|
|
|
|
# Knowing their order of appearance is key so we can bind follow-on values to them |
|
255
|
0
|
|
|
|
|
|
my $sorted = $q->sorted; |
|
256
|
0
|
|
|
|
|
|
foreach my $f ( @$sorted ) |
|
257
|
|
|
|
|
|
|
{ |
|
258
|
0
|
0
|
|
|
|
|
if( !CORE::exists( $vals->{ $f } ) ) |
|
259
|
|
|
|
|
|
|
{ |
|
260
|
0
|
|
|
|
|
|
push( @binded, undef() ); |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
# The value may be defined or not, or may be zero length long |
|
263
|
|
|
|
|
|
|
else |
|
264
|
|
|
|
|
|
|
{ |
|
265
|
0
|
|
|
|
|
|
push( @binded, $vals->{ $f } ); |
|
266
|
|
|
|
|
|
|
} |
|
267
|
|
|
|
|
|
|
} |
|
268
|
|
|
|
|
|
|
} |
|
269
|
|
|
|
|
|
|
elsif( @_ ) |
|
270
|
|
|
|
|
|
|
{ |
|
271
|
0
|
|
|
|
|
|
push( @binded, @_ ); |
|
272
|
|
|
|
|
|
|
} |
|
273
|
|
|
|
|
|
|
else |
|
274
|
|
|
|
|
|
|
{ |
|
275
|
0
|
|
|
|
|
|
my $binded_values = $q->binded; |
|
276
|
0
|
0
|
|
|
|
|
push( @binded, @$binded_values ) if( scalar( @$binded_values ) ); |
|
277
|
|
|
|
|
|
|
} |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
|
|
280
|
0
|
0
|
0
|
|
|
|
@binded = @_ if( ( !@binded && @_ ) || @_ ); |
|
|
|
|
0
|
|
|
|
|
|
281
|
0
|
0
|
|
|
|
|
@binded = () if( !@binded ); |
|
282
|
0
|
0
|
0
|
|
|
|
if( $q && $q->is_upsert ) |
|
283
|
|
|
|
|
|
|
{ |
|
284
|
0
|
0
|
|
|
|
|
if( scalar( @binded_types ) > scalar( @binded ) ) |
|
285
|
|
|
|
|
|
|
{ |
|
286
|
0
|
|
|
|
|
|
CORE::push( @binded, @binded ); |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
|
if( scalar( @_ ) ) |
|
291
|
|
|
|
|
|
|
{ |
|
292
|
0
|
|
|
|
|
|
my $temp = {}; |
|
293
|
0
|
|
|
|
|
|
for( my $i = 0; $i < scalar( @_ ); $i++ ) |
|
294
|
|
|
|
|
|
|
{ |
|
295
|
|
|
|
|
|
|
# { $some_value => 'varchar' } |
|
296
|
0
|
0
|
0
|
|
|
|
if( ref( $_[$i] ) eq 'HASH' && |
|
|
|
|
0
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
scalar( keys( %{$_[$i]} ) ) == 1 && |
|
298
|
|
|
|
|
|
|
# e.g. DBI::SQL_VARCHAR or DBI::SQL_INTEGER |
|
299
|
0
|
|
|
|
|
|
DBI->can( "SQL_" . uc( [values( %{$_[$i]} )]->[0] ) ) ) |
|
300
|
|
|
|
|
|
|
{ |
|
301
|
0
|
|
|
|
|
|
my $constant = DBI->can( "SQL_" . uc( [values( %{$_[$i]} )]->[0] ) ); |
|
|
0
|
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
$temp->{$i} = { type => $constant->(), value => [keys( %{$_[$i]} )]->[0] }; |
|
|
0
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# The user has chosen to override any datatype computed and be explicit. |
|
307
|
0
|
0
|
|
|
|
|
if( scalar( keys( %$temp ) ) == scalar( @_ ) ) |
|
|
|
0
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
{ |
|
309
|
0
|
|
|
|
|
|
@binded = @_; |
|
310
|
|
|
|
|
|
|
} |
|
311
|
|
|
|
|
|
|
elsif( scalar( keys( %$temp ) ) ) |
|
312
|
|
|
|
|
|
|
{ |
|
313
|
0
|
|
|
|
|
|
foreach my $i ( sort( keys( %$temp ) ) ) |
|
314
|
|
|
|
|
|
|
{ |
|
315
|
0
|
|
|
|
|
|
CORE::splice( @binded_types, $i, 0, $temp->{ $i }->{type} ); |
|
316
|
0
|
|
|
|
|
|
$binded[$i] = $temp->{ $i }->{value}; |
|
317
|
|
|
|
|
|
|
} |
|
318
|
|
|
|
|
|
|
} |
|
319
|
|
|
|
|
|
|
} |
|
320
|
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# $sth->exec({ $my_value => DBI::SQL_VARCHAR }); |
|
322
|
|
|
|
|
|
|
# for( my $i = 0; $i < scalar( @binded ); $i++ ) |
|
323
|
|
|
|
|
|
|
# { |
|
324
|
|
|
|
|
|
|
# # { $some_value => 'varchar' } |
|
325
|
|
|
|
|
|
|
# if( ref( $binded[$i] ) eq 'HASH' && |
|
326
|
|
|
|
|
|
|
# scalar( keys( %{$binded[$i]} ) ) == 1 && |
|
327
|
|
|
|
|
|
|
# # e.g. DBI::SQL_VARCHAR or DBI::SQL_INTEGER |
|
328
|
|
|
|
|
|
|
# DBI->can( "SQL_" . uc( [values( %{$binded[$i]} )]->[0] ) ) ) |
|
329
|
|
|
|
|
|
|
# { |
|
330
|
|
|
|
|
|
|
# my $constant = DBI->can( "SQL_" . uc( [values( %{$binded[$i]} )]->[0] ) ); |
|
331
|
|
|
|
|
|
|
# # Get the DBI SQL contant value and add it as a type |
|
332
|
|
|
|
|
|
|
# CORE::splice( @binded_types, $i, 0, $constant->() ); |
|
333
|
|
|
|
|
|
|
# # Replace our current value with the actual value |
|
334
|
|
|
|
|
|
|
# $binded[$i] = [keys( %{$binded[$i]} )]->[0]; |
|
335
|
|
|
|
|
|
|
# } |
|
336
|
|
|
|
|
|
|
# } |
|
337
|
|
|
|
|
|
|
|
|
338
|
0
|
0
|
0
|
|
|
|
if( $q && scalar( @binded ) != scalar( @binded_types ) ) |
|
339
|
|
|
|
|
|
|
{ |
|
340
|
0
|
|
|
|
|
|
warn( sprintf( "Warning: total %d bound values does not match the total %d bound types ('%s')! Check the code for query $self->{sth}->{Statement}...\n", scalar( @binded ), scalar( @binded_types ), CORE::join( "','", @binded_types ) ) ); |
|
341
|
|
|
|
|
|
|
# Cancel it, because it will create problems |
|
342
|
0
|
|
|
|
|
|
@binded_types = (); |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# If there are any array object of some sort provided, make sure they are transformed into a regular array so DBD::Ph can then transform it into a Postgres array. |
|
346
|
0
|
|
|
|
|
|
for( my $i = 0; $i < scalar( @binded ); $i++ ) |
|
347
|
|
|
|
|
|
|
{ |
|
348
|
0
|
0
|
|
|
|
|
next if( !defined( $binded[$i] ) ); |
|
349
|
0
|
0
|
0
|
|
|
|
if( $self->_is_array( $binded[$i] ) && |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
350
|
|
|
|
|
|
|
ref( $binded[$i] ) ne 'ARRAY' ) |
|
351
|
|
|
|
|
|
|
{ |
|
352
|
0
|
|
|
|
|
|
$binded[$i] = [@{$binded[$i]}]; |
|
|
0
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
} |
|
354
|
|
|
|
|
|
|
elsif( $self->_is_object( $binded[$i] ) && |
|
355
|
|
|
|
|
|
|
overload::Overloaded( $binded[$i] ) && |
|
356
|
|
|
|
|
|
|
overload::Method( $binded[$i], '""' ) ) |
|
357
|
|
|
|
|
|
|
{ |
|
358
|
1
|
|
|
1
|
|
9
|
no warnings 'uninitialized'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
5399
|
|
|
359
|
0
|
|
|
|
|
|
my $v = "$binded[$i]"; |
|
360
|
0
|
0
|
|
|
|
|
$binded[$i] = defined( $v ) ? $v : undef; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
# Will work well with Module::Generic::Hash |
|
363
|
|
|
|
|
|
|
elsif( $self->_is_hash( $binded[$i] ) && |
|
364
|
|
|
|
|
|
|
$self->_can( $binded[$i], 'as_json' ) ) |
|
365
|
|
|
|
|
|
|
{ |
|
366
|
0
|
|
|
|
|
|
$binded[$i] = $binded[$i]->as_json; |
|
367
|
|
|
|
|
|
|
} |
|
368
|
|
|
|
|
|
|
} |
|
369
|
|
|
|
|
|
|
|
|
370
|
0
|
|
|
|
|
|
local $_; |
|
371
|
|
|
|
|
|
|
my $rv = |
|
372
|
|
|
|
|
|
|
eval |
|
373
|
0
|
|
|
|
|
|
{ |
|
374
|
|
|
|
|
|
|
#local( $SIG{__DIE__} ) = sub{ }; |
|
375
|
|
|
|
|
|
|
#local( $SIG{__WARN__} ) = sub{ }; |
|
376
|
0
|
|
|
0
|
|
|
local( $SIG{ALRM} ) = sub{ die( "Timeout while processing query $self->{sth}->{Statement}\n" ) }; |
|
|
0
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# print( STDERR ref( $self ) . "::execute(): binding parameters '", join( ', ', @$binded ), "' to query:\n$self->{ 'query' }\n" ); |
|
378
|
|
|
|
|
|
|
# $self->{ 'sth' }->execute( @binded ); |
|
379
|
0
|
|
|
|
|
|
for( my $i = 0; $i < scalar( @binded ); $i++ ) |
|
380
|
|
|
|
|
|
|
{ |
|
381
|
|
|
|
|
|
|
# Stringify the binded value if it is a stringifyable object. |
|
382
|
0
|
0
|
0
|
|
|
|
if( ref( $binded[$i] ) && |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
383
|
|
|
|
|
|
|
$self->_is_object( $binded[$i] ) && |
|
384
|
|
|
|
|
|
|
overload::Overloaded( $binded[$i] ) && |
|
385
|
|
|
|
|
|
|
overload::Method( $binded[$i], '""' ) ) |
|
386
|
|
|
|
|
|
|
{ |
|
387
|
0
|
|
|
|
|
|
$binded[$i] .= ''; |
|
388
|
|
|
|
|
|
|
} |
|
389
|
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
my $data_type = $binded_types[ $i ]; |
|
391
|
0
|
0
|
0
|
|
|
|
if( CORE::length( $data_type ) && $self->_is_hash( $data_type ) ) |
|
392
|
|
|
|
|
|
|
{ |
|
393
|
0
|
|
|
|
|
|
$self->{sth}->bind_param( $i + 1, $binded[ $i ], $data_type ); |
|
394
|
|
|
|
|
|
|
} |
|
395
|
|
|
|
|
|
|
else |
|
396
|
|
|
|
|
|
|
{ |
|
397
|
0
|
|
|
|
|
|
$self->{sth}->bind_param( $i + 1, $binded[ $i ] ); |
|
398
|
|
|
|
|
|
|
} |
|
399
|
|
|
|
|
|
|
} |
|
400
|
0
|
|
|
|
|
|
$self->{sth}->execute(); |
|
401
|
|
|
|
|
|
|
}; |
|
402
|
0
|
|
|
|
|
|
my $error = $@; |
|
403
|
0
|
0
|
0
|
|
|
|
$error ||= $self->{sth}->errstr if( !$rv ); |
|
404
|
0
|
0
|
|
|
|
|
if( $q ) |
|
405
|
|
|
|
|
|
|
{ |
|
406
|
0
|
0
|
|
|
|
|
if( $q->join_tables->length > 0 ) |
|
407
|
|
|
|
|
|
|
{ |
|
408
|
|
|
|
|
|
|
$q->join_tables->foreach(sub{ |
|
409
|
0
|
|
|
0
|
|
|
my $tbl = shift( @_ ); |
|
410
|
0
|
0
|
0
|
|
|
|
return if( !$tbl || !ref( $tbl ) ); |
|
411
|
0
|
|
|
|
|
|
$tbl->reset; |
|
412
|
0
|
|
|
|
|
|
}); |
|
413
|
|
|
|
|
|
|
} |
|
414
|
0
|
|
|
|
|
|
$q->table_object->reset; |
|
415
|
|
|
|
|
|
|
} |
|
416
|
0
|
|
0
|
|
|
|
my $tie = $self->{tie} || {}; |
|
417
|
|
|
|
|
|
|
# Maybe it is time to bind SQL result to possible provided perl variables? |
|
418
|
0
|
0
|
0
|
|
|
|
if( !$error && %$tie ) |
|
419
|
|
|
|
|
|
|
{ |
|
420
|
0
|
|
|
|
|
|
my $order = $self->{tie_order}; |
|
421
|
0
|
|
|
|
|
|
my $sth = $self->{sth}; |
|
422
|
0
|
|
|
|
|
|
for( my $i = 0; $i < @$order; $i++ ) |
|
423
|
|
|
|
|
|
|
{ |
|
424
|
0
|
|
|
|
|
|
my $pos = $i + 1; |
|
425
|
0
|
|
|
|
|
|
my $val = $order->[ $i ]; |
|
426
|
0
|
0
|
0
|
|
|
|
if( exists( $tie->{ $val } ) && ref( $tie->{ $val } ) eq 'SCALAR' ) |
|
427
|
|
|
|
|
|
|
{ |
|
428
|
0
|
|
|
|
|
|
$sth->bind_col( $pos, $tie->{ $val } ); |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
} |
|
432
|
0
|
0
|
|
|
|
|
if( $error ) |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
{ |
|
434
|
0
|
|
|
|
|
|
$error =~ s/ at (\S+\s)?line \d+.*$//s; |
|
435
|
|
|
|
|
|
|
# $err .= ":\n\"$self->{ 'query' }\""; |
|
436
|
0
|
|
|
|
|
|
$error .= ":\n\"$self->{sth}->{Statement}\""; |
|
437
|
0
|
|
|
|
|
|
$error = "Error while trying to execute query $self->{sth}->{Statement}: $error"; |
|
438
|
0
|
0
|
|
|
|
|
if( $self->fatal() ) |
|
439
|
|
|
|
|
|
|
{ |
|
440
|
0
|
|
|
|
|
|
die( "$error in $self->{file} at line $self->{line} within sub $self->{sub}\n" ); |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
else |
|
443
|
|
|
|
|
|
|
{ |
|
444
|
|
|
|
|
|
|
# return( $self->error( "$err in $self->{ 'file' } at line $self->{ 'line' } within sub $self->{ 'sub' }" ) ); |
|
445
|
0
|
|
|
|
|
|
return( $self->error( $error ) ); |
|
446
|
|
|
|
|
|
|
} |
|
447
|
|
|
|
|
|
|
} |
|
448
|
|
|
|
|
|
|
elsif( $self->{sth}->errstr() ) |
|
449
|
|
|
|
|
|
|
{ |
|
450
|
0
|
|
|
|
|
|
return( $self->error( "Error while trying to execute query $self->{sth}->{Statement}: ", $self->{sth}->errstr ) ); |
|
451
|
|
|
|
|
|
|
} |
|
452
|
|
|
|
|
|
|
# User wants an object for chaining like: |
|
453
|
|
|
|
|
|
|
# $sth->exec( 'some value' )->fetchrow; |
|
454
|
|
|
|
|
|
|
elsif( want( 'OBJECT' ) ) |
|
455
|
|
|
|
|
|
|
{ |
|
456
|
0
|
|
|
|
|
|
return( $self ); |
|
457
|
|
|
|
|
|
|
} |
|
458
|
|
|
|
|
|
|
elsif( $rv ) |
|
459
|
|
|
|
|
|
|
{ |
|
460
|
0
|
|
|
|
|
|
return( $rv ); |
|
461
|
|
|
|
|
|
|
} |
|
462
|
|
|
|
|
|
|
# For void context too |
|
463
|
|
|
|
|
|
|
else |
|
464
|
|
|
|
|
|
|
{ |
|
465
|
0
|
|
|
|
|
|
return(1); |
|
466
|
|
|
|
|
|
|
} |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub executed |
|
470
|
|
|
|
|
|
|
{ |
|
471
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
472
|
|
|
|
|
|
|
# For hand made query to avoid clash when executing generic routine such as fetchall_arrayref... |
|
473
|
0
|
0
|
|
|
|
|
return( 1 ) if( !exists( $self->{query} ) ); |
|
474
|
0
|
|
0
|
|
|
|
return( exists( $self->{executed} ) && $self->{executed} ); |
|
475
|
|
|
|
|
|
|
} |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub fetchall_arrayref($@) |
|
478
|
|
|
|
|
|
|
{ |
|
479
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
480
|
0
|
|
0
|
|
|
|
my $slice = shift( @_ ) || []; |
|
481
|
0
|
|
|
|
|
|
my $dbo = $self->database_object; |
|
482
|
0
|
|
|
|
|
|
my $sth = $self->{sth}; |
|
483
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
484
|
|
|
|
|
|
|
{ |
|
485
|
0
|
0
|
|
|
|
|
$self->execute() || return; |
|
486
|
|
|
|
|
|
|
} |
|
487
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
488
|
0
|
|
|
|
|
|
my $mode = ref( $slice ); |
|
489
|
0
|
|
|
|
|
|
my @rows; |
|
490
|
|
|
|
|
|
|
my $row; |
|
491
|
0
|
0
|
|
|
|
|
if( $mode eq 'ARRAY' ) |
|
|
|
0
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
{ |
|
493
|
0
|
0
|
|
|
|
|
if( @$slice ) |
|
494
|
|
|
|
|
|
|
{ |
|
495
|
0
|
|
|
|
|
|
push( @rows, [ @{ $row }[ @{ $slice } ] ] ) while( $row = $self->{sth}->fetch() ); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
else |
|
498
|
|
|
|
|
|
|
{ |
|
499
|
0
|
|
|
|
|
|
push( @rows, [ @{ $row } ] ) while( $row = $self->{sth}->fetch ); |
|
|
0
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
} |
|
502
|
|
|
|
|
|
|
elsif( $mode eq 'HASH' ) |
|
503
|
|
|
|
|
|
|
{ |
|
504
|
0
|
|
|
|
|
|
my @o_keys = keys( %$slice ); |
|
505
|
0
|
0
|
|
|
|
|
if( @o_keys ) |
|
506
|
|
|
|
|
|
|
{ |
|
507
|
0
|
|
|
|
|
|
my %i_names = map{ ( lc( $_ ) => $_ ) } @{ $self->{sth}->FETCH( 'NAME' ) }; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
508
|
0
|
|
|
|
|
|
my @i_keys = map{ $i_names{ lc( $_ ) } } @o_keys; |
|
|
0
|
|
|
|
|
|
|
|
509
|
0
|
|
|
|
|
|
while( $row = $self->{sth}->fetchrow_hashref() ) |
|
510
|
|
|
|
|
|
|
{ |
|
511
|
0
|
|
|
|
|
|
my %hash; |
|
512
|
0
|
|
|
|
|
|
@hash{ @o_keys } = @{ $row }{ @i_keys }; |
|
|
0
|
|
|
|
|
|
|
|
513
|
0
|
|
|
|
|
|
push( @rows, \%hash ); |
|
514
|
|
|
|
|
|
|
} |
|
515
|
|
|
|
|
|
|
} |
|
516
|
|
|
|
|
|
|
else |
|
517
|
|
|
|
|
|
|
{ |
|
518
|
0
|
|
|
|
|
|
push( @rows, $row ) while( $row = $self->{sth}->fetchrow_hashref() ); |
|
519
|
|
|
|
|
|
|
} |
|
520
|
|
|
|
|
|
|
} |
|
521
|
|
|
|
|
|
|
else |
|
522
|
|
|
|
|
|
|
{ |
|
523
|
0
|
|
|
|
|
|
warn( "fetchall_arrayref($mode) invalid" ); |
|
524
|
|
|
|
|
|
|
} |
|
525
|
|
|
|
|
|
|
# return( \@rows ); |
|
526
|
0
|
0
|
0
|
|
|
|
return( \@rows ) if( !$dbo->auto_decode_json && !$dbo->auto_convert_datetime_to_object ); |
|
527
|
0
|
|
|
|
|
|
my $data = \@rows; |
|
528
|
0
|
0
|
|
|
|
|
$data = $self->_convert_json2hash({ statement => $sth, data => $data }) if( $dbo->auto_decode_json ); |
|
529
|
0
|
0
|
|
|
|
|
$data = $self->_convert_datetime2object({ statement => $sth, data => $data }) if( $dbo->auto_convert_datetime_to_object ); |
|
530
|
0
|
|
|
|
|
|
return( $data ); |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub fetchcol($;$) |
|
534
|
|
|
|
|
|
|
{ |
|
535
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
536
|
|
|
|
|
|
|
# @arr = $sth->fetchcol( $col_number ); |
|
537
|
0
|
|
|
|
|
|
my $col_num = shift( @_ ); |
|
538
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
539
|
|
|
|
|
|
|
{ |
|
540
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
541
|
|
|
|
|
|
|
} |
|
542
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
543
|
|
|
|
|
|
|
# return( $h->fetchcol( $COL_NUM ) ); |
|
544
|
0
|
|
|
|
|
|
my @col; |
|
545
|
|
|
|
|
|
|
# $self->dataseek( 0 ); |
|
546
|
|
|
|
|
|
|
my $ref; |
|
547
|
0
|
|
|
|
|
|
while( $ref = $self->{sth}->fetchrow_arrayref() ) |
|
548
|
|
|
|
|
|
|
{ |
|
549
|
0
|
|
|
|
|
|
push( @col, $ref->[ $col_num ] ); |
|
550
|
|
|
|
|
|
|
} |
|
551
|
0
|
|
|
|
|
|
return( @col ); |
|
552
|
|
|
|
|
|
|
} |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub fetchhash(@) |
|
555
|
|
|
|
|
|
|
{ |
|
556
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
557
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
558
|
|
|
|
|
|
|
{ |
|
559
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
562
|
|
|
|
|
|
|
# %hash = $sth->fetchhash; |
|
563
|
|
|
|
|
|
|
# return( $h->fetchhash ); |
|
564
|
0
|
|
|
|
|
|
my $ref = $self->{sth}->fetchrow_hashref(); |
|
565
|
0
|
0
|
|
|
|
|
if( $ref ) |
|
566
|
|
|
|
|
|
|
{ |
|
567
|
0
|
|
|
|
|
|
return( %$ref ); |
|
568
|
|
|
|
|
|
|
} |
|
569
|
|
|
|
|
|
|
else |
|
570
|
|
|
|
|
|
|
{ |
|
571
|
0
|
|
|
|
|
|
return( () ); |
|
572
|
|
|
|
|
|
|
} |
|
573
|
|
|
|
|
|
|
} |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
sub fetchrow(@) |
|
576
|
|
|
|
|
|
|
{ |
|
577
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
578
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
579
|
|
|
|
|
|
|
{ |
|
580
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
583
|
|
|
|
|
|
|
# @arr = $sth->fetchrow; # Array context |
|
584
|
|
|
|
|
|
|
# $firstcol = $sth->fetchrow; # Scalar context |
|
585
|
|
|
|
|
|
|
# return( $h->fetchrow ); |
|
586
|
|
|
|
|
|
|
# my $ref = $self->fetchrow_arrayref(); |
|
587
|
0
|
|
|
|
|
|
my $ref = $self->{sth}->fetchrow_arrayref(); |
|
588
|
|
|
|
|
|
|
# my $ref = $self->{sth}->fetch(); |
|
589
|
0
|
0
|
|
|
|
|
if( $ref ) |
|
590
|
|
|
|
|
|
|
{ |
|
591
|
0
|
0
|
|
|
|
|
return( wantarray ? @$ref : $ref->[0] ); |
|
592
|
|
|
|
|
|
|
} |
|
593
|
|
|
|
|
|
|
else |
|
594
|
|
|
|
|
|
|
{ |
|
595
|
0
|
|
|
|
|
|
return( () ); |
|
596
|
|
|
|
|
|
|
} |
|
597
|
|
|
|
|
|
|
} |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# sub fetchrow_hashref(@) is inherited from DBI |
|
600
|
|
|
|
|
|
|
sub fetchrow_hashref |
|
601
|
|
|
|
|
|
|
{ |
|
602
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
603
|
0
|
|
|
|
|
|
my $dbo = $self->database_object; |
|
604
|
0
|
|
|
|
|
|
my $deb = {}; |
|
605
|
0
|
|
|
|
|
|
%$deb = %$self; |
|
606
|
0
|
|
|
|
|
|
my $sth = $self->{sth}; |
|
607
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
608
|
|
|
|
|
|
|
{ |
|
609
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
610
|
|
|
|
|
|
|
} |
|
611
|
0
|
0
|
0
|
|
|
|
return( $sth->fetchrow_hashref ) if( !$dbo->auto_decode_json && !$dbo->auto_convert_datetime_to_object ); |
|
612
|
0
|
|
|
|
|
|
my $ref = $sth->fetchrow_hashref; |
|
613
|
|
|
|
|
|
|
# Convert json to hash for the relevant fields |
|
614
|
|
|
|
|
|
|
# return( $self->_convert_json2hash( $ref ) ); |
|
615
|
0
|
0
|
|
|
|
|
$ref = $self->_convert_json2hash({ statement => $sth, data => $ref }) if( $dbo->auto_decode_json ); |
|
616
|
0
|
0
|
|
|
|
|
$ref = $self->_convert_datetime2object({ statement => $sth, data => $ref }) if( $dbo->auto_convert_datetime_to_object ); |
|
617
|
0
|
|
|
|
|
|
return( $ref ); |
|
618
|
|
|
|
|
|
|
} |
|
619
|
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
sub fetchrow_object |
|
621
|
|
|
|
|
|
|
{ |
|
622
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
623
|
|
|
|
|
|
|
# This should give us something like Postgres or Mysql or SQLite |
|
624
|
0
|
|
|
|
|
|
my $basePack = ( ref( $self ) =~ /^DB::Object::([^\:]+)/ )[0]; |
|
625
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
626
|
|
|
|
|
|
|
{ |
|
627
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
628
|
|
|
|
|
|
|
} |
|
629
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
630
|
0
|
|
|
|
|
|
my $rows = $self->{sth}->rows; |
|
631
|
0
|
|
|
|
|
|
my $ref = $self->{sth}->fetchrow_hashref(); |
|
632
|
0
|
0
|
0
|
|
|
|
if( $ref && scalar( keys( %$ref ) ) ) |
|
633
|
|
|
|
|
|
|
{ |
|
634
|
0
|
|
|
|
|
|
my $struct = { map{ $_ => '$' } keys( %$ref ) }; |
|
|
0
|
|
|
|
|
|
|
|
635
|
0
|
|
|
|
|
|
my $table = $self->table; |
|
636
|
0
|
|
|
|
|
|
my $class = "DB::Object::${basePack}::Result::${table}"; |
|
637
|
0
|
0
|
|
|
|
|
if( !defined( &{ $class . '::new' } ) ) |
|
|
0
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
{ |
|
639
|
0
|
|
|
|
|
|
struct $class => $struct; |
|
640
|
|
|
|
|
|
|
} |
|
641
|
0
|
|
|
|
|
|
my $obj = $class->new( %$ref ); |
|
642
|
0
|
|
|
|
|
|
return( $obj ); |
|
643
|
|
|
|
|
|
|
} |
|
644
|
|
|
|
|
|
|
else |
|
645
|
|
|
|
|
|
|
{ |
|
646
|
0
|
|
|
|
|
|
return( () ); |
|
647
|
|
|
|
|
|
|
} |
|
648
|
|
|
|
|
|
|
} |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub finish |
|
651
|
|
|
|
|
|
|
{ |
|
652
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
653
|
0
|
|
|
|
|
|
my $rc = $self->{sth}->finish(); |
|
654
|
0
|
0
|
|
|
|
|
if( !$rc ) |
|
655
|
|
|
|
|
|
|
{ |
|
656
|
0
|
|
|
|
|
|
return( $self->error( $self->{sth}->errstr() ) ); |
|
657
|
|
|
|
|
|
|
} |
|
658
|
|
|
|
|
|
|
else |
|
659
|
|
|
|
|
|
|
{ |
|
660
|
0
|
|
|
|
|
|
return( $rc ); |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
} |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
sub ignore |
|
665
|
|
|
|
|
|
|
{ |
|
666
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
667
|
|
|
|
|
|
|
my $query = $self->{query} || |
|
668
|
0
|
|
0
|
|
|
|
return( $self->error( "No query to set as to be ignored." ) ); |
|
669
|
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
|
my $type = uc( ( $query =~ /^\s*(\S+)\s+/ )[0] ); |
|
671
|
|
|
|
|
|
|
# ALTER for table alteration statements (DB::Object::Tables |
|
672
|
0
|
|
|
|
|
|
my @allowed = qw( INSERT UPDATE ALTER ); |
|
673
|
0
|
|
|
|
|
|
my $allowed = CORE::join( '|', @allowed ); |
|
674
|
0
|
0
|
|
|
|
|
if( !scalar( grep{ /^$type$/i } @allowed ) ) |
|
|
0
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
{ |
|
676
|
0
|
|
|
|
|
|
return( $self->error( "You may not flag statement of type \U$type\E to be ignored:\n$query" ) ); |
|
677
|
|
|
|
|
|
|
} |
|
678
|
|
|
|
|
|
|
# Incompatible. Do not bother going further |
|
679
|
0
|
0
|
|
|
|
|
return( $self ) if( $query =~ /^\s*(?:$allowed)\s+(?:DELAYED|LOW_PRIORITY|HIGH_PRIORITY)\s+/i ); |
|
680
|
0
|
0
|
0
|
|
|
|
return( $self ) if( $type eq 'ALTER' && $query !~ /^\s*$type\s+TABLE\s+/i ); |
|
681
|
|
|
|
|
|
|
|
|
682
|
0
|
|
|
|
|
|
$query =~ s/^(\s*)($allowed)(\s+)/$1$2 IGNORE /; |
|
683
|
|
|
|
|
|
|
# my $sth = $self->prepare( $query ) || |
|
684
|
|
|
|
|
|
|
# $self->{ 'query' } = $query; |
|
685
|
|
|
|
|
|
|
# saving parameters to bind later on must have been done previously |
|
686
|
0
|
|
0
|
|
|
|
my $sth = $self->_cache_this( $query ) || |
|
687
|
|
|
|
|
|
|
return( $self->error( "Error while preparing new ignored query:\n$query" ) ); |
|
688
|
0
|
0
|
|
|
|
|
if( !defined( wantarray() ) ) |
|
689
|
|
|
|
|
|
|
{ |
|
690
|
0
|
0
|
|
|
|
|
$sth->execute() || |
|
691
|
|
|
|
|
|
|
return( $self->error( "Error while executing new ignored query:\n$query" ) ); |
|
692
|
|
|
|
|
|
|
} |
|
693
|
0
|
|
|
|
|
|
return( $sth ); |
|
694
|
|
|
|
|
|
|
} |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub join |
|
697
|
|
|
|
|
|
|
{ |
|
698
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
699
|
0
|
|
|
|
|
|
my $data = shift( @_ ); |
|
700
|
0
|
|
|
|
|
|
my $on; |
|
701
|
0
|
0
|
|
|
|
|
if( @_ ) |
|
702
|
|
|
|
|
|
|
{ |
|
703
|
0
|
0
|
0
|
|
|
|
$on = ( scalar( @_ ) == 1 && ref( $_[0] ) ) ? shift( @_ ) : [ @_ ]; |
|
704
|
|
|
|
|
|
|
} |
|
705
|
0
|
|
0
|
|
|
|
my $q = $self->query_object || return( $self->error( "No query formatter object was set" ) ); |
|
706
|
0
|
|
0
|
|
|
|
my $tbl_o = $q->table_object || return( $self->error( "No table object is set in query object." ) ); |
|
707
|
0
|
|
0
|
|
|
|
my $query = $q->query || |
|
708
|
|
|
|
|
|
|
return( $self->error( "No query prepared for join with another table." ) ); |
|
709
|
0
|
0
|
|
|
|
|
if( $query !~ /^[[:blank:]]*SELECT[[:blank:]]+/i ) |
|
710
|
|
|
|
|
|
|
{ |
|
711
|
0
|
|
|
|
|
|
return( $self->error( "You may not perform a join on a query other than select." ) ); |
|
712
|
|
|
|
|
|
|
} |
|
713
|
0
|
|
|
|
|
|
my $constant = $q->constant; |
|
714
|
|
|
|
|
|
|
# Constant is set and query object marked as final, which means this statement has already been processed as a join and so we skip all further processing. |
|
715
|
0
|
0
|
0
|
|
|
|
if( scalar( keys( %$constant ) ) && $q->final ) |
|
716
|
|
|
|
|
|
|
{ |
|
717
|
0
|
|
|
|
|
|
return( $self ); |
|
718
|
|
|
|
|
|
|
} |
|
719
|
0
|
|
|
|
|
|
my $table = $tbl_o->table; |
|
720
|
0
|
|
|
|
|
|
my $db = $tbl_o->database(); |
|
721
|
0
|
|
|
|
|
|
my $multi_db = $tbl_o->prefix_database; |
|
722
|
0
|
|
|
|
|
|
my $alias = $tbl_o->as; |
|
723
|
0
|
|
|
|
|
|
my $new_fields = ''; |
|
724
|
0
|
|
|
|
|
|
my $new_table = ''; |
|
725
|
0
|
|
|
|
|
|
my $new_db = ''; |
|
726
|
0
|
|
|
|
|
|
my $class = ref( $self ); |
|
727
|
0
|
|
|
|
|
|
my $q2 = $q->clone; |
|
728
|
0
|
|
|
|
|
|
my $q1; |
|
729
|
0
|
0
|
|
|
|
|
$q2->join_tables( $tbl_o ) if( !$q2->join_tables->length ); |
|
730
|
|
|
|
|
|
|
# $data is a DB::Object::Postgres::Statement object - we get all its parameter and merge them with ours |
|
731
|
|
|
|
|
|
|
# if( ref( $data ) && ref( $data ) eq $class ) |
|
732
|
0
|
0
|
0
|
|
|
|
if( ref( $data ) && $self->_is_a( $data, $class ) ) |
|
733
|
|
|
|
|
|
|
{ |
|
734
|
0
|
|
|
|
|
|
$q1 = $data->query_object; |
|
735
|
|
|
|
|
|
|
} |
|
736
|
|
|
|
|
|
|
# $data is the table name |
|
737
|
|
|
|
|
|
|
else |
|
738
|
|
|
|
|
|
|
{ |
|
739
|
0
|
|
|
|
|
|
my $join_tbl; |
|
740
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $data ) && $data->isa( 'DB::Object::Tables' ) ) |
|
|
|
0
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
{ |
|
742
|
0
|
|
|
|
|
|
$join_tbl = $data; |
|
743
|
|
|
|
|
|
|
} |
|
744
|
|
|
|
|
|
|
elsif( $self->_is_object( $data ) ) |
|
745
|
|
|
|
|
|
|
{ |
|
746
|
0
|
|
|
|
|
|
return( $self->error( "I was expecting either a table name as a scalar or a table object, but instead got \"$data\" (", ref( $data ), ")." ) ); |
|
747
|
|
|
|
|
|
|
} |
|
748
|
|
|
|
|
|
|
else |
|
749
|
|
|
|
|
|
|
{ |
|
750
|
0
|
0
|
|
|
|
|
return( $self->error( "No such table \"$data\" exists in database \"$db\"." ) ) if( !$self->database_object->table_exists( $data ) ); |
|
751
|
0
|
|
|
|
|
|
$join_tbl = $self->database_object->table( $data ); |
|
752
|
0
|
0
|
|
|
|
|
return( $self->error( "Could not get a table object from \"$data\"." ) ) if( !$join_tbl ); |
|
753
|
|
|
|
|
|
|
} |
|
754
|
0
|
0
|
|
|
|
|
$join_tbl->prefixed( $db ne $join_tbl->database_object->database ? 3 : 1 ); |
|
755
|
0
|
|
0
|
|
|
|
my $sth_tmp = $join_tbl->select || return( $self->pass_error( $join_tbl->error ) ); |
|
756
|
0
|
|
0
|
|
|
|
$q1 = $sth_tmp->query_object || return( $self->error( "Could not get a query object out of the dummy select query I made from table \"$data\"." ) ); |
|
757
|
0
|
|
|
|
|
|
$new_fields = $q1->selected_fields; |
|
758
|
|
|
|
|
|
|
# NOTE: 2021-08-22: If we reset it here, we lose the table aliasing |
|
759
|
|
|
|
|
|
|
# $join_tbl->reset; |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
# $join_tbl->prefixed( $db ne $join_tbl->database_object->database ? 3 : 1 ) unless( $join_tbl->prefixed ); |
|
762
|
0
|
|
|
|
|
|
$new_table = $join_tbl->prefix; |
|
763
|
0
|
|
|
|
|
|
$join_tbl->reset; |
|
764
|
|
|
|
|
|
|
# We assume this table is part of our same database |
|
765
|
0
|
|
|
|
|
|
$new_db = $db; |
|
766
|
|
|
|
|
|
|
# my $db_data = $self->getdefault( $new_table ); |
|
767
|
|
|
|
|
|
|
# $new_fields = $db_data->format_statement(); |
|
768
|
0
|
|
|
|
|
|
$new_fields = ''; |
|
769
|
|
|
|
|
|
|
} |
|
770
|
|
|
|
|
|
|
# TODO: check this or remove it |
|
771
|
|
|
|
|
|
|
# $q1->table_object->prefixed( $db ne $q1->database_object->database ? 3 : 1 ); |
|
772
|
0
|
|
|
|
|
|
$new_fields = $q1->selected_fields; |
|
773
|
0
|
|
|
|
|
|
$new_table = $q1->table_object->name; |
|
774
|
|
|
|
|
|
|
# $new_table = $q1->table_object->prefix; |
|
775
|
0
|
|
|
|
|
|
$new_db = $q1->database_object->database; |
|
776
|
0
|
|
|
|
|
|
$q2->join_tables->push( $q1->table_object ); |
|
777
|
0
|
0
|
|
|
|
|
if( CORE::length( $q->where ) ) |
|
|
|
0
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
{ |
|
779
|
0
|
0
|
|
|
|
|
$q2->where( $self->AND( ( $q->where ), $q1->new_clause({ value => '( ' . ( $q1->where ) . ' )' }) ) ) if( CORE::length( $q1->where ) ); |
|
780
|
|
|
|
|
|
|
} |
|
781
|
|
|
|
|
|
|
elsif( CORE::length( $q1->where ) ) |
|
782
|
|
|
|
|
|
|
{ |
|
783
|
0
|
|
|
|
|
|
$q2->where( $q1->where ); |
|
784
|
|
|
|
|
|
|
} |
|
785
|
0
|
0
|
|
|
|
|
$q2->group( $q->group, $q1->group ) if( $q1->group->value->length ); |
|
786
|
0
|
0
|
|
|
|
|
$q2->order( $q->order, $q1->order ) if( $q1->order->value->length ); |
|
787
|
0
|
|
|
|
|
|
$q2->binded_where->push( @{$q1->binded_where} ); |
|
|
0
|
|
|
|
|
|
|
|
788
|
0
|
|
|
|
|
|
$q2->binded_group->push( @{$q1->binded_group} ); |
|
|
0
|
|
|
|
|
|
|
|
789
|
0
|
|
|
|
|
|
$q2->binded_order->push( @{$q1->binded_order} ); |
|
|
0
|
|
|
|
|
|
|
|
790
|
0
|
|
|
|
|
|
$q2->binded( @{$q1->binded} ); |
|
|
0
|
|
|
|
|
|
|
|
791
|
0
|
0
|
0
|
|
|
|
if( ( !$q->limit || !$q->_limit->length ) && $q2->_limit->length ) |
|
|
|
|
0
|
|
|
|
|
|
792
|
|
|
|
|
|
|
{ |
|
793
|
0
|
|
|
|
|
|
$q2->_limit( $q1->_limit ); |
|
794
|
0
|
|
|
|
|
|
$q2->binded_limit( $q1->binded_limit ); |
|
795
|
|
|
|
|
|
|
} |
|
796
|
0
|
0
|
|
|
|
|
my $prev_fields = length( $q->join_fields ) ? $q->join_fields : $q->selected_fields; |
|
797
|
|
|
|
|
|
|
# Regular express to prepend previous fields by their table name if that's not the case already |
|
798
|
|
|
|
|
|
|
# my $prev_prefix = $new_db ? "$db.$table" : $table; |
|
799
|
|
|
|
|
|
|
# my $prev_prefix = $tbl_o->query_object->table_alias ? $tbl_o->query_object->table_alias : $tbl_o->prefixed( $db ne $new_db ? 3 : 1 )->prefix; |
|
800
|
|
|
|
|
|
|
# unless( $tbl_o->query_object->table_alias ) |
|
801
|
|
|
|
|
|
|
# { |
|
802
|
|
|
|
|
|
|
# $tbl_o->prefixed( $db ne $new_db ? 3 : 1 ) |
|
803
|
|
|
|
|
|
|
# } |
|
804
|
0
|
0
|
|
|
|
|
$tbl_o->prefixed( $db ne $new_db ? 3 : 1 ); |
|
805
|
|
|
|
|
|
|
# Prefix for previous fields list |
|
806
|
0
|
|
|
|
|
|
my $prev_prefix = $tbl_o->prefix; |
|
807
|
0
|
|
|
|
|
|
my $prev_fields_hash = $q->table_object->fields; |
|
808
|
0
|
|
|
|
|
|
my $prev_fields_list = CORE::join( '|', sort( keys( %$prev_fields_hash ) ) ); |
|
809
|
0
|
|
|
|
|
|
my $re = qr/(?<![\.\"])\b($prev_fields_list)\b/; |
|
810
|
0
|
|
|
|
|
|
$prev_fields =~ s/(?<![\.\"])\b($prev_fields_list)\b/${prev_prefix}.$1/gs; |
|
811
|
0
|
0
|
|
|
|
|
my $fields = $new_fields ? CORE::join( ', ', $prev_fields, $new_fields ) : $prev_fields; |
|
812
|
0
|
|
|
|
|
|
$q2->join_fields( $fields ); |
|
813
|
|
|
|
|
|
|
#my $from_table = $q2->from_table; |
|
814
|
|
|
|
|
|
|
#$from_table = $multi_db ? [ "$db.$table" ] : [ $table ] if( !scalar( @$from_table ) ); |
|
815
|
|
|
|
|
|
|
# $q2->from_table( $multi_db ? "$db.$table" : $table ) if( !$q2->from_table->length ); |
|
816
|
0
|
0
|
|
|
|
|
$q2->from_table->push( |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
$q2->table_alias |
|
818
|
|
|
|
|
|
|
? sprintf( '%s AS %s', $q2->table_object->name, $q2->table_alias ) |
|
819
|
|
|
|
|
|
|
: ( $q2->table_object->prefixed ? $q2->table_object->prefix : $q2->table_object->name ) |
|
820
|
|
|
|
|
|
|
) if( !$q2->from_table->length ); |
|
821
|
|
|
|
|
|
|
# $q2->left_join( {} ) if( !$q2->left_join ); |
|
822
|
0
|
|
|
|
|
|
my $left_join = ''; |
|
823
|
0
|
|
|
|
|
|
my $condition = ''; |
|
824
|
0
|
|
|
|
|
|
my $format_condition; |
|
825
|
|
|
|
|
|
|
$format_condition = sub |
|
826
|
|
|
|
|
|
|
{ |
|
827
|
0
|
|
|
0
|
|
|
my @vals = (); |
|
828
|
0
|
|
|
|
|
|
my $vals = shift( @_ ); |
|
829
|
0
|
|
|
|
|
|
my $op = shift( @_ ); |
|
830
|
0
|
|
|
|
|
|
my @res = (); |
|
831
|
0
|
|
|
|
|
|
my $fields_tables = {}; |
|
832
|
0
|
|
|
|
|
|
while( scalar( @$vals ) ) |
|
833
|
|
|
|
|
|
|
{ |
|
834
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $vals->[0] ) && $vals->[0]->isa( 'DB::Object::Operator' ) ) |
|
835
|
|
|
|
|
|
|
{ |
|
836
|
0
|
|
|
|
|
|
my $sub_obj = shift( @$vals ); |
|
837
|
0
|
|
|
|
|
|
my $sub_op = $sub_obj->operator; |
|
838
|
0
|
|
|
|
|
|
my( @sub_vals ) = $sub_obj->value; |
|
839
|
0
|
|
|
|
|
|
my $this_ref = $format_condition->( \@sub_vals, $sub_op ); |
|
840
|
0
|
0
|
|
|
|
|
CORE::push( @res, $this_ref->{clause} ) if( length( $this_ref->{clause} ) ); |
|
841
|
0
|
|
|
|
|
|
my $tmp = $this_ref->{fields_tables}; |
|
842
|
0
|
|
|
|
|
|
my @those_table_names = keys( %$tmp ); |
|
843
|
0
|
|
|
|
|
|
@$fields_tables{ @those_table_names } = @$tmp{ @those_table_names }; |
|
844
|
|
|
|
|
|
|
} |
|
845
|
|
|
|
|
|
|
else |
|
846
|
|
|
|
|
|
|
{ |
|
847
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $vals->[0] ) && $vals->[0]->isa( 'DB::Object::Fields::Field::Overloaded' ) ) |
|
848
|
|
|
|
|
|
|
{ |
|
849
|
0
|
|
|
|
|
|
my $f1 = shift( @$vals ); |
|
850
|
0
|
0
|
|
|
|
|
$f1->field->prefixed( $multi_db ? 3 : 1 ); |
|
851
|
0
|
|
|
|
|
|
CORE::push( @res, "$f1" ); |
|
852
|
0
|
0
|
|
|
|
|
$fields_tables->{ $f1->field->table }++ if( !$fields_tables->{ $f1->field->table } ); |
|
853
|
0
|
|
|
|
|
|
next; |
|
854
|
|
|
|
|
|
|
} |
|
855
|
|
|
|
|
|
|
|
|
856
|
0
|
|
|
|
|
|
my( $f1, $f2 ) = ( shift( @$vals ), shift( @$vals ) ); |
|
857
|
0
|
|
|
|
|
|
my $i_am_negative = 0; |
|
858
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $f2 ) && $f2->isa( 'DB::Object::NOT' ) ) |
|
859
|
|
|
|
|
|
|
{ |
|
860
|
0
|
|
|
|
|
|
( $f2 ) = $f2->value; |
|
861
|
0
|
|
|
|
|
|
$i_am_negative++; |
|
862
|
|
|
|
|
|
|
} |
|
863
|
|
|
|
|
|
|
|
|
864
|
0
|
|
|
|
|
|
my( $field1, $field2 ); |
|
865
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $f1 ) && $f1->isa( 'DB::Object::Fields::Field' ) ) |
|
866
|
|
|
|
|
|
|
{ |
|
867
|
0
|
0
|
|
|
|
|
$f1->prefixed( $multi_db ? 3 : 1 ); |
|
868
|
0
|
|
|
|
|
|
$field1 = $f1->name; |
|
869
|
0
|
0
|
|
|
|
|
$fields_tables->{ $f1->table }++ if( !$fields_tables->{ $f1->table } ); |
|
870
|
|
|
|
|
|
|
} |
|
871
|
|
|
|
|
|
|
else |
|
872
|
|
|
|
|
|
|
{ |
|
873
|
0
|
0
|
|
|
|
|
$field1 = $multi_db ? "$new_db.$new_table.$f1" : "$new_table.$f1"; |
|
874
|
|
|
|
|
|
|
} |
|
875
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $f2 ) && $f2->isa( 'DB::Object::Fields::Field' ) ) |
|
876
|
|
|
|
|
|
|
{ |
|
877
|
0
|
0
|
|
|
|
|
$f2->prefixed( $multi_db ? 3 : 1 ); |
|
878
|
0
|
|
|
|
|
|
$field2 = $f2->name; |
|
879
|
0
|
0
|
|
|
|
|
$fields_tables->{ $f2->table }++ if( !$fields_tables->{ $f2->table } ); |
|
880
|
|
|
|
|
|
|
} |
|
881
|
|
|
|
|
|
|
else |
|
882
|
|
|
|
|
|
|
{ |
|
883
|
0
|
0
|
|
|
|
|
$field2 = $multi_db ? "$new_db.$new_table.$f2" : "$new_table.$f2"; |
|
884
|
|
|
|
|
|
|
} |
|
885
|
0
|
0
|
|
|
|
|
CORE::push( @res, $i_am_negative ? "$field1 != $field2" : "$field1 = $field2" ); |
|
886
|
|
|
|
|
|
|
} |
|
887
|
|
|
|
|
|
|
} |
|
888
|
|
|
|
|
|
|
return({ |
|
889
|
0
|
|
|
|
|
|
clause => CORE::join( $op, @res ), |
|
890
|
|
|
|
|
|
|
fields_tables => $fields_tables, |
|
891
|
|
|
|
|
|
|
}); |
|
892
|
0
|
|
|
|
|
|
}; |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
# $on is either a $dbh->AND, or $dbh->OR |
|
895
|
0
|
0
|
|
|
|
|
if( defined( $on ) ) |
|
896
|
|
|
|
|
|
|
{ |
|
897
|
0
|
0
|
0
|
|
|
|
if( $self->_is_object( $on ) && $on->isa( 'DB::Object::Operator' ) ) |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
{ |
|
899
|
0
|
|
|
|
|
|
my $op = $on->operator; |
|
900
|
0
|
|
|
|
|
|
my( @vals ) = $on->value; |
|
901
|
0
|
|
|
|
|
|
my $ret = $format_condition->( \@vals, $op ); |
|
902
|
0
|
0
|
|
|
|
|
my $as = $q1->table_alias ? sprintf( ' AS %s', $q1->table_alias ) : ''; |
|
903
|
0
|
|
|
|
|
|
$left_join = "LEFT JOIN ${new_table}${as} ON $ret->{clause}"; |
|
904
|
|
|
|
|
|
|
} |
|
905
|
|
|
|
|
|
|
elsif( $self->_is_object( $on ) && $on->isa( 'DB::Object::Fields::Field::Overloaded' ) ) |
|
906
|
|
|
|
|
|
|
{ |
|
907
|
0
|
0
|
|
|
|
|
my $as = $q1->table_alias ? sprintf( ' AS %s', $q1->table_alias ) : ''; |
|
908
|
0
|
|
|
|
|
|
$left_join = "LEFT JOIN ${new_table}${as} ON ${on}"; |
|
909
|
|
|
|
|
|
|
} |
|
910
|
|
|
|
|
|
|
elsif( $self->_is_array( $on ) ) |
|
911
|
|
|
|
|
|
|
{ |
|
912
|
0
|
|
|
|
|
|
my $ret = $format_condition->( $on, 'AND' ); |
|
913
|
0
|
0
|
|
|
|
|
my $as = $q1->table_alias ? sprintf( ' AS %s', $q1->table_alias ) : ''; |
|
914
|
0
|
|
|
|
|
|
$left_join = "LEFT JOIN ${new_table}${as} ON $ret->{clause}"; |
|
915
|
|
|
|
|
|
|
} |
|
916
|
|
|
|
|
|
|
# There is a second parameter - if so this is the condition of the 'LEFT JOIN' |
|
917
|
|
|
|
|
|
|
elsif( $self->_is_hash( $on ) ) |
|
918
|
|
|
|
|
|
|
{ |
|
919
|
|
|
|
|
|
|
# Previous join |
|
920
|
0
|
|
|
|
|
|
my $join_ref = $q2->left_join; |
|
921
|
0
|
|
|
|
|
|
my $def = { on => $on, table_object => $q1->table_object, query_object => $q1 }; |
|
922
|
|
|
|
|
|
|
## Add the current one |
|
923
|
0
|
0
|
|
|
|
|
if( $multi_db ) |
|
924
|
|
|
|
|
|
|
{ |
|
925
|
0
|
|
|
|
|
|
$join_ref->{ "$new_db.$new_table" } = $def; |
|
926
|
|
|
|
|
|
|
} |
|
927
|
|
|
|
|
|
|
else |
|
928
|
|
|
|
|
|
|
{ |
|
929
|
0
|
|
|
|
|
|
$join_ref->{ $new_table } = $def; |
|
930
|
|
|
|
|
|
|
} |
|
931
|
|
|
|
|
|
|
# (Re)build the LEFT JOIN ... ON ... definition |
|
932
|
0
|
|
|
|
|
|
my @join_data = (); |
|
933
|
0
|
|
|
|
|
|
foreach my $joined ( keys( %$join_ref ) ) |
|
934
|
|
|
|
|
|
|
{ |
|
935
|
0
|
|
|
|
|
|
my $condition = $join_ref->{ $joined }->{on}; |
|
936
|
0
|
|
|
|
|
|
my $to = $join_ref->{ $joined }->{table_object}; |
|
937
|
0
|
|
|
|
|
|
my $qo = $join_ref->{ $joined }->{query_object}; |
|
938
|
0
|
|
|
|
|
|
my $join_table_name = $to->prefix; |
|
939
|
0
|
|
|
|
|
|
my $join_table_alias = ''; |
|
940
|
0
|
0
|
|
|
|
|
if( length( $join_table_alias = $qo->table_alias ) ) |
|
941
|
|
|
|
|
|
|
{ |
|
942
|
0
|
|
|
|
|
|
$join_table_alias = " AS $join_table_alias"; |
|
943
|
|
|
|
|
|
|
} |
|
944
|
0
|
|
|
|
|
|
push( @join_data, "LEFT JOIN ${join_table_name}${join_table_alias} ON " . CORE::join( ' AND ', map{ "$_=$condition->{ $_ }" } keys( %$condition ) ) ); |
|
|
0
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} |
|
946
|
0
|
|
|
|
|
|
$left_join = CORE::join( ' ', @join_data ); |
|
947
|
|
|
|
|
|
|
} |
|
948
|
|
|
|
|
|
|
else |
|
949
|
|
|
|
|
|
|
{ |
|
950
|
0
|
|
|
|
|
|
warn( "Warning: I have no clue what to do with '$on' (", overload::StrVal( $on ), ") in this join for table \"", $q->table_object->name, "\"\n" ); |
|
951
|
|
|
|
|
|
|
} |
|
952
|
|
|
|
|
|
|
} |
|
953
|
|
|
|
|
|
|
# Otherwise, this is a straight JOIN |
|
954
|
|
|
|
|
|
|
else |
|
955
|
|
|
|
|
|
|
{ |
|
956
|
|
|
|
|
|
|
# $q2->from_table->push( $multi_db ? "$new_db.$new_table" : $new_table ); |
|
957
|
0
|
0
|
|
|
|
|
$q2->from_table->push( |
|
|
|
0
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
$q1->table_alias |
|
959
|
|
|
|
|
|
|
? sprintf( '%s AS %s', $q1->table_object->name, $q1->table_alias ) |
|
960
|
|
|
|
|
|
|
: ( $q1->table_object->prefixed ? $q1->table_object->prefix : $q1->table_object->name ) |
|
961
|
|
|
|
|
|
|
); |
|
962
|
|
|
|
|
|
|
} |
|
963
|
0
|
|
|
|
|
|
my $from = $q2->from_table->join( ', ' ); |
|
964
|
|
|
|
|
|
|
# $q2->from_table( $from_table ); |
|
965
|
0
|
|
|
|
|
|
my $clause = $q2->_query_components( 'select', { no_bind_copy => 1 } ); |
|
966
|
|
|
|
|
|
|
# You may not sort if there is no order clause |
|
967
|
|
|
|
|
|
|
# my $table_alias = ''; |
|
968
|
|
|
|
|
|
|
# if( length( $table_alias = $q2->table_alias ) ) |
|
969
|
|
|
|
|
|
|
# { |
|
970
|
|
|
|
|
|
|
# $table_alias = " AS ${table_alias}"; |
|
971
|
|
|
|
|
|
|
# } |
|
972
|
|
|
|
|
|
|
# my @query = ( "SELECT ${fields} FROM ${from}${table_alias} ${left_join}" ); |
|
973
|
0
|
|
|
|
|
|
my @query = ( "SELECT ${fields} FROM ${from} ${left_join}" ); |
|
974
|
0
|
0
|
|
|
|
|
push( @query, @$clause ) if( @$clause ); |
|
975
|
0
|
|
|
|
|
|
my $statement = CORE::join( ' ', @query ); |
|
976
|
0
|
|
|
|
|
|
$q2->query( $statement ); |
|
977
|
|
|
|
|
|
|
# my $sth = $self->prepare( $self->{ 'query' } ) || |
|
978
|
0
|
|
0
|
|
|
|
my $sth = $tbl_o->_cache_this( $q2 ) || |
|
979
|
|
|
|
|
|
|
return( $self->error( "Error while preparing query to select:\n", $q2->as_string(), $tbl_o->error ) ); |
|
980
|
|
|
|
|
|
|
# Routines such as as_string() expect an array on pupose so we do not have to commit the action |
|
981
|
|
|
|
|
|
|
# but rather get the statement string. At the end, we write: |
|
982
|
|
|
|
|
|
|
# $obj->select() to really select |
|
983
|
|
|
|
|
|
|
# $obj->select->as_string() to ONLY get the formatted statement |
|
984
|
|
|
|
|
|
|
# wantarray() returns the undefined value in void context, which is typical use of a real select command |
|
985
|
|
|
|
|
|
|
# i.e. $obj->select(); |
|
986
|
0
|
0
|
|
|
|
|
if( !defined( wantarray() ) ) |
|
987
|
|
|
|
|
|
|
{ |
|
988
|
0
|
0
|
|
|
|
|
$sth->execute() || |
|
989
|
|
|
|
|
|
|
return( $self->error( "Error while executing query to select:\n", $q2->as_string(), "\nError: ", $sth->error() ) ); |
|
990
|
|
|
|
|
|
|
} |
|
991
|
0
|
|
|
|
|
|
return( $sth ); |
|
992
|
|
|
|
|
|
|
} |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
sub object |
|
995
|
|
|
|
|
|
|
{ |
|
996
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
997
|
|
|
|
|
|
|
# This is intended for statement to fetched their object: |
|
998
|
|
|
|
|
|
|
# my $obj = $table->select( '*' )->object(); |
|
999
|
|
|
|
|
|
|
# my $obj = $table->select( '*' ) |
|
1000
|
|
|
|
|
|
|
# would merly execute the statement before returning its object, but there are conditions |
|
1001
|
|
|
|
|
|
|
# such like using a SELECT to create a table where we do not want the statement to be executed already |
|
1002
|
0
|
0
|
|
|
|
|
return( $self->{sth} ) if( $self->{sth} ); |
|
1003
|
|
|
|
|
|
|
# More sensible approach will return a special Module::Generic::Null object to avoid perl complaining of 'called on undef value' if this is used in chaining |
|
1004
|
0
|
0
|
|
|
|
|
return( Module::Generic::Null->new ) if( want( 'OBJECT' ) ); |
|
1005
|
0
|
|
|
|
|
|
return; |
|
1006
|
|
|
|
|
|
|
} |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
sub priority |
|
1009
|
|
|
|
|
|
|
{ |
|
1010
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
1011
|
0
|
|
|
|
|
|
my $prio = shift( @_ ); |
|
1012
|
0
|
|
|
|
|
|
my $map = |
|
1013
|
|
|
|
|
|
|
{ |
|
1014
|
|
|
|
|
|
|
0 => 'LOW_PRIORITY', |
|
1015
|
|
|
|
|
|
|
1 => 'HIGH_PRIORITY', |
|
1016
|
|
|
|
|
|
|
}; |
|
1017
|
|
|
|
|
|
|
## Bad argument. Do not bother |
|
1018
|
0
|
0
|
|
|
|
|
return( $self ) if( !exists( $map->{ $prio } ) ); |
|
1019
|
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
my $query = $self->{query} || |
|
1021
|
0
|
|
0
|
|
|
|
return( $self->error( "No query to set priority for was provided." ) ); |
|
1022
|
0
|
|
|
|
|
|
my $type = uc( ( $query =~ /^\s*(\S+)\s+/ )[ 0 ] ); |
|
1023
|
0
|
|
|
|
|
|
my @allowed = qw( DELETE INSERT REPLACE SELECT UPDATE ); |
|
1024
|
0
|
|
|
|
|
|
my $allowed = CORE::join( '|', @allowed ); |
|
1025
|
|
|
|
|
|
|
# Ignore if not allowed |
|
1026
|
0
|
0
|
|
|
|
|
if( !scalar( grep{ /^$type$/i } @allowed ) ) |
|
|
0
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
{ |
|
1028
|
0
|
|
|
|
|
|
$self->error( "You may not set priority on statement of type \U$type\E:\n$query" ); |
|
1029
|
0
|
|
|
|
|
|
return( $self ); |
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
|
|
|
|
|
|
# Incompatible. Do not bother going further |
|
1032
|
0
|
0
|
|
|
|
|
return( $self ) if( $query =~ /^\s*(?:$allowed)\s+(?:DELAYED|LOW_PRIORITY|HIGH_PRIORITY)\s+/i ); |
|
1033
|
|
|
|
|
|
|
# SELECT with something else than HIGH_PRIORITY is incompatible, so do not bother to go further |
|
1034
|
0
|
0
|
0
|
|
|
|
return( $self ) if( $prio != 1 && $type =~ /^(?:SELECT)$/i ); |
|
1035
|
0
|
0
|
0
|
|
|
|
return( $self ) if( $prio != 0 && $type =~ /^(?:DELETE|INSERT|REPLACE|UPDATE)$/i ); |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
0
|
|
|
|
|
|
$query =~ s/^(\s*)($allowed)(\s+)/$1$2 $map->{ $prio } /i; |
|
1038
|
|
|
|
|
|
|
# $self->{ 'query' } = $query; |
|
1039
|
|
|
|
|
|
|
# my $sth = $self->prepare( $query ) || |
|
1040
|
0
|
|
0
|
|
|
|
my $sth = $self->_cache_this( $query ) || |
|
1041
|
|
|
|
|
|
|
return( $self->error( "Error while preparing new low priority query:\n$query" ) ); |
|
1042
|
0
|
0
|
|
|
|
|
if( !defined( wantarray() ) ) |
|
1043
|
|
|
|
|
|
|
{ |
|
1044
|
0
|
0
|
|
|
|
|
$sth->execute() || |
|
1045
|
|
|
|
|
|
|
return( $self->error( "Error while executing new low priority query:\n$query" ) ); |
|
1046
|
|
|
|
|
|
|
} |
|
1047
|
0
|
|
|
|
|
|
return( $sth ); |
|
1048
|
|
|
|
|
|
|
} |
|
1049
|
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
sub promise |
|
1051
|
|
|
|
|
|
|
{ |
|
1052
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
1053
|
0
|
0
|
|
|
|
|
$self->_load_class( 'Promise::Me' ) || return( $self->pass_error ); |
|
1054
|
|
|
|
|
|
|
return( Promise::Me->new(sub |
|
1055
|
|
|
|
|
|
|
{ |
|
1056
|
0
|
|
|
0
|
|
|
return( $self->execute( @_ ) ); |
|
1057
|
0
|
|
|
|
|
|
}) ); |
|
1058
|
|
|
|
|
|
|
} |
|
1059
|
|
|
|
|
|
|
|
|
1060
|
0
|
|
|
0
|
1
|
|
sub query { return( shift->_set_get_scalar( 'query', @_ ) ); } |
|
1061
|
|
|
|
|
|
|
|
|
1062
|
0
|
|
|
0
|
1
|
|
sub query_object { return( shift->_set_get_object_without_init( 'query_object', 'DB::Object::Query', @_ ) ); } |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
0
|
|
|
0
|
1
|
|
sub query_time { return( shift->_set_get_datetime( 'query_time', @_ ) ); } |
|
1065
|
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
sub rollback |
|
1067
|
|
|
|
|
|
|
{ |
|
1068
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
1069
|
0
|
0
|
0
|
|
|
|
if( $self->{sth} && $self->param( 'autocommit' ) ) |
|
1070
|
|
|
|
|
|
|
{ |
|
1071
|
0
|
|
0
|
|
|
|
my $sth = $self->prepare( "ROLLBACK" ) || return( $self->error( "An error occurred while preparing query to rollback: ", $self->error ) ); |
|
1072
|
0
|
0
|
|
|
|
|
$sth->execute() || return( $self->error( "Error occurred while executing query to rollback: ", $sth->error ) ); |
|
1073
|
0
|
|
|
|
|
|
$sth->finish(); |
|
1074
|
|
|
|
|
|
|
} |
|
1075
|
0
|
|
|
|
|
|
return( $self ); |
|
1076
|
|
|
|
|
|
|
} |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
sub rows(@) |
|
1079
|
|
|
|
|
|
|
{ |
|
1080
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
|
1081
|
0
|
0
|
|
|
|
|
if( !$self->executed() ) |
|
1082
|
|
|
|
|
|
|
{ |
|
1083
|
0
|
0
|
|
|
|
|
$self->execute() || return( $self->pass_error ); |
|
1084
|
|
|
|
|
|
|
} |
|
1085
|
|
|
|
|
|
|
# $self->_cleanup(); |
|
1086
|
|
|
|
|
|
|
# $rv = $sth->rows; |
|
1087
|
0
|
0
|
|
|
|
|
if( !ref( $self ) ) |
|
1088
|
|
|
|
|
|
|
{ |
|
1089
|
0
|
|
|
|
|
|
return( $DBI::rows ); |
|
1090
|
|
|
|
|
|
|
} |
|
1091
|
|
|
|
|
|
|
else |
|
1092
|
|
|
|
|
|
|
{ |
|
1093
|
0
|
|
|
|
|
|
return( $self->{sth}->rows() ); |
|
1094
|
|
|
|
|
|
|
} |
|
1095
|
|
|
|
|
|
|
} |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
# A DBI::sth object. This should rather be a _set_get_object helper method, but I am not 100% sure if this is really a DBI::sth |
|
1098
|
0
|
|
|
0
|
1
|
|
sub sth { return( shift->_set_get_scalar( 'sth', @_ ) ); } |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
0
|
|
|
0
|
1
|
|
sub table { return( shift->{table} ); } |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
0
|
|
|
0
|
1
|
|
sub table_object { return( shift->_set_get_object_without_init( 'table_object', 'DB::Object::Tables', @_ ) ); } |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
sub undo |
|
1105
|
|
|
|
|
|
|
{ |
|
1106
|
0
|
|
|
0
|
1
|
|
goto( &rollback ); |
|
1107
|
|
|
|
|
|
|
} |
|
1108
|
|
|
|
|
|
|
|
|
1109
|
0
|
|
|
0
|
1
|
|
sub wait { return( shift->error( "Method wait() is not implemented by this driver." ) ); } |
|
1110
|
|
|
|
|
|
|
|
|
1111
|
0
|
|
|
0
|
|
|
sub _convert_datetime2object { return( shift->database_object->_convert_datetime2object( @_ ) ); } |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
0
|
|
|
0
|
|
|
sub _convert_json2hash { return( shift->database_object->_convert_json2hash( @_ ) ); } |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
DESTROY |
|
1116
|
|
|
|
0
|
|
|
{ |
|
1117
|
|
|
|
|
|
|
# Do nothing but existing so it is handled by this package |
|
1118
|
|
|
|
|
|
|
# print( STDERR "DESTROY'ing statement $self ($self->{ 'query' })\n" ); |
|
1119
|
|
|
|
|
|
|
}; |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
1; |
|
1122
|
|
|
|
|
|
|
# NOTE: POD |
|
1123
|
|
|
|
|
|
|
__END__ |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=encoding utf-8 |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=head1 NAME |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
DB::Object::Statement - Statement Object |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
say $sth->as_string; |
|
1134
|
|
|
|
|
|
|
$sth->bind_param( 2, $binded_value ); |
|
1135
|
|
|
|
|
|
|
$sth->bind_param( 2, $binded_value, $binded_type ); |
|
1136
|
|
|
|
|
|
|
$sth->commit; |
|
1137
|
|
|
|
|
|
|
my $dbh = $sth->database_object; |
|
1138
|
|
|
|
|
|
|
$sth->distinct; |
|
1139
|
|
|
|
|
|
|
say $sth->dump; |
|
1140
|
|
|
|
|
|
|
say $sth->execute; |
|
1141
|
|
|
|
|
|
|
$sth->execute( $val1, $val2 ) || die( $sth->error ); |
|
1142
|
|
|
|
|
|
|
# explicitly specify types |
|
1143
|
|
|
|
|
|
|
# Here in this mixed example, $val1 and $val3 have known types |
|
1144
|
|
|
|
|
|
|
$tbl->where( $dbh->AND( |
|
1145
|
|
|
|
|
|
|
$tbl->fo->name == '?', |
|
1146
|
|
|
|
|
|
|
$tbl->fo>city == '?', |
|
1147
|
|
|
|
|
|
|
'?' == ANY( $tbl->fo->alias ) |
|
1148
|
|
|
|
|
|
|
) ); |
|
1149
|
|
|
|
|
|
|
my $sth = $tbl->select || die( $tbl->error ); |
|
1150
|
|
|
|
|
|
|
$sth->execute( $val1, $val2, { $val3 => 'varchar' } ) || die( $sth->error ); |
|
1151
|
|
|
|
|
|
|
my $ref = $sth->fetchall_arrayref; |
|
1152
|
|
|
|
|
|
|
my $val = $sth->fetchcol; |
|
1153
|
|
|
|
|
|
|
my %hash = $sth->fetchhash; |
|
1154
|
|
|
|
|
|
|
my @values = $sth->fetchrow; |
|
1155
|
|
|
|
|
|
|
my $ref = $sth->fetchrow_hashref; |
|
1156
|
|
|
|
|
|
|
my $obj = $sth->fetchrow_object; |
|
1157
|
|
|
|
|
|
|
$sth->finish; |
|
1158
|
|
|
|
|
|
|
$sth->ignore; |
|
1159
|
|
|
|
|
|
|
$sth->join( $join_condition ); |
|
1160
|
|
|
|
|
|
|
my $qo = $sth->query_object; |
|
1161
|
|
|
|
|
|
|
$sth->rollback; |
|
1162
|
|
|
|
|
|
|
my $rows = $sth->rows; |
|
1163
|
|
|
|
|
|
|
my $dbi_sth = $sth->sth; |
|
1164
|
|
|
|
|
|
|
my $tbl = $sth->table_object; |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head1 VERSION |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
v0.4.2 |
|
1169
|
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1171
|
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
This is the statement object package from which other driver specific packages inherit from. |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=head1 METHODS |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=head2 as_string |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
Returns the current statement object as a string. |
|
1179
|
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=head2 bind_param |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
Provided with a list of arguments and they will be passed to L<DBI/bind_param> |
|
1183
|
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
If an error occurred, an error is returned, otherwise the return value of calling C<bind_param> is returned. |
|
1185
|
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=head2 commit |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
If the statement parameter I<autocommit> is true, a C<COMMIT> statement will be prepared and executed. |
|
1189
|
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
The current object is returned. |
|
1191
|
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
=head2 database_object |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
Sets or gets the current database object. |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=head2 distinct |
|
1197
|
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Assuming a I<query> object property has already been set previously, this will add the C<DISTINCT> keyword to it if not already set. |
|
1199
|
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
If L</distinct> is called in void context, the query is executed immediately. |
|
1201
|
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
The query statement is returned. |
|
1203
|
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=head2 dump |
|
1205
|
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
Provided with a file and this will print on STDOUT the columns used, separated by a tab and then will process each rows fetched with L<DBI::fetchrow> and will join the column valus with a tab before printing it out to STDOUT. |
|
1207
|
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
It returns the current object for chaining. |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=head2 exec |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
This is an alias for L</execute> |
|
1213
|
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=head2 execute |
|
1215
|
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
$sth->execute || die( $sth->error ); |
|
1217
|
|
|
|
|
|
|
$sth->execute( $val1, $val2 ) || die( $sth->error ); |
|
1218
|
|
|
|
|
|
|
# explicitly specify types |
|
1219
|
|
|
|
|
|
|
# Here in this mixed example, $val1 and $val3 have known types |
|
1220
|
|
|
|
|
|
|
$tbl->where( $dbh->AND( |
|
1221
|
|
|
|
|
|
|
$tbl->fo->name == '?', |
|
1222
|
|
|
|
|
|
|
$tbl->fo>city == '?', |
|
1223
|
|
|
|
|
|
|
'?' == ANY( $tbl->fo->alias ) |
|
1224
|
|
|
|
|
|
|
) ); |
|
1225
|
|
|
|
|
|
|
my $sth = $tbl->select || die( $tbl->error ); |
|
1226
|
|
|
|
|
|
|
$sth->execute( $val1, $val2, { $val3 => 'varchar' } ) || die( $sth->error ); |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
If binded values have been prepared, they are applied here before executing the query. |
|
1229
|
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
Sometime, you need to clearly specify what the datatype are for the value provided with C<execute>, because L<DB::Object::Query> could not figure it out. |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
Thus, if you do: |
|
1233
|
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
$tbl->where( |
|
1235
|
|
|
|
|
|
|
$tbl->fo->name == '?' |
|
1236
|
|
|
|
|
|
|
); |
|
1237
|
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
L<DB::Object::Query> knows the datatype, because you are using a field object (C<fo>), but if you were doing: |
|
1239
|
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
$tbl->where( |
|
1241
|
|
|
|
|
|
|
'?' == ANY( $tbl->fo->alias ) |
|
1242
|
|
|
|
|
|
|
); |
|
1243
|
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
In this scenario, L<DB::Object::Query> does not know what the bind value would be, although we could venture a guess by looking at the right-hand side, but this is a bit hazardous. So you are left with a placeholder, but no datatype. So you would execute like: |
|
1245
|
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
$sth->execute({ $val => 'varchar' }); |
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
If the total number of binded values does not match the total number of binded type, this will trigger a warning. |
|
1249
|
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
L<DBI/execute> will be called with the binded values and if this method was called in an object context, the current object is returned, otherwise the returned value from L<DBI/execute> is returned. |
|
1251
|
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=head2 executed |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
Returns true if this statement has already been executed, and false otherwise. |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
=head2 fetchall_arrayref |
|
1257
|
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
Similar to L<DBI/fetchall_arrayref>, this will execute the query and return an array reference of data. |
|
1259
|
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=head2 fetchcol |
|
1261
|
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
Provided with an integer that represents a column number, starting from 0, and this will get each row of results and add the value for the column at the given offset. |
|
1263
|
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
it returns a list of those column value fetched. |
|
1265
|
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
=head2 fetchhash |
|
1267
|
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
This will retrieve an hash reference for the given row and return it as a regular hash. |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=head2 fetchrow |
|
1271
|
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
This will retrieve the data from database using L</fetchrow_arrayref> and return the list of data as array in list context, or the first entry of the array in scalar context. |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
=head2 fetchrow_hashref |
|
1275
|
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
This will retrieve the data from the database as an hash reference. |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
It will convert any data from json to hash reference if L<DB::Object/auto_decode_json> is set to true. |
|
1279
|
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
it will also convert any datetime data into a L<DateTime> object if L<DB::Object/auto_convert_datetime_to_object> is true. |
|
1281
|
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
It returns the hash reference retrieved. |
|
1283
|
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
=head2 fetchrow_object |
|
1285
|
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
This will create dynamically a package named C<DB::Object::Postgres::Result::SomeTable> for example and load the hash reference retrieved from the database into this dynamically created packackage. |
|
1287
|
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
It returns the object thus created. |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
=head2 finish |
|
1291
|
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
Calls L<DBI/finish> and return the returned value, or an error if an error occurred. |
|
1293
|
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=head2 ignore |
|
1295
|
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
This will change the query prepared and add the keyword C<IGNORE>. |
|
1297
|
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
If called in void context, this will execute the resulting statement handler immediately. |
|
1299
|
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=head2 join |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
Provided with a target and an hash reference, or list or array reference of condition for the join and this will prepare the join statement. |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
If the original query is not of type C<select>, this will trigger an error. |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
The target mentioned above can be either a L<DB::Object::Statement> object, or a table object (L<DB::Object::Tables>), or even just a string representing the name of a table. |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
$tbl->select->join( $sth ); |
|
1309
|
|
|
|
|
|
|
$tbl->select->join( $other_tbl ); |
|
1310
|
|
|
|
|
|
|
$tbl->select->join( 'table_name' ); |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
The condition mentioned above can be a L<DB::Object::Operator> (C<AND>, C<OR> or C<NOT>), in which case the actual condition will be taken from that operator embedded value. |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
The condition can also be a L<DB::Object::Fields::Field::Overloaded> object, which implies a table field with some operator and some value. |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
$tbl->select->join( $other_tbl, $other_tbl->fo->id == 2 ); |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
Here C<$other_tbl->fo->id == 2> will become a L<DB::Object::Fields::Field::Overloaded> object. |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
The condition can also be an array reference or array object of conditions and implicitly the array entry will be joined with C<AND>: |
|
1321
|
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
$tbl->select->join( $other_tbl, ["user = 'joe'", $other_tbl->fo->id == 2] ); |
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
The condition can also be an hash reference with each key being a table name to join and each value an hash reference of condition for that particular join with each key being a column name and each value the value of the join for that column. |
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
my $tbl = $dbh->first_table; |
|
1327
|
|
|
|
|
|
|
$tbl->select->join({ |
|
1328
|
|
|
|
|
|
|
other_table => |
|
1329
|
|
|
|
|
|
|
{ |
|
1330
|
|
|
|
|
|
|
id => 'first_table.id', |
|
1331
|
|
|
|
|
|
|
user => 'first_table.user', |
|
1332
|
|
|
|
|
|
|
}, |
|
1333
|
|
|
|
|
|
|
yet_another_table => |
|
1334
|
|
|
|
|
|
|
{ |
|
1335
|
|
|
|
|
|
|
id => 'other_table.id', |
|
1336
|
|
|
|
|
|
|
}, |
|
1337
|
|
|
|
|
|
|
}); |
|
1338
|
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
would become something like: |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
SELECT * |
|
1342
|
|
|
|
|
|
|
FROM first_table |
|
1343
|
|
|
|
|
|
|
LEFT JOIN other_table ON |
|
1344
|
|
|
|
|
|
|
first_table.id = id AND |
|
1345
|
|
|
|
|
|
|
first_table.user = user |
|
1346
|
|
|
|
|
|
|
LEFT JOIN yet_another_table ON |
|
1347
|
|
|
|
|
|
|
other_table.id = id |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
Each condition will be formatted assuming an C<AND> expression, so this is less flexible than using operator objects and table field objects. |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
If no condition is provided, this is taken to be a straight join. |
|
1352
|
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
$tbl->where( $tbl->fo->id == 2 ); |
|
1354
|
|
|
|
|
|
|
$other_tbl->where( $other_tbl->fo->user 'john' ); |
|
1355
|
|
|
|
|
|
|
$tbl->select->join( $other_tbl ); |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
Would become something like: |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
SELECT * |
|
1360
|
|
|
|
|
|
|
FROM first_table, other_table |
|
1361
|
|
|
|
|
|
|
WHERE id = 2 AND user = 'john' |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
If called in void context, this will execute the resulting statement handler immediately. |
|
1364
|
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
It returns the resulting statement handler. |
|
1366
|
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
It returns the statement handler. |
|
1368
|
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
=head2 object |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Returns the statement object explicitly. |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
my $sth = $tbl->select->object; |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
which is really equivalent to: |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
my $sth = $tbl->select; |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=head2 priority |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
Provided with a priority integer that can be 0 or 1 with 0 being C<LOW_PRIORITY> and 1 being C<HIGH_PRIORITY> and this will adjust the query formatted to add the priority. This works only on Mysql drive though. |
|
1382
|
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
If used on queries other than C<DELETE>, C<INSERT>, C<REPLACE>, C<SELECT>, C<UPDATE> an error will be returned. |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
If called in void context, this will execute the newly create statement handler immediately. |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
It returns the newly create statement handler. |
|
1388
|
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
=head2 promise |
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
This the same as calling L</execute>, except that the query will be executed asynchronously and a L<Promise::Me> object will be returned, so you can do asynchronous queries like this: |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
my $sth = $dbh->prepare( "SELECT some_slow_function(?)" ) || die( $dbh->error ); |
|
1394
|
|
|
|
|
|
|
my $p = $sth->promise(10)->then(sub |
|
1395
|
|
|
|
|
|
|
{ |
|
1396
|
|
|
|
|
|
|
my $st = shift( @_ ); |
|
1397
|
|
|
|
|
|
|
my $ref = $st->fetchrow_hashref; |
|
1398
|
|
|
|
|
|
|
my $obj = My::Module->new( %$ref ); |
|
1399
|
|
|
|
|
|
|
})->catch(sub |
|
1400
|
|
|
|
|
|
|
{ |
|
1401
|
|
|
|
|
|
|
$log->warn( "Failed to execute query: ", @_ ); |
|
1402
|
|
|
|
|
|
|
}); |
|
1403
|
|
|
|
|
|
|
my( $obj ) = await( $p ); |
|
1404
|
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=head2 query |
|
1406
|
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
Sets or gets the previously formatted query as a regular string. |
|
1408
|
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=head2 query_object |
|
1410
|
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
Sets or gets the query object used in this query. |
|
1412
|
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
=head2 query_time |
|
1414
|
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
Sets or gets the query time as a L<DateTime> object. |
|
1416
|
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
=head2 rollback |
|
1418
|
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
If there is a statement handler and the database parameter C<autocommit> is set to true, this will prepare a C<ROLLBACK> query and execute it. |
|
1420
|
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
=head2 rows |
|
1422
|
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
Returns the number of rows affected by the last query. |
|
1424
|
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
=head2 sth |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
Sets or gets the L<DBI> statement handler. |
|
1428
|
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
=head2 table |
|
1430
|
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
Sets or gets the table object (L<DB::Object::Tables>) for this query. |
|
1432
|
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
=head2 table_object |
|
1434
|
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
Sets or get the table object (L<DB::Object::Tables>) |
|
1436
|
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
=head2 undo |
|
1438
|
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
This is an alias for L</rollback> |
|
1440
|
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
=head2 wait |
|
1442
|
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
The implementation is driver dependent, and in this case, this is implemented only in L<DB::Object::Mysql> |
|
1444
|
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
=head2 _convert_datetime2object |
|
1446
|
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
A convenient short to enable or disable L<DB::Object/_convert_datetime2object> |
|
1448
|
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
=head2 _convert_json2hash |
|
1450
|
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
A convenient short to enable or disable L<DB::Object/_convert_json2hash> |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1454
|
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
L<DB::Object::Query>, L<DB::Object::Mysql::Query>, L<DB::Object::Postgres::Query>, L<DB::Object::SQLite::Query> |
|
1456
|
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1458
|
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
|
1460
|
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
|
1462
|
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
Copyright (c) 2019-2021 DEGUEST Pte. Ltd. |
|
1464
|
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
You can use, copy, modify and redistribute this package and associated |
|
1466
|
|
|
|
|
|
|
files under the same terms as Perl itself. |
|
1467
|
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
=cut |