line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver - DBI Wrapper with Driver Subclasses |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
B: Adds methods to a DBI database handle. |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( $dbi_dsn, $dbi_user, $dbi_passwd ); |
10
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( $dbh ); # or use your existing handle |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
$dbh = $sqldb->get_dbh(); # get the wraped DBI dbh |
13
|
|
|
|
|
|
|
$sth = $sqldb->prepare($statement); # or just call any dbh method |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
B Prepare and fetch in one call. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$row_count = $sqldb->try_query($sql, \@params, 'get_execute_rowcount'); |
18
|
|
|
|
|
|
|
$array_ary = $sqldb->try_query($sql, \@params, 'fetchall_arrayref'); |
19
|
|
|
|
|
|
|
$hash_ary = $sqldb->try_query($sql, \@params, 'fetchall_hashref'); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
B SQL generation with flexible arguments. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( |
24
|
|
|
|
|
|
|
table => 'students', where => { 'status'=>'minor' }, |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
$sqldb->do_insert( |
28
|
|
|
|
|
|
|
table => 'students', |
29
|
|
|
|
|
|
|
values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' }, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$sqldb->do_update( |
33
|
|
|
|
|
|
|
table => 'students', where => 'age > 20', |
34
|
|
|
|
|
|
|
values => { 'status'=>'adult' }, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
$sqldb->do_delete( |
38
|
|
|
|
|
|
|
table => 'students', where => { 'name'=>'Dave' }, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
B Pre-define connections and queries. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
44
|
|
|
|
|
|
|
'test' => 'dbi:AnyData:test', |
45
|
|
|
|
|
|
|
'production' => [ 'dbi:Mysql:our_data:dbhost', 'user', 'passwd' ], |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_queries( |
49
|
|
|
|
|
|
|
'all_students' => 'select * from students', |
50
|
|
|
|
|
|
|
'delete_student' => [ 'delete * from students where id = ?', \$1 ], |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'test' ); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_named_query( 'all_students' ); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$rowcount = $sqldb->do_named_query( 'delete_student', $my_id ); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
B Uses driver's idioms or emulation. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( # uses database's limit syntax |
62
|
|
|
|
|
|
|
table => 'students', order => 'last_name, first_name', |
63
|
|
|
|
|
|
|
limit => 20, offset => 100, |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( # use "join on" or merge with "where" |
67
|
|
|
|
|
|
|
table => ['students'=>{'students.id'=>\'grades.student'}=>'grades'], |
68
|
|
|
|
|
|
|
where => { 'academic_year'=>'2004' }, |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( # combines multiple query results |
72
|
|
|
|
|
|
|
union => [ { table=>'students', columns=>'first_name, last_name' }, |
73
|
|
|
|
|
|
|
{ table=>'staff', columns=>'name_f, name_l' } ], |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
$sqldb->do_insert( # use auto_increment/sequence column |
77
|
|
|
|
|
|
|
table => 'students', sequence => 'id', |
78
|
|
|
|
|
|
|
values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' }, |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 DESCRIPTION |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver objects are wrappers around DBI database handles which |
85
|
|
|
|
|
|
|
add methods that support ad-hoc SQL generation and query execution in a single |
86
|
|
|
|
|
|
|
call. Dynamic subclassing based on database server type enables cross-platform |
87
|
|
|
|
|
|
|
portability. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
For more information about this framework, see L. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
######################################################################## |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 Driver Subclasses |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The only methods that are actually provided by the DBIx::SQLEngine::Driver |
98
|
|
|
|
|
|
|
package itself are the constructors like new(). All of the other |
99
|
|
|
|
|
|
|
methods described here are defined in DBIx::SQLEngine::Driver::Default, |
100
|
|
|
|
|
|
|
or in one of its automatically-loaded subclasses. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
After setting up the DBI handle that it will use, the SQLEngine is reblessed |
103
|
|
|
|
|
|
|
into a matching subclass, if one is available. Thus, if you connect a |
104
|
|
|
|
|
|
|
DBIx::SQLEngine through DBD::mysql, by passing a DSN such as "dbi:mysql:test", |
105
|
|
|
|
|
|
|
your object will automatically shift to being an instance of the |
106
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver::Mysql class. This allows the driver-specific |
107
|
|
|
|
|
|
|
subclasses to compensate for differences in the SQL dialect or execution |
108
|
|
|
|
|
|
|
ideosyncracies of that platform. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
This release includes the following driver subclasses, which support the listed database platforms: |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=over 10 |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item Mysql |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
MySQL via DBD::mysql or DBD::ODBC (Free RDBMS) |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item Pg |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
PostgreSQL via DBD::Pg or DBD::ODBC (Free RDBMS) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item Oracle |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Oracle via DBD::Oracle or DBD::ODBC (Commercial RDBMS) |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item Sybase |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Sybase via DBD::Sybase or DBD::ODBC (Commercial RDBMS) |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item Informix |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Informix via DBD::Informix or DBD::ODBC (Commercial RDBMS) |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item MSSQL |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Microsoft SQL Server via DBD::ODBC (Commercial RDBMS) |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item Sybase::MSSQL |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Microsoft SQL Server via DBD::Sybase and FreeTDS libraries |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item SQLite |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
SQLite via DBD::SQLite (Free Package) |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item AnyData |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
AnyData via DBD::AnyData (Free Package) |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item CSV |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
CSV files via DBD::CSV (Free Package) |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=back |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
To understand which SQLEngine driver class will be used for a given database |
157
|
|
|
|
|
|
|
connection, see the discussion of driver and class names in L. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
The public interface of described below is shared by all of the driver |
160
|
|
|
|
|
|
|
subclasses. The superclass methods aim to produce and perform generic queries |
161
|
|
|
|
|
|
|
in an database-independent fashion, using standard SQL syntax. Subclasses may |
162
|
|
|
|
|
|
|
override these methods to compensate for idiosyncrasies of their database |
163
|
|
|
|
|
|
|
server or mechanism. To facilitate cross-platform subclassing, many of these |
164
|
|
|
|
|
|
|
methods are implemented by calling combinations of other methods, which may |
165
|
|
|
|
|
|
|
individually be overridden by subclasses. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=cut |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
######################################################################## |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
package DBIx::SQLEngine::Driver; |
172
|
|
|
|
|
|
|
|
173
|
12
|
|
|
12
|
|
76
|
use strict; |
|
12
|
|
|
|
|
23
|
|
|
12
|
|
|
|
|
528
|
|
174
|
|
|
|
|
|
|
|
175
|
12
|
|
|
12
|
|
31233
|
use DBI; |
|
12
|
|
|
|
|
292923
|
|
|
12
|
|
|
|
|
1066
|
|
176
|
12
|
|
|
12
|
|
32870
|
use DBIx::AnyDBD; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
use Class::MakeMethods; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
######################################################################## |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
######################################################################## |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 DRIVER INSTANTIATION |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
These methods allow the creation of SQLEngine Driver objects connected to your databases. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 Driver Object Creation |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Create one SQLEngine Driver for each DBI datasource you will use. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
B Call the new() method to create a Driver object with associated DBI database handle. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=over 4 |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=item new() |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $dsn ) : $sqldb |
198
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $dsn, $user, $pass ) : $sqldb |
199
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $dsn, $user, $pass, $args ) : $sqldb |
200
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $dbh ) : $sqldb |
201
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $cnxn_name ) : $sqldb |
202
|
|
|
|
|
|
|
DBIx::SQLEngine->new( $cnxn_name, @params ) : $sqldb |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Based on the arguments supplied, invokes one of the below new_with_* methods and returns the resulting new object. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=back |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
B These methods are called internally by new(). |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=over 4 |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item new_with_connect() |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_connect( $dsn ) : $sqldb |
215
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_connect( $dsn, $user, $pass ) : $sqldb |
216
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_connect( $dsn, $user, $pass, $args ) : $sqldb |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Accepts the same arguments as the standard DBI connect method. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item new_with_dbh() |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_dbh( $dbh ) : $sqldb |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Accepts an existing DBI database handle and creates a new Driver object around it. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item new_with_name() |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_name( $cnxn_name ) : $sqldb |
229
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->new_with_name( $cnxn_name, @params ) : $sqldb |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Passes the provided arguments to interpret_named_connection, defined below, and uses its results to make a new connection. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=back |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=cut |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub new { |
238
|
|
|
|
|
|
|
my $class = shift; |
239
|
|
|
|
|
|
|
ref( $_[0] ) ? $class->new_with_dbh( @_ ) : |
240
|
|
|
|
|
|
|
$class->named_connections( $_[0] ) ? $class->new_with_name( @_ ) : |
241
|
|
|
|
|
|
|
$class->new_with_connect( @_ ) |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub new_with_connect { |
245
|
|
|
|
|
|
|
my ($class, $dsn, $user, $pass, $args) = @_; |
246
|
|
|
|
|
|
|
$args ||= { AutoCommit => 1, PrintError => 0, RaiseError => 1 }; |
247
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver::Default->log_connect( $dsn ) |
248
|
|
|
|
|
|
|
if DBIx::SQLEngine::Driver::Default->DBILogging; |
249
|
|
|
|
|
|
|
my $self = DBIx::AnyDBD->connect($dsn, $user, $pass, $args, |
250
|
|
|
|
|
|
|
'DBIx::SQLEngine::Driver'); |
251
|
|
|
|
|
|
|
return undef unless $self; |
252
|
|
|
|
|
|
|
$self->{'reconnector'} = sub { DBI->connect($dsn, $user, $pass, $args) }; |
253
|
|
|
|
|
|
|
return $self; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub new_with_dbh { |
257
|
|
|
|
|
|
|
my ($class, $dbh) = @_; |
258
|
|
|
|
|
|
|
my $self = bless { 'package' => 'DBIx::SQLEngine::Driver', 'dbh' => $dbh }, 'DBIx::AnyDBD'; |
259
|
|
|
|
|
|
|
$self->rebless; |
260
|
|
|
|
|
|
|
$self->_init if $self->can('_init'); |
261
|
|
|
|
|
|
|
return $self; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub new_with_name { |
265
|
|
|
|
|
|
|
my ($class, $name, @args) = @_; |
266
|
|
|
|
|
|
|
$class->new( $class->interpret_named_connection( $name, @args ) ); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
######################################################################## |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head2 Named Connections |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
The following methods maanage a collection of named connection parameters. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
B Call these methods to define connections. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=over 4 |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=item define_named_connections() |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( $name, $cnxn_info ) |
282
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( %names_and_info ) |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
Defines one or more named connections using the names and definitions provided. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
The definition for each connection is expected to be in one of the following formats: |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=over 4 |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=item * |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
A DSN string which will be passed to a DBI->connect call. |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=item * |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
A reference to an array of a DSN string, and optionally, a user name and password. Items which should later be replaced by per-connection parameters can be represented by references to the special Perl variables $1, $2, $3, and so forth, corresponding to the order and number of parameters to be supplied. |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=item * |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
A reference to a subroutine or code block which will process the user-supplied arguments and return a connected DBI database handle or a list of connection arguments. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=back |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item define_named_connections_from_text() |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections_from_text($name, $cnxn_info_text) |
307
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections_from_text(%names_and_info_text) |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Defines one or more connections, using some special processing to facilitate storing dynamic connection definitions in an external source such as a text file or database table. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
The interpretation of each definition is determined by its first non-whitespace character: |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=over 4 |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=item * |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Definitions which begin with a [ character are presumed to contain an array definition and are evaluated immediately. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=item * |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
Definitions which begin with a " or ; character are presumed to contain a code definition and evaluated as the contents of an anonymous subroutine. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item * |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Other definitions are assumed to contain a plain string DSN. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=back |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
All evaluations are done via a Safe compartment, which is required when this function is first used, so the code is fairly limited in terms of what actions it can perform. |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=back |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
B The following methods are called internally by new_with_name(). |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=over 4 |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=item named_connections() |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connections() : %names_and_info |
340
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connections( $name ) : $cnxn_info |
341
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connections( \@names ) : @cnxn_info |
342
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connections( $name, $cnxn_info, ... ) |
343
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connections( \%names_and_info ) |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
Accessor and mutator for a class-wide hash mappping connection names to their definitions. Used internally by the other named_connection methods. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item named_connection() |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->named_connection( $name ) : $cnxn_info |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Retrieves the connection definition matching the name provided. Croaks if no connection has been defined for that name. Used interally by the interpret_named_connection method. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=item interpret_named_connection() |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : $dbh |
356
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : $dsn |
357
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver->interpret_named_connection($name, @params) : @args |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
Combines the connection definition matching the name provided with the following arguments and returns the resulting connection arguments. Croaks if no connection has been defined for that name. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Depending on the definition associated with the name, it is combined with the provided parameters in one the following ways: |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=over 4 |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=item * |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
A string. Any connection parameters are assumed to be the user name and password, and are simply appended and returned. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=item * |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
A reference to an array, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the array, substituting the connection parameters in place of the placeholder references. An exception is thrown if the number of parameters provided does not match the number of special variables referred to. |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=item * |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
A reference to a subroutine. The connection parameters are passed |
376
|
|
|
|
|
|
|
along to the subroutine and its results returned for execution. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=back |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
For more information about the parameter replacement and argument count checking, see the clone_with_parameters() function from L. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=back |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
B These samples demonstrate use of the named_connections feature. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=over 2 |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item * |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Here's a simple definition with a DSN string: |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections('test'=>'dbi:mysql:test'); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'test' ); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item * |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
Here's an example that includes a user name and password: |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
401
|
|
|
|
|
|
|
'reference' => [ 'dbi:mysql:livedata', 'myuser', 'mypasswd' ], |
402
|
|
|
|
|
|
|
); |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'reference' ); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item * |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Here's a definition that requires a user name and password to be provided: |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
411
|
|
|
|
|
|
|
'production' => [ 'dbi:mysql:livedata', \$1, \$2 ], |
412
|
|
|
|
|
|
|
); |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'production', $user, $password ); |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=item * |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
Here's a definition using Perl code to set up the connection arguments: |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
421
|
|
|
|
|
|
|
'finance' => sub { "dbi:oracle:accounting", "bob", "123" }, |
422
|
|
|
|
|
|
|
); |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'finance' ); |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item * |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Connection names are interpreted recursively, allowing them to be used as aliases: |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
431
|
|
|
|
|
|
|
'test' => 'dbi:AnyData:test', |
432
|
|
|
|
|
|
|
'production' => 'dbi:Mysql:our_data:dbhost', |
433
|
|
|
|
|
|
|
); |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
436
|
|
|
|
|
|
|
'-active' => 'production', |
437
|
|
|
|
|
|
|
); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( '-active' ); |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=item * |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
You can also use named connecctions to hijack regular connections: |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
DBIx::SQLEngine->define_named_connections( |
446
|
|
|
|
|
|
|
'dbi:Mysql:students:db_host' => 'dbi:AnyData:test', |
447
|
|
|
|
|
|
|
); |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
$sqldb = DBIx::SQLEngine->new( 'dbi:Mysql:students:db_host' ); |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=item * |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Connection definitions can be stored in external text files or other sources and then evaluated into data structures or code references. The below code loads a simple text file of query definitions |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
open( CNXNS, '/path/to/my/connections' ); |
456
|
|
|
|
|
|
|
%cnxn_info = map { split /\:\s*/, $_, 2 } grep { /^[^#]/ } ; |
457
|
|
|
|
|
|
|
close CNXNS; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
$sqldb->define_named_connections_from_text( %cnxn_info ); |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Placing the following text in the target file will define all of the connections used above: |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# Simple DSN that doesn't need any parameters |
464
|
|
|
|
|
|
|
test: dbi:mysql:test |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Definition that includes a user name and password |
467
|
|
|
|
|
|
|
reference: [ 'dbi:mysql:livedata', 'myuser', 'mypasswd' ] |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# Definition that requires a user name and password |
470
|
|
|
|
|
|
|
production: [ 'dbi:mysql:livedata', \$1, \$2 ] |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
# Definition using Perl code to set up the connection arguments |
473
|
|
|
|
|
|
|
finance: "dbi:oracle:accounting", "bob", "123" |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=back |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=cut |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
use Class::MakeMethods ( 'Standard::Global:hash' => 'named_connections' ); |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
use DBIx::SQLEngine::Utility::CloneWithParams ':all'; |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# $cnxn_def = DBIx::SQLEngine::Driver->named_connection( $name ) |
484
|
|
|
|
|
|
|
sub named_connection { |
485
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
486
|
|
|
|
|
|
|
$self->named_connections( $name ) or croak("No connection named '$name'"); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# ($dsn) = DBIx::SQLEngine::Driver->interpret_named_connection($name, @args) |
490
|
|
|
|
|
|
|
# ($dsn, $user, $pass) = DBIx::SQLEngine::Driver->interpret_named_connection(...) |
491
|
|
|
|
|
|
|
# ($dsn, $user, $pass, $opts) = DBIx::SQLEngine::Driver->interpret_named_connection(...) |
492
|
|
|
|
|
|
|
sub interpret_named_connection { |
493
|
|
|
|
|
|
|
my ( $self, $name, @cnxn_args ) = @_; |
494
|
|
|
|
|
|
|
my $cnxn_def = $self->named_connection( $name ); |
495
|
|
|
|
|
|
|
if ( ! $cnxn_def ) { |
496
|
|
|
|
|
|
|
croak("No definition was provided for named connection '$name': $cnxn_def") |
497
|
|
|
|
|
|
|
} elsif ( ! ref $cnxn_def ) { |
498
|
|
|
|
|
|
|
return ( $cnxn_def, @cnxn_args ); |
499
|
|
|
|
|
|
|
} elsif ( ref($cnxn_def) eq 'ARRAY' ) { |
500
|
|
|
|
|
|
|
return ( @{ clone_with_parameters($cnxn_def, @cnxn_args) } ); |
501
|
|
|
|
|
|
|
} elsif ( ref($cnxn_def) eq 'CODE' ) { |
502
|
|
|
|
|
|
|
my @results = $cnxn_def->( @cnxn_args ); |
503
|
|
|
|
|
|
|
unshift @results, 'sql' if scalar(@results) == 1; |
504
|
|
|
|
|
|
|
return @results; |
505
|
|
|
|
|
|
|
} else { |
506
|
|
|
|
|
|
|
croak("Unable to interpret definition of named connection '$name': $cnxn_def") |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# DBIx::SQLEngine::Driver->define_named_connections( $name, $string_hash_or_sub, ... ) |
511
|
|
|
|
|
|
|
sub define_named_connections { |
512
|
|
|
|
|
|
|
my $self = shift; |
513
|
|
|
|
|
|
|
while ( scalar @_ ) { |
514
|
|
|
|
|
|
|
$self->named_connections( splice( @_, 0, 2 ) ) |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
sub define_named_connection { (shift)->define_named_connections(@_) } |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# DBIx::SQLEngine::Driver->define_named_connections_from_text( $name, $string ) |
520
|
|
|
|
|
|
|
sub define_named_connections_from_text { |
521
|
|
|
|
|
|
|
my $self = shift; |
522
|
|
|
|
|
|
|
while ( scalar @_ ) { |
523
|
|
|
|
|
|
|
my ( $name, $text ) = splice( @_, 0, 2 ); |
524
|
|
|
|
|
|
|
my $cnxn_def = do { |
525
|
|
|
|
|
|
|
if ( $text =~ /^\s*[\[|\{]/ ) { |
526
|
|
|
|
|
|
|
safe_eval_with_parameters( $text ); |
527
|
|
|
|
|
|
|
} elsif ( $text =~ /^\s*[\"|\;]/ ) { |
528
|
|
|
|
|
|
|
safe_eval_with_parameters( "sub { $text }" ); |
529
|
|
|
|
|
|
|
} else { |
530
|
|
|
|
|
|
|
$text |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
}; |
533
|
|
|
|
|
|
|
$self->define_named_connection( $name, $cnxn_def ); |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
######################################################################## |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# Provide aliases for methods that might be called on the factory class |
540
|
|
|
|
|
|
|
foreach my $method ( qw/ DBILogging SQLLogging |
541
|
|
|
|
|
|
|
named_queries define_named_queries define_named_queries_from_text / ) { |
542
|
|
|
|
|
|
|
no strict 'refs'; |
543
|
|
|
|
|
|
|
*{$method} = sub { shift; DBIx::SQLEngine::Driver::Default->$method( @_ ) } |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
######################################################################## |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
######################################################################## |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# Set up default driver package and ensure that we don't try to require it later |
551
|
|
|
|
|
|
|
package DBIx::SQLEngine::Driver::Default; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
BEGIN { $INC{'DBIx/SQLEngine/Driver.pm'} = __FILE__ } |
554
|
|
|
|
|
|
|
BEGIN { $INC{'DBIx/SQLEngine/Driver/Default.pm'} = __FILE__ } |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
use strict; |
557
|
|
|
|
|
|
|
use Carp; |
558
|
|
|
|
|
|
|
use DBI; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
use DBIx::SQLEngine::Utility::CloneWithParams ':all'; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
######################################################################## |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
######################################################################## |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=head1 FETCHING DATA (SQL DQL) |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
Information is obtained from a DBI database through the Data Query Language features of SQL. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=head2 Select to Retrieve Data |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
The following methods may be used to retrieve data using SQL select statements. They all accept a flexible set of key-value arguments describing the query to be run, as described in the "SQL Select Clauses" section below. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
B There are several ways to retrieve information from a SELECT query. |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
The fetch_* methods select and return matching rows. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=over 4 |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
=item fetch_select() |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
$sqldb->fetch_select( %sql_clauses ) : $row_hashes |
583
|
|
|
|
|
|
|
$sqldb->fetch_select( %sql_clauses ) : ($row_hashes, $column_hashes) |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Retrieve rows from the datasource as an array of hashrefs. If called in a list context, also returns an array of hashrefs containing information about the columns included in the result set. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=item fetch_select_rows() |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
$sqldb->fetch_select_rows( %sql_clauses ) : $row_arrays |
590
|
|
|
|
|
|
|
$sqldb->fetch_select_rows( %sql_clauses ) : ($row_arrays, $column_hashes) |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Like fetch_select, but returns an array of arrayrefs, rather than hashrefs. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=item fetch_one_row() |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
$sqldb->fetch_one_row( %sql_clauses ) : $row_hash |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
Calls fetch_select, then returns only the first row of results. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=item fetch_one_value() |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
$sqldb->fetch_one_value( %sql_clauses ) : $scalar |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
Calls fetch_select, then returns the first value from the first row of results. |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=back |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
The visit_* and fetchsub_* methods allow you to loop through the returned records without necessarily loading them all into memory at once. |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=over 4 |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=item visit_select() |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
$sqldb->visit_select( $code_ref, %sql_clauses ) : @results |
615
|
|
|
|
|
|
|
$sqldb->visit_select( %sql_clauses, $code_ref ) : @results |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
Retrieve rows from the datasource as a series of hashrefs, and call the user provided function for each one. For your convenience, will accept a coderef as either the first or the last argument. Returns the results returned by each of those function calls. Processing with visit_select rather than fetch_select can be more efficient if you are looping over a large number of rows and do not need to keep them all in memory. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
Note that some DBI drivers do not support simultaneous use of more than one statement handle; if you are using such a driver, you will receive an error if you run another query from within your code reference. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
=item visit_select_rows() |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
$sqldb->visit_select_rows( $code_ref, %sql_clauses ) : @results |
624
|
|
|
|
|
|
|
$sqldb->visit_select_rows( %sql_clauses, $code_ref ) : @results |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
Like visit_select, but for each row the code ref is called with the current row retrieved as a list of values, rather than a hash ref. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=item fetchsub_select() |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
$self->fetchsub_select( %clauses ) : $coderef |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Execute a query and returns a code reference that can be called repeatedly to retrieve a row as a hashref. When all of the rows have been fetched it will return undef. |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method. |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
Note that some DBI drivers do not support simultaneous use of more than one statement handle; if you are using such a driver, you will receive an error if you run another query while this code reference is still in scope. |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=item fetchsub_select_rows() |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
$self->fetchsub_select_rows( %clauses ) : $coderef |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
Like fetchsub_select, but for each row returns a list of values, rather than a hash ref. When all of the rows have been fetched it will return an empty list. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=back |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
B: The above select methods accept a hash describing the clauses of the SQL statement they are to generate, using the values provided for the keys defined below. |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=over 4 |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=item 'sql' |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders. Can not be used in combination with the table and columns arguments. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=item 'named_query' |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L"NAMED QUERY CATALOG"> for details. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=item 'union' |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
Calls sql_union() to produce a query that combines the results of multiple calls to sql_select(). Should contain a reference to an array of hash-refs, each of which contains key-value pairs to be used in one of the unified selects. Can not be used in combination with the table and columns arguments. |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=item 'table' I 'tables' |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
The name of the tables to select from. Required unless one of the above parameters is provided. May contain a string with one or more table names, or a reference to an array or hash of table names and join criteria. See the sql_join() method for details. |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=item 'columns' |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Optional; defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash mapping column names to "as" aliases, or a reference to an object with a "column_names" method. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=item 'distinct' |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
Optional. Boolean. Adds the "distinct" keyword to the query if value is true. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=item 'where' I 'criteria' |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Optional. May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=item 'group' |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Optional. May contain a comma-separated string of column names or experessions, or an reference to an array of the same. |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=item 'order' |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Optional. May contain a comma-separated string of column names or experessions, optionally followed by "DESC", or an reference to an array of the same. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=item 'limit' |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Optional. Maximum number of rows to be retrieved from the server. Relies on DBMS-specific behavior provided by sql_limit(). |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=item 'offset' |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Optional. Number of rows at the start of the result which should be skipped over. Relies on DBMS-specific behavior provided by sql_limit(). |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=back |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
B These samples demonstrate use of the select features. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=over 2 |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=item * |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Each query can be written out explicitly or generated on demand using whichever syntax is most appropriate to your application; the following examples are functionally equivalent: |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
705
|
|
|
|
|
|
|
sql => "select * from students where status = 'minor'" |
706
|
|
|
|
|
|
|
); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
709
|
|
|
|
|
|
|
sql => [ 'select * from students where status = ?', 'minor' ] |
710
|
|
|
|
|
|
|
); |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
713
|
|
|
|
|
|
|
sql => 'select * from students', where => { 'status' => 'minor' } |
714
|
|
|
|
|
|
|
); |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
717
|
|
|
|
|
|
|
table => 'students', where => [ 'status = ?', 'minor' ] |
718
|
|
|
|
|
|
|
); |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
721
|
|
|
|
|
|
|
table => 'students', where => { 'status' => 'minor' } |
722
|
|
|
|
|
|
|
); |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
725
|
|
|
|
|
|
|
table => 'students', where => |
726
|
|
|
|
|
|
|
DBIx::SQLEngine::Criteria->type_new('Equality','status'=>'minor') |
727
|
|
|
|
|
|
|
); |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=item * |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Both generated and explicit SQL can be stored as named queries and then used again later; the following examples are equivalent to those above: |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
$sqldb->define_named_query( |
734
|
|
|
|
|
|
|
'minor_students' => "select * from students where status = 'minor'" |
735
|
|
|
|
|
|
|
); |
736
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
737
|
|
|
|
|
|
|
named_query => 'minor_students' |
738
|
|
|
|
|
|
|
); |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
$sqldb->define_named_query( |
741
|
|
|
|
|
|
|
'minor_students' => { |
742
|
|
|
|
|
|
|
table => 'students', where => { 'status' => 'minor' } |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
); |
745
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
746
|
|
|
|
|
|
|
named_query => 'minor_students' |
747
|
|
|
|
|
|
|
); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
=item * |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
Here's a use of some optional clauses listing the columns returned, and specifying a sort order: |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
754
|
|
|
|
|
|
|
table => 'students', columns => 'name, age', order => 'name' |
755
|
|
|
|
|
|
|
); |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=item * |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Here's a where clause that uses a function to find the youngest people; note the use of a backslash to indicate that "min(age)" is an expression to be evaluated by the database server, rather than a literal value: |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
762
|
|
|
|
|
|
|
table => 'students', where => { 'age' => \"min(age)" } |
763
|
|
|
|
|
|
|
); |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=item * |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
If you know that only one row will match, you can use fetch_one_row: |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
$joe = $sqldb->fetch_one_row( |
770
|
|
|
|
|
|
|
table => 'student', where => { 'id' => 201 } |
771
|
|
|
|
|
|
|
); |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
All of the SQL select clauses are accepted, including explicit SQL statements with parameters: |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
$joe = $sqldb->fetch_one_row( |
776
|
|
|
|
|
|
|
sql => [ 'select * from students where id = ?', 201 ] |
777
|
|
|
|
|
|
|
); |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=item * |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
And when you know that there will only be one row and one column in your result set, you can use fetch_one_value: |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
$count = $sqldb->fetch_one_value( |
784
|
|
|
|
|
|
|
table => 'student', columns => 'count(*)' |
785
|
|
|
|
|
|
|
); |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
All of the SQL select clauses are accepted, including explicit SQL statements with parameters: |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
$maxid = $sqldb->fetch_one_value( |
790
|
|
|
|
|
|
|
sql => [ 'select max(id) from students where status = ?', 'minor' ] |
791
|
|
|
|
|
|
|
); |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=item * |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
You can use visit_select to make a traversal of all rows that match a query without retrieving them all at once: |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
$sqldb->visit_select( |
798
|
|
|
|
|
|
|
table => 'student', |
799
|
|
|
|
|
|
|
sub { |
800
|
|
|
|
|
|
|
my $student = shift; |
801
|
|
|
|
|
|
|
print $student->{id}, $student->{name}, $student->{age}; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
); |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
You can collect values along the way: |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
my @firstnames = $sqldb->visit_select( |
808
|
|
|
|
|
|
|
table => 'student', |
809
|
|
|
|
|
|
|
sub { |
810
|
|
|
|
|
|
|
my $student = shift; |
811
|
|
|
|
|
|
|
( $student->{name} =~ /(\w+)\s/ ) ? $1 : $student->{name}; |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
); |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
You can visit with any combination of the other clauses supported by fetch_select: |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
$sqldb->visit_select( |
818
|
|
|
|
|
|
|
table => 'student', |
819
|
|
|
|
|
|
|
columns => 'id, name', |
820
|
|
|
|
|
|
|
order => 'name, id desc', |
821
|
|
|
|
|
|
|
where => 'age < 22', |
822
|
|
|
|
|
|
|
sub { |
823
|
|
|
|
|
|
|
my $student = shift; |
824
|
|
|
|
|
|
|
print $student->{id}, $student->{name}; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
); |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=item * |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
You can use fetchsub_select to make a traversal of some or all rows without retrieving them all at once: |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
my $fetchsub = $sqldb->fetchsub_select( |
833
|
|
|
|
|
|
|
table => 'student', |
834
|
|
|
|
|
|
|
where => 'age < 22', |
835
|
|
|
|
|
|
|
); |
836
|
|
|
|
|
|
|
while ( my $student = $fetchsub->() ) { |
837
|
|
|
|
|
|
|
print $student->{id}, $student->{name}, $student->{age}; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
You can use fetchsub_select_rows to treat each row as a list of values instead of a hashref: |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
my $fetchsub = $sqldb->fetchsub_select_rows( |
843
|
|
|
|
|
|
|
table => 'student', |
844
|
|
|
|
|
|
|
columns => 'id, name, age', |
845
|
|
|
|
|
|
|
); |
846
|
|
|
|
|
|
|
while ( my @student = $fetchsub->() ) { |
847
|
|
|
|
|
|
|
print $student[0], $student[1], $student[2]; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=back |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=cut |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# $rows = $self->fetch_select( %clauses ); |
855
|
|
|
|
|
|
|
sub fetch_select { |
856
|
|
|
|
|
|
|
my $self = shift; |
857
|
|
|
|
|
|
|
$self->fetch_sql( $self->sql_select( @_ ) ); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
# $rows = $self->fetch_select_rows( %clauses ); |
861
|
|
|
|
|
|
|
sub fetch_select_rows { |
862
|
|
|
|
|
|
|
my $self = shift; |
863
|
|
|
|
|
|
|
$self->fetch_sql_rows( $self->sql_select( @_ ) ); |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
# $row = $self->fetch_one( %clauses ); |
867
|
|
|
|
|
|
|
sub fetch_one { |
868
|
|
|
|
|
|
|
my $self = shift; |
869
|
|
|
|
|
|
|
my $rows = $self->fetch_select( limit => 1, @_ ) or return; |
870
|
|
|
|
|
|
|
$rows->[0]; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
# $row = $self->fetch_one_row( %clauses ); |
874
|
|
|
|
|
|
|
sub fetch_one_row { (shift)->fetch_one( @_ ) } |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
# $row = $self->fetch_one_values( %clauses ); |
877
|
|
|
|
|
|
|
sub fetch_one_values { |
878
|
|
|
|
|
|
|
my $self = shift; |
879
|
|
|
|
|
|
|
my $rows = $self->fetch_select_rows( limit => 1, @_ ) or return; |
880
|
|
|
|
|
|
|
$rows->[0] ? @{ $rows->[0] } : (); |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
# $value = $self->fetch_one_value( %clauses ); |
884
|
|
|
|
|
|
|
sub fetch_one_value { |
885
|
|
|
|
|
|
|
my $self = shift; |
886
|
|
|
|
|
|
|
my $row = $self->fetch_one_row( @_ ) or return; |
887
|
|
|
|
|
|
|
(%$row)[1]; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# @results = $self->visit_select( %clauses, $coderef ); |
891
|
|
|
|
|
|
|
# @results = $self->visit_select( $coderef, %clauses ); |
892
|
|
|
|
|
|
|
sub visit_select { |
893
|
|
|
|
|
|
|
my $self = shift; |
894
|
|
|
|
|
|
|
$self->visit_sql( ( ref($_[0]) ? shift : pop ), $self->sql_select( @_ ) ) |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
# @results = $self->visit_select_rows( %clauses, $coderef ); |
898
|
|
|
|
|
|
|
# @results = $self->visit_select_rows( $coderef, %clauses ); |
899
|
|
|
|
|
|
|
sub visit_select_rows { |
900
|
|
|
|
|
|
|
my $self = shift; |
901
|
|
|
|
|
|
|
$self->visit_sql_rows( ( ref($_[0]) ? shift : pop ), $self->sql_select( @_ ) ) |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
# $coderef = $self->fetchsub_select( %clauses ); |
905
|
|
|
|
|
|
|
sub fetchsub_select { |
906
|
|
|
|
|
|
|
my $self = shift; |
907
|
|
|
|
|
|
|
$self->fetchsub_sql( $self->sql_select( @_ ) ); |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# $coderef = $self->fetchsub_select_rows( %clauses ); |
911
|
|
|
|
|
|
|
sub fetchsub_select_rows { |
912
|
|
|
|
|
|
|
my $self = shift; |
913
|
|
|
|
|
|
|
$self->fetchsub_sql_rows( $self->sql_select( @_ ) ); |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
######################################################################## |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
=pod |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
B The following methods are used to construct select queries. They are called automatically by the public select methods, and do not need to be invoked directly. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=over 4 |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=item sql_select() |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
$sqldb->sql_select ( %sql_clauses ) : $sql_stmt, @params |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
Generate a SQL select statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the fetch_ and visit_ methods above, and calls any of the other sql_ methods necessary. |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=item sql_where() |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
$sqldb->sql_where( $criteria, $sql, @params ) : $sql, @params |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Modifies the SQL statement and parameters list provided to append the specified criteria as a where clause. Triggered by use of a where or criteria clause in a call to sql_select(), sql_update(), or sql_delete(). |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
The criteria may be a literal SQL where clause (everything after the word "where"), or a reference to an array of a SQL string with embedded placeholders followed by the values that should be bound to those placeholders. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
If the criteria argument is a reference to hash, it is treated as a set of field-name => value pairs, and a SQL expression is created that requires each one of the named fields to exactly match the value provided for it, or if the value is an array reference to match any one of the array's contents; see L for details. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
Alternately, if the criteria argument is a reference to an object which supports a sql_where() method, the results of that method will be used; see L for classes with this behavior. |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
If no SQL statement or parameters are provided, this just returns the where clause and associated parameters. If a SQL statement is provided, the where clauses is appended to it; if the SQL statement already includes a where clause, the additional criteria are inserted into the existing statement and AND'ed together with the existing criteria. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
=item sql_escape_text_for_like() |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
$sqldb->sql_escape_text_for_like ( $text ) : $escaped_expr |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Subclasses should, based on the datasource's server_type, protect a literal value for use in a like expression. |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=item sql_join() |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
$sqldb->sql_join( $table1, $table2, ... ) : $sql, @params |
955
|
|
|
|
|
|
|
$sqldb->sql_join( \%table_names_and_criteria ) : $sql, @params |
956
|
|
|
|
|
|
|
$sqldb->sql_join( $table1, \%criteria, $table2 ) : $sql, @params |
957
|
|
|
|
|
|
|
$sqldb->sql_join( $table1, $join_type=>\%criteria, $table2 ) : $sql, @params |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
Processes one or more table names to create the "from" clause of a select statement. Table names may appear in succession for normal "cross joins", or you may specify a "complex join" by placing an inner or outer joining operation between them. |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
A joining operation consists of a string containing the word C, followed by an array reference or hash reference that specifies the criteria. The string should be one of the types of joins supported by your database, typically the following: "cross join", "inner join", "outer join", "left outer join", "right outer join". Any underscores in the string are converted to spaces, making it easier to use as an unquoted string. |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
The joining criteria can be an array reference of a string containing a bit SQL followed by any necessary placeholder parameters, or a hash reference which will be converted to SQL with the DBIx::SQLEngine::Criteria package. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
If an array reference is used as a table name, its contents are evaluated by being passed to another call to sql_join, and then the results are treated as a parenthesized expression. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
If a hash reference is used as a table name, its contents are evaluated as criteria in "table1.column1" => "table2.column2" format. The table names and criteria are passed to another call to sql_join, and then the results are treated as a parenthesized expression. |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
B While the cross and inner joins are widely supported, the various outer join capabilities are only present in some databases. Subclasses may provide a degree of emulation; for one implementation of this, see L. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
B These samples demonstrate use of the join feature. |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=over 2 |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
=item * |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
Here's a simple inner join of two tables, using a hash ref to express the linkage: |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
980
|
|
|
|
|
|
|
tables => { 'students.id' => 'grades.student_id' }, |
981
|
|
|
|
|
|
|
order => 'students.name' |
982
|
|
|
|
|
|
|
); |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=item * |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
You can also use bits of SQL to express the linkage between two tables: |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
989
|
|
|
|
|
|
|
tables => [ |
990
|
|
|
|
|
|
|
'students', |
991
|
|
|
|
|
|
|
INNER_JOIN=>['students.id = grades.student_id'], |
992
|
|
|
|
|
|
|
'grades' |
993
|
|
|
|
|
|
|
], |
994
|
|
|
|
|
|
|
order => 'students.name' |
995
|
|
|
|
|
|
|
); |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item * |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
Any number of tables can be joined in this fashion: |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
1002
|
|
|
|
|
|
|
tables => [ |
1003
|
|
|
|
|
|
|
'students', |
1004
|
|
|
|
|
|
|
INNER_JOIN=>['students.id = grades.student_id'], |
1005
|
|
|
|
|
|
|
'grades', |
1006
|
|
|
|
|
|
|
INNER_JOIN=>['classes.id = grades.class_id' ], |
1007
|
|
|
|
|
|
|
'classes', |
1008
|
|
|
|
|
|
|
], |
1009
|
|
|
|
|
|
|
order => 'students.name' |
1010
|
|
|
|
|
|
|
); |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=item * |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
Here's yet another way of expressing a join, using a join type and a hash of criteria: |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
1017
|
|
|
|
|
|
|
tables => [ |
1018
|
|
|
|
|
|
|
'students', INNER_JOIN=>{ 'students.id'=>\'grades.student_id' }, 'grades' |
1019
|
|
|
|
|
|
|
], |
1020
|
|
|
|
|
|
|
order => 'students.name' |
1021
|
|
|
|
|
|
|
); |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Note that we're using a backslash in our criteria hash again to make it clear that we're looking for tuples where the students.id column matches that the grades.student_id column, rather than trying to match the literal string 'grades.student_id'. |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=item * |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
The inner join shown above is equivalent to a typical cross join with the same joining criteria: |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
1030
|
|
|
|
|
|
|
tables => [ 'students', 'grades' ], |
1031
|
|
|
|
|
|
|
where => { 'students.id' => \'grades.student_id' }, |
1032
|
|
|
|
|
|
|
order => 'students.name' |
1033
|
|
|
|
|
|
|
); |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=item * |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
You can use nested array references to produce grouped join expressions: |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( table => [ |
1040
|
|
|
|
|
|
|
[ 'table1', INNER_JOIN=>{ 'table1.foo' => \'table2.foo' }, 'table2' ], |
1041
|
|
|
|
|
|
|
OUTER_JOIN=>{ 'table1.bar' => \'table3.bar' }, |
1042
|
|
|
|
|
|
|
[ 'table3', INNER_JOIN=>{ 'table3.baz' => \'table4.baz' }, 'table4' ], |
1043
|
|
|
|
|
|
|
] ); |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item * |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
You can also simply pass in your own arbitrary join as text: |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
$hashes = $sqldb->fetch_select( |
1050
|
|
|
|
|
|
|
tables => 'students OUTER JOIN grades ON students.id = grades.student_id', |
1051
|
|
|
|
|
|
|
order => 'students.name' |
1052
|
|
|
|
|
|
|
); |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=back |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
=item sql_limit() |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
$sqldb->sql_limit( $limit, $offset, $sql, @params ) : $sql, @params |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Modifies the SQL statement and parameters list provided to apply the specified limit and offset requirements. Triggered by use of a limit or offset clause in a call to sql_select(). |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
B Limit and offset clauses are handled differently by various DBMS platforms. For example, MySQL accepts "limit 20,10", Postgres "limit 10 offset 20", and Oracle requires a nested select with rowcount. The sql_limit method can be overridden by subclasses to adjust this behavior. |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
B These samples demonstrate use of the limit feature. |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=over 2 |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=item * |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
This query return records 101 through 120 from an alphabetical list: |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( |
1073
|
|
|
|
|
|
|
table => 'students', order => 'last_name, first_name', |
1074
|
|
|
|
|
|
|
limit => 20, offset => 100, |
1075
|
|
|
|
|
|
|
); |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
=back |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=item sql_union() |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
$sqldb->sql_union( \%clauses_1, \%clauses_2, ... ) : $sql, @params |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
Returns a combined select query using the C operator between the SQL statements produced by calling sql_select() with each of the provided arrays of arguments. Triggered by use of a union clause in a call to sql_select(). |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
B Union queries are only supported by some databases. Croaks if the dbms_union_unsupported() capability method is set. Subclasses may provide a degree of emulation; for one implementation of this, see L. |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
B These samples demonstrate use of the union feature. |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=over 2 |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=item * |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
A union can combine any mixture of queries with generated clauses: |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( |
1096
|
|
|
|
|
|
|
union=>[ { table=>'students', columns=>'first_name, last_name' }, |
1097
|
|
|
|
|
|
|
{ table=>'staff', columns=>'name_f, name_l' }, ], |
1098
|
|
|
|
|
|
|
); |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=item * |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
Unions can also combine plain SQL strings: |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
$hash_ary = $sqldb->fetch_select( |
1105
|
|
|
|
|
|
|
union=>[ { sql=>'select first_name, last_name from students' }, |
1106
|
|
|
|
|
|
|
{ sql=>'select name_f, name_l from staff' }, ], |
1107
|
|
|
|
|
|
|
); |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
=back |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
=back |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=cut |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
sub sql_select { |
1116
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
my $keyword = 'select'; |
1119
|
|
|
|
|
|
|
my ($sql, @params); |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
if ( my $named = delete $clauses{'named_query'} ) { |
1122
|
|
|
|
|
|
|
my %named = $self->interpret_named_query( ref($named) ? @$named : $named ); |
1123
|
|
|
|
|
|
|
%clauses = ( %named, %clauses ); |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
if ( my $action = delete $clauses{'action'} ) { |
1127
|
|
|
|
|
|
|
confess("Action mismatch: expecting $keyword, not $action query") |
1128
|
|
|
|
|
|
|
unless ( $action eq $keyword ); |
1129
|
|
|
|
|
|
|
} |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
if ( my $union = delete $clauses{'union'} ) { |
1132
|
|
|
|
|
|
|
if ( my ( $conflict ) = grep $clauses{$_}, qw/sql table tables columns/ ) { |
1133
|
|
|
|
|
|
|
croak("Can't build a $keyword query using both union and $conflict args") |
1134
|
|
|
|
|
|
|
} |
1135
|
|
|
|
|
|
|
ref($union) eq 'ARRAY' or |
1136
|
|
|
|
|
|
|
croak("Union clause must be a reference to an array of hashes or arrays"); |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
$clauses{'sql'} = [ $self->sql_union( @$union ) ] |
1139
|
|
|
|
|
|
|
} |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
if ( my $literal = delete $clauses{'sql'} ) { |
1142
|
|
|
|
|
|
|
if ( my ($conflict) = grep $clauses{$_}, qw/distinct table tables columns/){ |
1143
|
|
|
|
|
|
|
croak("Can't build a $keyword query using both sql and $conflict clauses") |
1144
|
|
|
|
|
|
|
} |
1145
|
|
|
|
|
|
|
($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal; |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
} else { |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
if ( my $distinct = delete $clauses{'distinct'} ) { |
1150
|
|
|
|
|
|
|
$keyword .= " distinct"; |
1151
|
|
|
|
|
|
|
} |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
my $columns = delete $clauses{'columns'}; |
1154
|
|
|
|
|
|
|
if ( ! $columns ) { |
1155
|
|
|
|
|
|
|
$columns = '*'; |
1156
|
|
|
|
|
|
|
} elsif ( ! ref( $columns ) and length( $columns ) ) { |
1157
|
|
|
|
|
|
|
# should be one or more comma-separated column names |
1158
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($columns, 'column_names') ) { |
1159
|
|
|
|
|
|
|
$columns = join ', ', $columns->column_names; |
1160
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'ARRAY' ) { |
1161
|
|
|
|
|
|
|
$columns = join ', ', @$columns; |
1162
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'HASH' ) { |
1163
|
|
|
|
|
|
|
$columns = join ', ', map { "$_ as $columns->{$_}" } sort keys %$columns; |
1164
|
|
|
|
|
|
|
} else { |
1165
|
|
|
|
|
|
|
confess("Unsupported column spec '$columns'"); |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
$sql = "$keyword $columns"; |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
my $tables = delete $clauses{'table'} || delete $clauses{'tables'}; |
1170
|
|
|
|
|
|
|
if ( ! $tables ) { |
1171
|
|
|
|
|
|
|
confess("You must supply a table name if you do not use literal SQL or a named query"); |
1172
|
|
|
|
|
|
|
} elsif ( ! ref( $tables ) and length( $tables ) ) { |
1173
|
|
|
|
|
|
|
# should be one or more comma-separated table names |
1174
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($tables, 'table_names') ) { |
1175
|
|
|
|
|
|
|
$tables = $tables->table_names; |
1176
|
|
|
|
|
|
|
} elsif ( ref($tables) eq 'ARRAY' ) { |
1177
|
|
|
|
|
|
|
($tables, my @join_params) = $self->sql_join( @$tables ); |
1178
|
|
|
|
|
|
|
push @params, @join_params; |
1179
|
|
|
|
|
|
|
} elsif ( ref($tables) eq 'HASH' ) { |
1180
|
|
|
|
|
|
|
($tables, my @join_params) = $self->sql_join( $tables ); |
1181
|
|
|
|
|
|
|
push @params, @join_params; |
1182
|
|
|
|
|
|
|
} else { |
1183
|
|
|
|
|
|
|
confess("Unsupported table spec '$tables'"); |
1184
|
|
|
|
|
|
|
} |
1185
|
|
|
|
|
|
|
$sql .= " from $tables"; |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){ |
1189
|
|
|
|
|
|
|
($sql, @params) = $self->sql_where($criteria, $sql, @params); |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
if ( my $group = delete $clauses{'group'} ) { |
1193
|
|
|
|
|
|
|
if ( ! ref( $group ) and length( $group ) ) { |
1194
|
|
|
|
|
|
|
# should be one or more comma-separated column names or expressions |
1195
|
|
|
|
|
|
|
} elsif ( ref($group) eq 'ARRAY' ) { |
1196
|
|
|
|
|
|
|
$group = join ', ', @$group; |
1197
|
|
|
|
|
|
|
} else { |
1198
|
|
|
|
|
|
|
confess("Unsupported group spec '$group'"); |
1199
|
|
|
|
|
|
|
} |
1200
|
|
|
|
|
|
|
if ( $group ) { |
1201
|
|
|
|
|
|
|
$sql .= " group by $group"; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
} |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
if ( my $order = delete $clauses{'order'} ) { |
1206
|
|
|
|
|
|
|
if ( ! ref( $order ) and length( $order ) ) { |
1207
|
|
|
|
|
|
|
# should be one or more comma-separated column names with optional 'desc' |
1208
|
|
|
|
|
|
|
} elsif ( ref($order) eq 'ARRAY' ) { |
1209
|
|
|
|
|
|
|
$order = join ', ', @$order; |
1210
|
|
|
|
|
|
|
} else { |
1211
|
|
|
|
|
|
|
confess("Unsupported order spec '$order'"); |
1212
|
|
|
|
|
|
|
} |
1213
|
|
|
|
|
|
|
if ( $order ) { |
1214
|
|
|
|
|
|
|
$sql .= " order by $order"; |
1215
|
|
|
|
|
|
|
} |
1216
|
|
|
|
|
|
|
} |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
my $limit = delete $clauses{limit}; |
1219
|
|
|
|
|
|
|
my $offset = delete $clauses{offset}; |
1220
|
|
|
|
|
|
|
if ( $limit or $offset) { |
1221
|
|
|
|
|
|
|
($sql, @params) = $self->sql_limit($limit, $offset, $sql, @params); |
1222
|
|
|
|
|
|
|
} |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
if ( scalar keys %clauses ) { |
1225
|
|
|
|
|
|
|
confess("Unsupported $keyword clauses: " . |
1226
|
|
|
|
|
|
|
join ', ', map "$_ ('$clauses{$_}')", keys %clauses); |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
$self->log_sql( $sql, @params ); |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
return( $sql, @params ); |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
######################################################################## |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
use DBIx::SQLEngine::Criteria; |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
sub sql_where { |
1239
|
|
|
|
|
|
|
my $self = shift; |
1240
|
|
|
|
|
|
|
my ( $criteria, $sql, @params ) = @_; |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
my ( $sql_crit, @cp ) = DBIx::SQLEngine::Criteria->auto_where( $criteria ); |
1243
|
|
|
|
|
|
|
if ( $sql_crit ) { |
1244
|
|
|
|
|
|
|
if ( ! defined $sql ) { |
1245
|
|
|
|
|
|
|
$sql = "where $sql_crit"; |
1246
|
|
|
|
|
|
|
} elsif ( $sql =~ s{(\bwhere\b)(.*?)(\border by|\bgroup by|$)} |
1247
|
|
|
|
|
|
|
{$1 ($2) AND $sql_crit $3}i ) { |
1248
|
|
|
|
|
|
|
} else { |
1249
|
|
|
|
|
|
|
$sql .= " where $sql_crit"; |
1250
|
|
|
|
|
|
|
} |
1251
|
|
|
|
|
|
|
push @params, @cp; |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
return ($sql, @params); |
1255
|
|
|
|
|
|
|
} |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
sub sql_escape_text_for_like { |
1258
|
|
|
|
|
|
|
confess("DBMS-Specific Function") |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
######################################################################## |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
# ( $sql, @params ) = $sqldb->sql_join( $table_name, $table_name, ... ); |
1264
|
|
|
|
|
|
|
# ( $sql, @params ) = $sqldb->sql_join( $table_name, \%crit, $table_name); |
1265
|
|
|
|
|
|
|
# ( $sql, @params ) = $sqldb->sql_join( $table_name, join=>\%crit, $table_name); |
1266
|
|
|
|
|
|
|
sub sql_join { |
1267
|
|
|
|
|
|
|
my ($self, @exprs) = @_; |
1268
|
|
|
|
|
|
|
my $sql = ''; |
1269
|
|
|
|
|
|
|
my @params; |
1270
|
|
|
|
|
|
|
while ( scalar @exprs ) { |
1271
|
|
|
|
|
|
|
my $expr = shift @exprs; |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
my ( $table, $join, $criteria ); |
1274
|
|
|
|
|
|
|
if ( ! ref $expr and $expr =~ /^[\w\s]+join$/i and ref($exprs[0]) ) { |
1275
|
|
|
|
|
|
|
$join = $expr; |
1276
|
|
|
|
|
|
|
$criteria = shift @exprs; |
1277
|
|
|
|
|
|
|
$table = shift @exprs; |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
} elsif ( $sql and ref($expr) eq 'HASH' ) { |
1280
|
|
|
|
|
|
|
$join = 'inner join'; |
1281
|
|
|
|
|
|
|
$criteria = $expr; |
1282
|
|
|
|
|
|
|
$table = shift @exprs; |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
} else { |
1285
|
|
|
|
|
|
|
$join = ','; |
1286
|
|
|
|
|
|
|
$criteria = undef; |
1287
|
|
|
|
|
|
|
$table = $expr; |
1288
|
|
|
|
|
|
|
} |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
( $table ) or croak("No table name provided to join to"); |
1291
|
|
|
|
|
|
|
( $join ) or croak("No join type provided for link to $table"); |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
$join =~ tr[_][ ]; |
1294
|
|
|
|
|
|
|
$sql .= ( ( length($join) == 1 ) ? '' : ' ' ) . $join; |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
my ( $expr_sql, @expr_params ); |
1297
|
|
|
|
|
|
|
if ( ! ref $table ) { |
1298
|
|
|
|
|
|
|
$expr_sql = $table |
1299
|
|
|
|
|
|
|
} elsif ( ref($table) eq 'ARRAY' ) { |
1300
|
|
|
|
|
|
|
my ( $sub_sql, @sub_params ) = $self->sql_join( @$table ); |
1301
|
|
|
|
|
|
|
$expr_sql = "( $sub_sql )"; |
1302
|
|
|
|
|
|
|
push @expr_params, @sub_params |
1303
|
|
|
|
|
|
|
} elsif ( ref($table) eq 'HASH' ) { |
1304
|
|
|
|
|
|
|
my %seen_tables; |
1305
|
|
|
|
|
|
|
my @tables = grep { ! $seen_tables{$_} ++ } map { ( /^([^\.]+)\./ )[0] } %$table; |
1306
|
|
|
|
|
|
|
if ( @tables == 2 ) { |
1307
|
|
|
|
|
|
|
my ( $sub_sql, @sub_params ) = $self->sql_join( |
1308
|
|
|
|
|
|
|
$tables[0], |
1309
|
|
|
|
|
|
|
inner_join => { map { $_ => \($table->{$_}) } keys %$table }, |
1310
|
|
|
|
|
|
|
$tables[1], |
1311
|
|
|
|
|
|
|
); |
1312
|
|
|
|
|
|
|
$expr_sql = $sub_sql; |
1313
|
|
|
|
|
|
|
push @expr_params, @sub_params |
1314
|
|
|
|
|
|
|
} else { |
1315
|
|
|
|
|
|
|
confess("sql_join on hash with more than two tables not yet supported") |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($table, 'name') ) { |
1318
|
|
|
|
|
|
|
$expr_sql = $table->name |
1319
|
|
|
|
|
|
|
} else { |
1320
|
|
|
|
|
|
|
Carp::confess("Unsupported expression in sql_join: '$table'"); |
1321
|
|
|
|
|
|
|
} |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
$sql .= " $expr_sql"; |
1324
|
|
|
|
|
|
|
push @params, @expr_params; |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
if ( $criteria ) { |
1327
|
|
|
|
|
|
|
my ($crit_sql, @crit_params) = |
1328
|
|
|
|
|
|
|
DBIx::SQLEngine::Criteria->auto_where( $criteria ); |
1329
|
|
|
|
|
|
|
if ( $crit_sql ) { |
1330
|
|
|
|
|
|
|
$sql .= " on $crit_sql"; |
1331
|
|
|
|
|
|
|
push @params, @crit_params; |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
$sql =~ s/^, // or carp("Suspect table join: '$sql'"); |
1337
|
|
|
|
|
|
|
( $sql, @params ); |
1338
|
|
|
|
|
|
|
} |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
######################################################################## |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
sub sql_limit { |
1343
|
|
|
|
|
|
|
my $self = shift; |
1344
|
|
|
|
|
|
|
my ( $limit, $offset, $sql, @params ) = @_; |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
$sql .= " limit $limit" if $limit; |
1347
|
|
|
|
|
|
|
$sql .= " offset $offset" if $offset; |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
return ($sql, @params); |
1350
|
|
|
|
|
|
|
} |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
######################################################################## |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
sub sql_union { |
1355
|
|
|
|
|
|
|
my ( $self, @queries ) = @_; |
1356
|
|
|
|
|
|
|
my ( @sql, @params ); |
1357
|
|
|
|
|
|
|
if ( $self->dbms_union_unsupported ) { |
1358
|
|
|
|
|
|
|
croak("SQL Union not supported by this database"); |
1359
|
|
|
|
|
|
|
} |
1360
|
|
|
|
|
|
|
foreach my $query ( @queries ) { |
1361
|
|
|
|
|
|
|
my ( $q_sql, @q_params ) = $self->sql_select( |
1362
|
|
|
|
|
|
|
( ref($query) eq 'ARRAY' ) ? @$query : %$query ); |
1363
|
|
|
|
|
|
|
push @sql, $q_sql; |
1364
|
|
|
|
|
|
|
push @params, @q_params; |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
return ( join( ' union ', @sql ), @params ) |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
sub detect_union_supported { |
1370
|
|
|
|
|
|
|
my $self = shift; |
1371
|
|
|
|
|
|
|
my $result = 0; |
1372
|
|
|
|
|
|
|
eval { |
1373
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
1374
|
|
|
|
|
|
|
$self->fetch_select( sql => 'select 1 union select 2' ); |
1375
|
|
|
|
|
|
|
$result = 1; |
1376
|
|
|
|
|
|
|
}; |
1377
|
|
|
|
|
|
|
return $result; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
######################################################################## |
1381
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
######################################################################## |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
=head1 EDITING DATA (SQL DML) |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
Information in a DBI database is entered and modified through the Data Manipulation Language features of SQL. |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head2 Insert to Add Data |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
B You can perform database INSERTs with these methods. |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
=over 4 |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=item do_insert() |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
$sqldb->do_insert( %sql_clauses ) : $row_count |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
Insert a single row into a table in the datasource. Should return 1, unless there's an exception. |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
=item do_bulk_insert() |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
$sqldb->do_bulk_insert( %sql_clauses, values => [ @array_or_hash_refs ] ) : $row_count |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
Inserts several rows into a table. Returns the number of rows inserted. |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
This is provided so that drivers which have alternate bulk-loader |
1407
|
|
|
|
|
|
|
interfaces can hook into that support here, and to allow specialty |
1408
|
|
|
|
|
|
|
options like C 100> in order to |
1409
|
|
|
|
|
|
|
optimize performance on servers such as Oracle, where auto-committing |
1410
|
|
|
|
|
|
|
one statement at a time is slow. |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
=back |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
B The following method is called by do_insert() and does not need to be called directly. |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=over 4 |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=item sql_insert() |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
$sqldb->sql_insert ( %sql_clauses ) : $sql_stmt, @params |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
Generate a SQL insert statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above. |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
=back |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
B: The above insert methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys: |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=over 4 |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
=item 'sql' |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
Optional; overrides all other arguments. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders. |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
=item 'named_query' |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L"NAMED QUERY CATALOG"> for details. |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
=item 'table' |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
Required. The name of the table to insert into. |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
=item 'columns' |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
Optional; defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash whose keys contain the column names, or a reference to an object with a "column_names" method. |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
=item 'values' |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
Required. May contain a string with one or more comma-separated quoted values or expressions in SQL format, or a reference to an array of values to insert in order, or a reference to a hash whose values are to be inserted. If an array or hash reference is used, each value may either be a scalar to be used as a literal value (passed via placeholder), or a reference to a scalar to be used directly (such as a sql function or other non-literal expression). |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
=item 'sequence' |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
Optional. May contain a string with the name of a column in the target table which should receive an automatically incremented value. If present, triggers use of the DMBS-specific do_insert_with_sequence() method, described below. |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
=back |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
B These samples demonstrate use of the insert feature. |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
=over 2 |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
=item * |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
Here's a simple insert using a hash of column-value pairs: |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
$sqldb->do_insert( |
1465
|
|
|
|
|
|
|
table => 'students', |
1466
|
|
|
|
|
|
|
values => { 'name'=>'Dave', 'age'=>'19', 'status'=>'minor' } |
1467
|
|
|
|
|
|
|
); |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=item * |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
Here's the same insert using separate arrays of column names and values to be inserted: |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
$sqldb->do_insert( |
1474
|
|
|
|
|
|
|
table => 'students', |
1475
|
|
|
|
|
|
|
columns => [ 'name', 'age', 'status' ], |
1476
|
|
|
|
|
|
|
values => [ 'Dave', '19', 'minor' ] |
1477
|
|
|
|
|
|
|
); |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
=item * |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
Here's a bulk insert of multiple rows: |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
$sqldb->do_insert( |
1484
|
|
|
|
|
|
|
table => 'students', |
1485
|
|
|
|
|
|
|
columns => [ 'name', 'age', 'status' ], |
1486
|
|
|
|
|
|
|
values => [ |
1487
|
|
|
|
|
|
|
[ 'Dave', '19', 'minor' ], |
1488
|
|
|
|
|
|
|
[ 'Alice', '20', 'minor' ], |
1489
|
|
|
|
|
|
|
[ 'Sam', '22', 'adult' ], |
1490
|
|
|
|
|
|
|
] |
1491
|
|
|
|
|
|
|
); |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
=item * |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
Of course you can also use your own arbitrary SQL and placeholder parameters. |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
$sqldb->do_insert( |
1498
|
|
|
|
|
|
|
sql=>['insert into students (id, name) values (?, ?)', 201, 'Dave'] |
1499
|
|
|
|
|
|
|
); |
1500
|
|
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
=item * |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
And the named_query interface is supported as well: |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
$sqldb->define_named_query( |
1506
|
|
|
|
|
|
|
'insert_student' => 'insert into students (id, name) values (?, ?)' |
1507
|
|
|
|
|
|
|
); |
1508
|
|
|
|
|
|
|
$hashes = $sqldb->do_insert( |
1509
|
|
|
|
|
|
|
named_query => [ 'insert_student', 201, 'Dave' ] |
1510
|
|
|
|
|
|
|
); |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=back |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
=cut |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
# $rows = $self->do_insert( %clauses ); |
1517
|
|
|
|
|
|
|
sub do_insert { |
1518
|
|
|
|
|
|
|
my $self = shift; |
1519
|
|
|
|
|
|
|
my %args = @_; |
1520
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
if ( my $seq_name = delete $args{sequence} ) { |
1522
|
|
|
|
|
|
|
$self->do_insert_with_sequence( $seq_name, %args ); |
1523
|
|
|
|
|
|
|
} else { |
1524
|
|
|
|
|
|
|
$self->do_sql( $self->sql_insert( @_ ) ); |
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
sub do_bulk_insert { |
1529
|
|
|
|
|
|
|
my $self = shift; |
1530
|
|
|
|
|
|
|
my %args = @_; |
1531
|
|
|
|
|
|
|
my $values = delete $args{values}; |
1532
|
|
|
|
|
|
|
foreach my $value ( @$values ) { |
1533
|
|
|
|
|
|
|
$self->do_insert( %args, values => $value ); |
1534
|
|
|
|
|
|
|
} |
1535
|
|
|
|
|
|
|
} |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
sub sql_insert { |
1538
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
my $keyword = 'insert'; |
1541
|
|
|
|
|
|
|
my ($sql, @params); |
1542
|
|
|
|
|
|
|
|
1543
|
|
|
|
|
|
|
if ( my $named = delete $clauses{'named_query'} ) { |
1544
|
|
|
|
|
|
|
my %named = $self->interpret_named_query( ref($named) ? @$named : $named ); |
1545
|
|
|
|
|
|
|
%clauses = ( %named, %clauses ); |
1546
|
|
|
|
|
|
|
} |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
if ( my $action = delete $clauses{'action'} ) { |
1549
|
|
|
|
|
|
|
confess("Action mismatch: expecting $keyword, not $action query") |
1550
|
|
|
|
|
|
|
unless ( $action eq $keyword ); |
1551
|
|
|
|
|
|
|
} |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
if ( my $literal = delete $clauses{'sql'} ) { |
1554
|
|
|
|
|
|
|
return ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal; |
1555
|
|
|
|
|
|
|
} |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
my $table = delete $clauses{'table'}; |
1558
|
|
|
|
|
|
|
if ( ! $table ) { |
1559
|
|
|
|
|
|
|
confess("Table name is missing or empty"); |
1560
|
|
|
|
|
|
|
} elsif ( ! ref( $table ) and length( $table ) ) { |
1561
|
|
|
|
|
|
|
# should be a single table name |
1562
|
|
|
|
|
|
|
} else { |
1563
|
|
|
|
|
|
|
confess("Unsupported table spec '$table'"); |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
$sql = "insert into $table"; |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
my $columns = delete $clauses{'columns'}; |
1568
|
|
|
|
|
|
|
if ( ! $columns and UNIVERSAL::isa( $clauses{'values'}, 'HASH' ) ) { |
1569
|
|
|
|
|
|
|
$columns = $clauses{'values'} |
1570
|
|
|
|
|
|
|
} |
1571
|
|
|
|
|
|
|
if ( ! $columns or $columns eq '*' ) { |
1572
|
|
|
|
|
|
|
$columns = ''; |
1573
|
|
|
|
|
|
|
} elsif ( ! ref( $columns ) and length( $columns ) ) { |
1574
|
|
|
|
|
|
|
# should be one or more comma-separated column names |
1575
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($columns, 'column_names') ) { |
1576
|
|
|
|
|
|
|
$columns = join ', ', $columns->column_names; |
1577
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'HASH' ) { |
1578
|
|
|
|
|
|
|
$columns = join ', ', sort keys %$columns; |
1579
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'ARRAY' ) { |
1580
|
|
|
|
|
|
|
$columns = join ', ', @$columns; |
1581
|
|
|
|
|
|
|
} else { |
1582
|
|
|
|
|
|
|
confess("Unsupported column spec '$columns'"); |
1583
|
|
|
|
|
|
|
} |
1584
|
|
|
|
|
|
|
if ( $columns ) { |
1585
|
|
|
|
|
|
|
$sql .= " ($columns)"; |
1586
|
|
|
|
|
|
|
} |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
my $values = delete $clauses{'values'}; |
1589
|
|
|
|
|
|
|
my @value_args; |
1590
|
|
|
|
|
|
|
if ( ! defined $values or ! length $values ) { |
1591
|
|
|
|
|
|
|
croak("Values are missing or empty"); |
1592
|
|
|
|
|
|
|
} elsif ( ! ref( $values ) and length( $values ) ) { |
1593
|
|
|
|
|
|
|
# should be one or more comma-separated quoted values or expressions |
1594
|
|
|
|
|
|
|
@value_args = \$values; |
1595
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::isa( $values, 'HASH' ) ) { |
1596
|
|
|
|
|
|
|
@value_args = map $values->{$_}, split /,\s?/, $columns; |
1597
|
|
|
|
|
|
|
} elsif ( ref($values) eq 'ARRAY' ) { |
1598
|
|
|
|
|
|
|
@value_args = @$values; |
1599
|
|
|
|
|
|
|
} else { |
1600
|
|
|
|
|
|
|
confess("Unsupported values spec '$values'"); |
1601
|
|
|
|
|
|
|
} |
1602
|
|
|
|
|
|
|
( scalar @value_args ) or croak("Values are missing or empty"); |
1603
|
|
|
|
|
|
|
my @v_literals; |
1604
|
|
|
|
|
|
|
my @v_params; |
1605
|
|
|
|
|
|
|
foreach my $v ( @value_args ) { |
1606
|
|
|
|
|
|
|
if ( ! defined($v) ) { |
1607
|
|
|
|
|
|
|
push @v_literals, 'NULL'; |
1608
|
|
|
|
|
|
|
} elsif ( ! ref($v) ) { |
1609
|
|
|
|
|
|
|
push @v_literals, '?'; |
1610
|
|
|
|
|
|
|
push @v_params, $v; |
1611
|
|
|
|
|
|
|
} elsif ( ref($v) eq 'SCALAR' ) { |
1612
|
|
|
|
|
|
|
push @v_literals, $$v; |
1613
|
|
|
|
|
|
|
} else { |
1614
|
|
|
|
|
|
|
Carp::confess( "Can't use '$v' as part of a sql values clause" ); |
1615
|
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
$values = join ', ', @v_literals; |
1618
|
|
|
|
|
|
|
$sql .= " values ($values)"; |
1619
|
|
|
|
|
|
|
push @params, @v_params; |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
if ( scalar keys %clauses ) { |
1622
|
|
|
|
|
|
|
confess("Unsupported $keyword clauses: " . |
1623
|
|
|
|
|
|
|
join ', ', map "$_ ('$clauses{$_}')", keys %clauses); |
1624
|
|
|
|
|
|
|
} |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
$self->log_sql( $sql, @params ); |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
return( $sql, @params ); |
1629
|
|
|
|
|
|
|
} |
1630
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
######################################################################## |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=pod |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
B The following methods are called by do_insert() and do not need to be called directly. |
1636
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
=over 4 |
1638
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
=item do_insert_with_sequence() |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
$sqldb->do_insert_with_sequence( $seq_name, %sql_clauses ) : $row_count |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
Insert a single row into a table in the datasource, using a sequence to fill in the values of the column named in the first argument. Should return 1, unless there's an exception. |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
1646
|
|
|
|
|
|
|
|
1647
|
|
|
|
|
|
|
B Auto-incrementing sequences are handled differently by various DBMS platforms. For example, the MySQL and MSSQL subclasses use auto-incrementing fields, Oracle and Pg use server-specific sequence objects, and AnyData and CSV lack this capability, which can be emulated with an ad-hoc table of incrementing values. |
1648
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
To standardize their use, this package defines an interface with several typical methods which may or may not be supported by individual subclasses. You may need to consult the documentation for the SQLEngine Driver subclass and DBMS platform you're using to confirm that the sequence functionality you need is available. |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
Drivers which don't support native sequences may provide a degree of emulation; for one implementation of this, see L. |
1652
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
Subclasses will probably want to call either the _seq_do_insert_preinc() method or the _seq_do_insert_postfetch() method, and define the appropriate other seq_* methods to support them. These two methods are not part of the public interface but instead provide a template for the two most common types of insert-with-sequence behavior. The _seq_do_insert_preinc() method first obtaines a new number from the sequence using seq_increment(), and then performs a normal do_insert(). The _seq_do_insert_postfetch() method performs a normal do_insert() and then fetches the resulting value that was automatically incremented using seq_fetch_current(). |
1654
|
|
|
|
|
|
|
|
1655
|
|
|
|
|
|
|
=item seq_fetch_current() |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
$sqldb->seq_fetch_current( $table, $field ) : $current_value |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
Fetches the current sequence value. |
1660
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
1662
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
=item seq_increment() |
1664
|
|
|
|
|
|
|
|
1665
|
|
|
|
|
|
|
$sqldb->seq_increment( $table, $field ) : $new_value |
1666
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
Increments the sequence, and returns the newly allocated value. |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=back |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
=cut |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
# $self->do_insert_with_sequence( $seq_name, %args ); |
1676
|
|
|
|
|
|
|
sub do_insert_with_sequence { |
1677
|
|
|
|
|
|
|
confess("DBMS-Specific Function") |
1678
|
|
|
|
|
|
|
} |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
# $rows = $self->_seq_do_insert_preinc( $sequence, %clauses ); |
1681
|
|
|
|
|
|
|
sub _seq_do_insert_preinc { |
1682
|
|
|
|
|
|
|
my ($self, $seq_name, %args) = @_; |
1683
|
|
|
|
|
|
|
|
1684
|
|
|
|
|
|
|
unless ( UNIVERSAL::isa($args{values}, 'HASH') ) { |
1685
|
|
|
|
|
|
|
croak ref($self) . " insert with sequence requires values to be hash-ref" |
1686
|
|
|
|
|
|
|
} |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
$args{values}->{$seq_name} = $self->seq_increment( $args{table}, $seq_name ); |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
$self->do_insert( %args ); |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
# $rows = $self->_seq_do_insert_postfetch( $sequence, %clauses ); |
1694
|
|
|
|
|
|
|
sub _seq_do_insert_postfetch { |
1695
|
|
|
|
|
|
|
my ($self, $seq_name, %args) = @_; |
1696
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
unless ( UNIVERSAL::isa($args{values}, 'HASH') ) { |
1698
|
|
|
|
|
|
|
croak ref($self) . " insert with sequence requires values to be hash-ref" |
1699
|
|
|
|
|
|
|
} |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
my $rv = $self->do_insert( %args ); |
1702
|
|
|
|
|
|
|
$args{values}->{$seq_name} = $self->seq_fetch_current($args{table},$seq_name); |
1703
|
|
|
|
|
|
|
return $rv; |
1704
|
|
|
|
|
|
|
} |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
# $current_id = $sqldb->seq_fetch_current( $table, $field ); |
1707
|
|
|
|
|
|
|
sub seq_fetch_current { |
1708
|
|
|
|
|
|
|
confess("DBMS-Specific Function") |
1709
|
|
|
|
|
|
|
} |
1710
|
|
|
|
|
|
|
|
1711
|
|
|
|
|
|
|
# $nextid = $sqldb->seq_increment( $table, $field ); |
1712
|
|
|
|
|
|
|
sub seq_increment { |
1713
|
|
|
|
|
|
|
confess("DBMS-Specific Function") |
1714
|
|
|
|
|
|
|
} |
1715
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
######################################################################## |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head2 Update to Change Data |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
B You can perform database UPDATEs with these methods. |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
=over 4 |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
=item do_update() |
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
$sqldb->do_update( %sql_clauses ) : $row_count |
1727
|
|
|
|
|
|
|
|
1728
|
|
|
|
|
|
|
Modify one or more rows in a table in the datasource. |
1729
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
=back |
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
B These methods are called by the public update method. |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
=over 4 |
1735
|
|
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
=item sql_update() |
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
$sqldb->sql_update ( %sql_clauses ) : $sql_stmt, @params |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
Generate a SQL update statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above. |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
=back |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
B: The above update methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys: |
1745
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
=over 4 |
1747
|
|
|
|
|
|
|
|
1748
|
|
|
|
|
|
|
=item 'sql' |
1749
|
|
|
|
|
|
|
|
1750
|
|
|
|
|
|
|
Optional; conflicts with table, columns and values arguments. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders. |
1751
|
|
|
|
|
|
|
|
1752
|
|
|
|
|
|
|
=item 'named_query' |
1753
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L"NAMED QUERY CATALOG"> for details. |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
=item 'table' |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
Required unless sql argument is used. The name of the table to update. |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
=item 'columns' |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
Optional unless sql argument is used. Defaults to '*'. May contain a comma-separated string of column names, or an reference to an array of column names, or a reference to a hash whose keys contain the column names, or a reference to an object with a "column_names" method. |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
=item 'values' |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
Required unless sql argument is used. May contain a string with one or more comma-separated quoted values or expressions in SQL format, or a reference to an array of values to insert in order, or a reference to a hash whose values are to be inserted. If an array or hash reference is used, each value may either be a scalar to be used as a literal value (passed via placeholder), or a reference to a scalar to be used directly (such as a sql function or other non-literal expression). |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
=item 'where' I 'criteria' |
1769
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
Optional, but remember that ommitting this will cause all of your rows to be updated! May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details. |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
=back |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
B These samples demonstrate use of the update feature. |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
=over 2 |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
=item * |
1779
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
Here's a basic update statement with a hash of columns-value pairs to change: |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
$sqldb->do_update( |
1783
|
|
|
|
|
|
|
table => 'students', |
1784
|
|
|
|
|
|
|
where => 'age > 20', |
1785
|
|
|
|
|
|
|
values => { 'status'=>'adult' } |
1786
|
|
|
|
|
|
|
); |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
=item * |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
Here's an equivalent update statement using separate lists of columns and values: |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
$sqldb->do_update( |
1793
|
|
|
|
|
|
|
table => 'students', |
1794
|
|
|
|
|
|
|
where => 'age > 20', |
1795
|
|
|
|
|
|
|
columns => [ 'status' ], |
1796
|
|
|
|
|
|
|
values => [ 'adult' ] |
1797
|
|
|
|
|
|
|
); |
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
=item * |
1800
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
You can also use your own arbitrary SQL statements and placeholders: |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
$sqldb->do_update( |
1804
|
|
|
|
|
|
|
sql=>['update students set status = ? where age > ?', 'adult', 20] |
1805
|
|
|
|
|
|
|
); |
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
=item * |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
And the named_query interface is supported as well: |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
$sqldb->define_named_query( |
1812
|
|
|
|
|
|
|
'update_minors' => |
1813
|
|
|
|
|
|
|
[ 'update students set status = ? where age > ?', 'adult', 20 ] |
1814
|
|
|
|
|
|
|
); |
1815
|
|
|
|
|
|
|
$hashes = $sqldb->do_update( |
1816
|
|
|
|
|
|
|
named_query => 'update_minors' |
1817
|
|
|
|
|
|
|
); |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
=back |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
=cut |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
# $rows = $self->do_update( %clauses ); |
1824
|
|
|
|
|
|
|
sub do_update { |
1825
|
|
|
|
|
|
|
my $self = shift; |
1826
|
|
|
|
|
|
|
$self->do_sql( $self->sql_update( @_ ) ); |
1827
|
|
|
|
|
|
|
} |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
sub sql_update { |
1830
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
my $keyword = 'update'; |
1833
|
|
|
|
|
|
|
my ($sql, @params); |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
if ( my $named = delete $clauses{'named_query'} ) { |
1836
|
|
|
|
|
|
|
my %named = $self->interpret_named_query( ref($named) ? @$named : $named ); |
1837
|
|
|
|
|
|
|
%clauses = ( %named, %clauses ); |
1838
|
|
|
|
|
|
|
} |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
if ( my $action = delete $clauses{'action'} ) { |
1841
|
|
|
|
|
|
|
confess("Action mismatch: expecting $keyword, not $action query") |
1842
|
|
|
|
|
|
|
unless ( $action eq $keyword ); |
1843
|
|
|
|
|
|
|
} |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
if ( my $literal = delete $clauses{'sql'} ) { |
1846
|
|
|
|
|
|
|
($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal; |
1847
|
|
|
|
|
|
|
if ( my ( $conflict ) = grep $clauses{$_}, qw/ table columns values / ) { |
1848
|
|
|
|
|
|
|
croak("Can't build a $keyword query using both sql and $conflict clauses") |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
} else { |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
my $table = delete $clauses{'table'}; |
1854
|
|
|
|
|
|
|
if ( ! $table ) { |
1855
|
|
|
|
|
|
|
confess("Table name is missing or empty"); |
1856
|
|
|
|
|
|
|
} elsif ( ! ref( $table ) and length( $table ) ) { |
1857
|
|
|
|
|
|
|
# should be a single table name |
1858
|
|
|
|
|
|
|
} else { |
1859
|
|
|
|
|
|
|
confess("Unsupported table spec '$table'"); |
1860
|
|
|
|
|
|
|
} |
1861
|
|
|
|
|
|
|
$sql = "update $table"; |
1862
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
my $columns = delete $clauses{'columns'}; |
1864
|
|
|
|
|
|
|
if ( ! $columns and UNIVERSAL::isa( $clauses{'values'}, 'HASH' ) ) { |
1865
|
|
|
|
|
|
|
$columns = $clauses{'values'} |
1866
|
|
|
|
|
|
|
} |
1867
|
|
|
|
|
|
|
my @columns; |
1868
|
|
|
|
|
|
|
if ( ! $columns or $columns eq '*' ) { |
1869
|
|
|
|
|
|
|
croak("Column names are missing or empty"); |
1870
|
|
|
|
|
|
|
} elsif ( ! ref( $columns ) and length( $columns ) ) { |
1871
|
|
|
|
|
|
|
# should be one or more comma-separated column names |
1872
|
|
|
|
|
|
|
@columns = split /,\s?/, $columns; |
1873
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($columns, 'column_names') ) { |
1874
|
|
|
|
|
|
|
@columns = $columns->column_names; |
1875
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'HASH' ) { |
1876
|
|
|
|
|
|
|
@columns = sort keys %$columns; |
1877
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'ARRAY' ) { |
1878
|
|
|
|
|
|
|
@columns = @$columns; |
1879
|
|
|
|
|
|
|
} else { |
1880
|
|
|
|
|
|
|
confess("Unsupported column spec '$columns'"); |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
my $values = delete $clauses{'values'}; |
1884
|
|
|
|
|
|
|
my @value_args; |
1885
|
|
|
|
|
|
|
if ( ! $values ) { |
1886
|
|
|
|
|
|
|
croak("Values are missing or empty"); |
1887
|
|
|
|
|
|
|
} elsif ( ! ref( $values ) and length( $values ) ) { |
1888
|
|
|
|
|
|
|
confess("Unsupported values clause!"); |
1889
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::isa( $values, 'HASH' ) ) { |
1890
|
|
|
|
|
|
|
@value_args = map $values->{$_}, @columns; |
1891
|
|
|
|
|
|
|
} elsif ( ref($values) eq 'ARRAY' ) { |
1892
|
|
|
|
|
|
|
@value_args = @$values; |
1893
|
|
|
|
|
|
|
} else { |
1894
|
|
|
|
|
|
|
confess("Unsupported values spec '$values'"); |
1895
|
|
|
|
|
|
|
} |
1896
|
|
|
|
|
|
|
( scalar @value_args ) or croak("Values are missing or empty"); |
1897
|
|
|
|
|
|
|
my @values; |
1898
|
|
|
|
|
|
|
my @v_params; |
1899
|
|
|
|
|
|
|
foreach my $v ( @value_args ) { |
1900
|
|
|
|
|
|
|
if ( ! defined($v) ) { |
1901
|
|
|
|
|
|
|
push @values, 'NULL'; |
1902
|
|
|
|
|
|
|
} elsif ( ! ref($v) ) { |
1903
|
|
|
|
|
|
|
push @values, '?'; |
1904
|
|
|
|
|
|
|
push @v_params, $v; |
1905
|
|
|
|
|
|
|
} elsif ( ref($v) eq 'SCALAR' ) { |
1906
|
|
|
|
|
|
|
push @values, $$v; |
1907
|
|
|
|
|
|
|
} else { |
1908
|
|
|
|
|
|
|
Carp::confess( "Can't use '$v' as part of a sql values clause" ); |
1909
|
|
|
|
|
|
|
} |
1910
|
|
|
|
|
|
|
} |
1911
|
|
|
|
|
|
|
$sql .= " set " . join ', ', map "$columns[$_] = $values[$_]", 0 .. $#columns; |
1912
|
|
|
|
|
|
|
push @params, @v_params; |
1913
|
|
|
|
|
|
|
} |
1914
|
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
|
if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){ |
1916
|
|
|
|
|
|
|
($sql, @params) = $self->sql_where($criteria, $sql, @params); |
1917
|
|
|
|
|
|
|
} |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
if ( scalar keys %clauses ) { |
1920
|
|
|
|
|
|
|
confess("Unsupported $keyword clauses: " . |
1921
|
|
|
|
|
|
|
join ', ', map "$_ ('$clauses{$_}')", keys %clauses); |
1922
|
|
|
|
|
|
|
} |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
$self->log_sql( $sql, @params ); |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
return( $sql, @params ); |
1927
|
|
|
|
|
|
|
} |
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
######################################################################## |
1930
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
=head2 Delete to Remove Data |
1932
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
B You can perform database DELETEs with these methods. |
1934
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
=over 4 |
1936
|
|
|
|
|
|
|
|
1937
|
|
|
|
|
|
|
=item do_delete() |
1938
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
$sqldb->do_delete( %sql_clauses ) : $row_count |
1940
|
|
|
|
|
|
|
|
1941
|
|
|
|
|
|
|
Delete one or more rows in a table in the datasource. |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
=back |
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
B These methods are called by the public delete methods. |
1946
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
=over 4 |
1948
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
=item sql_delete() |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
$sqldb->sql_delete ( %sql_clauses ) : $sql_stmt, @params |
1952
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
Generate a SQL delete statement and returns it as a query string and a list of values to be bound as parameters. Internally, this sql_ method is used by the do_ method above. |
1954
|
|
|
|
|
|
|
|
1955
|
|
|
|
|
|
|
=back |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
B: The above delete methods accept a hash describing the clauses of the SQL statement they are to generate, and require a value for one or more of the following keys: |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
=over 4 |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
=item 'sql' |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
Optional; conflicts with 'table' argument. May contain a plain SQL statement to be executed, or a reference to an array of a SQL statement followed by parameters for embedded placeholders. |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
=item 'named_query' |
1966
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
Uses the named_query catalog to build the query. May contain a defined query name, or a reference to an array of a query name followed by parameters to be handled by interpret_named_query. See L"NAMED QUERY CATALOG"> for details. |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
=item 'table' |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
Required unless explicit "sql => ..." is used. The name of the table to delete from. |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
=item 'where' I 'criteria' |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
Optional, but remember that ommitting this will cause all of your rows to be deleted! May contain a literal SQL where clause, an array ref with a SQL clause and parameter list, a hash of field => value pairs, or an object that supports a sql_where() method. See the sql_where() method for details. |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
=back |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
B These samples demonstrate use of the delete feature. |
1980
|
|
|
|
|
|
|
|
1981
|
|
|
|
|
|
|
=over 2 |
1982
|
|
|
|
|
|
|
|
1983
|
|
|
|
|
|
|
=item * |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
Here's a basic delete with a table name and criteria. |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
$sqldb->do_delete( |
1988
|
|
|
|
|
|
|
table => 'students', where => { 'name'=>'Dave' } |
1989
|
|
|
|
|
|
|
); |
1990
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
=item * |
1992
|
|
|
|
|
|
|
|
1993
|
|
|
|
|
|
|
You can use your own arbitrary SQL and placeholders: |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
$sqldb->do_delete( |
1996
|
|
|
|
|
|
|
sql => [ 'delete from students where name = ?', 'Dave' ] |
1997
|
|
|
|
|
|
|
); |
1998
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
=item * |
2000
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
You can combine an explicit delete statement with dynamic criteria: |
2002
|
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
|
$sqldb->do_delete( |
2004
|
|
|
|
|
|
|
sql => 'delete from students', where => { 'name'=>'Dave' } |
2005
|
|
|
|
|
|
|
); |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
=item * |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
And the named_query interface is supported as well: |
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
$sqldb->define_named_query( |
2012
|
|
|
|
|
|
|
'delete_by_name' => 'delete from students where name = ?' |
2013
|
|
|
|
|
|
|
); |
2014
|
|
|
|
|
|
|
$hashes = $sqldb->do_delete( |
2015
|
|
|
|
|
|
|
named_query => [ 'delete_by_name', 'Dave' ] |
2016
|
|
|
|
|
|
|
); |
2017
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
=back |
2019
|
|
|
|
|
|
|
|
2020
|
|
|
|
|
|
|
=cut |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
# $rows = $self->do_delete( %clauses ); |
2023
|
|
|
|
|
|
|
sub do_delete { |
2024
|
|
|
|
|
|
|
my $self = shift; |
2025
|
|
|
|
|
|
|
$self->do_sql( $self->sql_delete( @_ ) ); |
2026
|
|
|
|
|
|
|
} |
2027
|
|
|
|
|
|
|
|
2028
|
|
|
|
|
|
|
sub sql_delete { |
2029
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
2030
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
my $keyword = 'delete'; |
2032
|
|
|
|
|
|
|
my ($sql, @params); |
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
if ( my $named = delete $clauses{'named_query'} ) { |
2035
|
|
|
|
|
|
|
my %named = $self->interpret_named_query( ref($named) ? @$named : $named ); |
2036
|
|
|
|
|
|
|
%clauses = ( %named, %clauses ); |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
if ( my $action = delete $clauses{'action'} ) { |
2040
|
|
|
|
|
|
|
confess("Action mismatch: expecting $keyword, not $action query") |
2041
|
|
|
|
|
|
|
unless ( $action eq $keyword ); |
2042
|
|
|
|
|
|
|
} |
2043
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
if ( my $literal = delete $clauses{'sql'} ) { |
2045
|
|
|
|
|
|
|
($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal; |
2046
|
|
|
|
|
|
|
if ( my ( $conflict ) = grep $clauses{$_}, qw/ table / ) { |
2047
|
|
|
|
|
|
|
croak("Can't build a $keyword query using both sql and $conflict clauses") |
2048
|
|
|
|
|
|
|
} |
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
} else { |
2051
|
|
|
|
|
|
|
|
2052
|
|
|
|
|
|
|
my $table = delete $clauses{'table'}; |
2053
|
|
|
|
|
|
|
if ( ! $table ) { |
2054
|
|
|
|
|
|
|
confess("Table name is missing or empty"); |
2055
|
|
|
|
|
|
|
} elsif ( ! ref( $table ) and length( $table ) ) { |
2056
|
|
|
|
|
|
|
# should be a single table name |
2057
|
|
|
|
|
|
|
} else { |
2058
|
|
|
|
|
|
|
confess("Unsupported table spec '$table'"); |
2059
|
|
|
|
|
|
|
} |
2060
|
|
|
|
|
|
|
$sql = "delete from $table"; |
2061
|
|
|
|
|
|
|
} |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
if ( my $criteria = delete $clauses{'criteria'} || delete $clauses{'where'} ){ |
2064
|
|
|
|
|
|
|
($sql, @params) = $self->sql_where($criteria, $sql, @params); |
2065
|
|
|
|
|
|
|
} |
2066
|
|
|
|
|
|
|
|
2067
|
|
|
|
|
|
|
if ( scalar keys %clauses ) { |
2068
|
|
|
|
|
|
|
confess("Unsupported $keyword clauses: " . |
2069
|
|
|
|
|
|
|
join ', ', map "$_ ('$clauses{$_}')", keys %clauses); |
2070
|
|
|
|
|
|
|
} |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
$self->log_sql( $sql, @params ); |
2073
|
|
|
|
|
|
|
|
2074
|
|
|
|
|
|
|
return( $sql, @params ); |
2075
|
|
|
|
|
|
|
} |
2076
|
|
|
|
|
|
|
|
2077
|
|
|
|
|
|
|
######################################################################## |
2078
|
|
|
|
|
|
|
|
2079
|
|
|
|
|
|
|
######################################################################## |
2080
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
=head1 NAMED QUERY CATALOG |
2082
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
The following methods manage a collection of named query definitions. |
2084
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
=head2 Defining Named Queries |
2086
|
|
|
|
|
|
|
|
2087
|
|
|
|
|
|
|
B Call these methods to load your query definitions. |
2088
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
=over 4 |
2090
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
=item define_named_queries() |
2092
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
$sqldb->define_named_query( $query_name, $query_info ) |
2094
|
|
|
|
|
|
|
$sqldb->define_named_queries( $query_name, $query_info, ... ) |
2095
|
|
|
|
|
|
|
$sqldb->define_named_queries( %query_names_and_info ) |
2096
|
|
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
Defines one or more named queries using the names and definitions provided. |
2098
|
|
|
|
|
|
|
|
2099
|
|
|
|
|
|
|
The definition for each query is expected to be in one of the following formats: |
2100
|
|
|
|
|
|
|
|
2101
|
|
|
|
|
|
|
=over 4 |
2102
|
|
|
|
|
|
|
|
2103
|
|
|
|
|
|
|
=item * |
2104
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
A literal SQL string. May contain "?" placeholders whose values will be passed as arguments when the query is run. |
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
=item * |
2108
|
|
|
|
|
|
|
|
2109
|
|
|
|
|
|
|
A reference to an array of a SQL string and placeholder parameters. Parameters which should later be replaced by per-query arguments can be represented by references to the special Perl variables $1, $2, $3, and so forth, corresponding to the order and number of parameters to be supplied. |
2110
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
=item * |
2112
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
A reference to a hash of clauses supported by one of the SQL generation methods. Items which should later be replaced by per-query arguments can be represented by references to the special Perl variables $1, $2, $3, and so forth. |
2114
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
=item * |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
A reference to a subroutine or code block which will process the user-supplied arguments and return either a SQL statement, a reference to an array of a SQL statement and associated parameters, or a list of key-value pairs to be used as clauses by the SQL generation methods. |
2118
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
=back |
2120
|
|
|
|
|
|
|
|
2121
|
|
|
|
|
|
|
|
2122
|
|
|
|
|
|
|
=item define_named_queries_from_text() |
2123
|
|
|
|
|
|
|
|
2124
|
|
|
|
|
|
|
$sqldb->define_named_queries_from_text($query_name, $query_info_text) |
2125
|
|
|
|
|
|
|
$sqldb->define_named_queries_from_text(%query_names_and_info_text) |
2126
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
Defines one or more queries, using some special processing to facilitate storing dynamic query definitions in an external source such as a text file or database table. |
2128
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
The interpretation of each definition is determined by its first non-whitespace character: |
2130
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
=over 4 |
2132
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
=item * |
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
Definitions which begin with a [ or { character are presumed to contain an array or hash definition and are evaluated immediately. |
2136
|
|
|
|
|
|
|
|
2137
|
|
|
|
|
|
|
=item * |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
Definitions which begin with a " or ; character are presumed to contain a code definition and evaluated as the contents of an anonymous subroutine. |
2140
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
=item * |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
Other definitions are assumed to contain a plain SQL statement. |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
=back |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
All evaluations are done via a Safe compartment, which is required when this function is first used, so the code is extremely limited and can not call most other functions. |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
=back |
2150
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
=cut |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
# $sqldb->define_named_queries( $name, $string_hash_or_sub ) |
2154
|
|
|
|
|
|
|
sub define_named_queries { |
2155
|
|
|
|
|
|
|
my $self = shift; |
2156
|
|
|
|
|
|
|
while ( scalar @_ ) { |
2157
|
|
|
|
|
|
|
$self->named_queries( splice( @_, 0, 2 ) ) |
2158
|
|
|
|
|
|
|
} |
2159
|
|
|
|
|
|
|
} |
2160
|
|
|
|
|
|
|
sub define_named_query { (shift)->define_named_queries(@_) } |
2161
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
# $sqldb->define_named_queries_from_text( $name, $string ) |
2163
|
|
|
|
|
|
|
sub define_named_queries_from_text { |
2164
|
|
|
|
|
|
|
my $self = shift; |
2165
|
|
|
|
|
|
|
while ( scalar @_ ) { |
2166
|
|
|
|
|
|
|
my ( $name, $text ) = splice( @_, 0, 2 ); |
2167
|
|
|
|
|
|
|
my $query_def = do { |
2168
|
|
|
|
|
|
|
if ( $text =~ /^\s*[\[|\{]/ ) { |
2169
|
|
|
|
|
|
|
safe_eval_with_parameters( $text ); |
2170
|
|
|
|
|
|
|
} elsif ( $text =~ /^\s*[\"|\;]/ ) { |
2171
|
|
|
|
|
|
|
safe_eval_with_parameters( "sub { $text }" ); |
2172
|
|
|
|
|
|
|
} else { |
2173
|
|
|
|
|
|
|
$text |
2174
|
|
|
|
|
|
|
} |
2175
|
|
|
|
|
|
|
}; |
2176
|
|
|
|
|
|
|
$self->define_named_queries( $name, $query_def ); |
2177
|
|
|
|
|
|
|
} |
2178
|
|
|
|
|
|
|
} |
2179
|
|
|
|
|
|
|
|
2180
|
|
|
|
|
|
|
######################################################################## |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
=head2 Interpreting Named Queries |
2183
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
B These methods are called internally when named queries are used. |
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
=over 4 |
2187
|
|
|
|
|
|
|
|
2188
|
|
|
|
|
|
|
=item named_queries() |
2189
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
$sqldb->named_queries() : %query_names_and_info |
2191
|
|
|
|
|
|
|
$sqldb->named_queries( $query_name ) : $query_info |
2192
|
|
|
|
|
|
|
$sqldb->named_queries( \@query_names ) : @query_info |
2193
|
|
|
|
|
|
|
$sqldb->named_queries( $query_name, $query_info, ... ) |
2194
|
|
|
|
|
|
|
$sqldb->named_queries( \%query_names_and_info ) |
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
Accessor and mutator for a hash mappping query names to their definitions. |
2197
|
|
|
|
|
|
|
Used internally by the other named_query methods. Created with |
2198
|
|
|
|
|
|
|
Class::MakeMethods::Standard::Inheritable, so if called as a class method, |
2199
|
|
|
|
|
|
|
uses class-wide values, and if called on an instance defaults to its class' |
2200
|
|
|
|
|
|
|
value but may be overridden. |
2201
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
=item named_query() |
2203
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
$sqldb->named_query( $query_name ) : $query_info |
2205
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
Retrieves the query definition matching the name provided. Croaks if no query has been defined for that name. |
2207
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
=item interpret_named_query() |
2209
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
$sqldb->interpret_named_query( $query_name, @params ) : %clauses |
2211
|
|
|
|
|
|
|
|
2212
|
|
|
|
|
|
|
Combines the query definition matching the name provided with the following arguments and returns the resulting hash of query clauses. Croaks if no query has been defined for that name. |
2213
|
|
|
|
|
|
|
|
2214
|
|
|
|
|
|
|
Depending on the definition associated with the name, it is combined with the provided parameters in one the following ways: |
2215
|
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
|
=over 4 |
2217
|
|
|
|
|
|
|
|
2218
|
|
|
|
|
|
|
=item * |
2219
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
A string. Any user-supplied parameters are assumed to be values for embedded "?"-style placeholders. Any parameters passed to interpret_named_query() are collected with the SQL statement in an array reference and returned as the value of a C key pair for execution. There is no check that the number of parameters match the number of placeholders. |
2221
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
=item * |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
A reference to an array, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the array, substituting the connection parameters in place of the placeholder references. The array reference is returned as the value of a C key pair for execution. An exception is thrown if the number of parameters provided does not match the number of special variables referred to. |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
=item * |
2227
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
A reference to an hash, possibly with embedded placeholders in the C<\$1> style described above. Uses clone_with_parameters() to make and return a copy of the hash, substituting the connection parameters in place of the placeholder references. An exception is thrown if the number of parameters provided does not match the number of special variables referred to. |
2229
|
|
|
|
|
|
|
|
2230
|
|
|
|
|
|
|
=item * |
2231
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
A reference to a subroutine. The parameters are passed |
2233
|
|
|
|
|
|
|
along to the subroutine and its results returned for execution. The subroutine may return a SQL statement, a reference to an array of a SQL statement and associated parameters, or a list of key-value pairs to be used as clauses by the SQL generation methods. |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
=back |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
For more information about the parameter replacement and argument count checking, see the clone_with_parameters() function from L. |
2238
|
|
|
|
|
|
|
|
2239
|
|
|
|
|
|
|
=back |
2240
|
|
|
|
|
|
|
|
2241
|
|
|
|
|
|
|
See the Examples section below for illustrations of these various options. |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
=cut |
2244
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
use Class::MakeMethods ( 'Standard::Inheritable:hash' => 'named_queries' ); |
2246
|
|
|
|
|
|
|
|
2247
|
|
|
|
|
|
|
# $query_def = $sqldb->named_query( $name ) |
2248
|
|
|
|
|
|
|
sub named_query { |
2249
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
2250
|
|
|
|
|
|
|
$self->named_queries( $name ) or croak("No query named '$name'"); |
2251
|
|
|
|
|
|
|
} |
2252
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
# %clauses = $sqldb->interpret_named_query( $name, @args ) |
2254
|
|
|
|
|
|
|
sub interpret_named_query { |
2255
|
|
|
|
|
|
|
my ( $self, $name, @query_args ) = @_; |
2256
|
|
|
|
|
|
|
my $query_def = $self->named_query( $name ); |
2257
|
|
|
|
|
|
|
if ( ! $query_def ) { |
2258
|
|
|
|
|
|
|
croak("No definition was provided for named query '$name': $query_def") |
2259
|
|
|
|
|
|
|
} elsif ( ! ref $query_def ) { |
2260
|
|
|
|
|
|
|
return ( sql => [ $query_def, @query_args ] ); |
2261
|
|
|
|
|
|
|
} elsif ( ref($query_def) eq 'ARRAY' ) { |
2262
|
|
|
|
|
|
|
return ( sql => clone_with_parameters($query_def, @query_args) ); |
2263
|
|
|
|
|
|
|
} elsif ( ref($query_def) eq 'HASH' ) { |
2264
|
|
|
|
|
|
|
return ( %{ clone_with_parameters($query_def, @query_args) } ); |
2265
|
|
|
|
|
|
|
} elsif ( ref($query_def) eq 'CODE' ) { |
2266
|
|
|
|
|
|
|
my @results = $query_def->( @query_args ); |
2267
|
|
|
|
|
|
|
unshift @results, 'sql' if scalar(@results) == 1; |
2268
|
|
|
|
|
|
|
return @results; |
2269
|
|
|
|
|
|
|
} else { |
2270
|
|
|
|
|
|
|
croak("Unable to interpret definition of named query '$name': $query_def") |
2271
|
|
|
|
|
|
|
} |
2272
|
|
|
|
|
|
|
} |
2273
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
######################################################################## |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
=head2 Executing Named Queries |
2277
|
|
|
|
|
|
|
|
2278
|
|
|
|
|
|
|
Typically, named queries are executed by passing a named_query argument to |
2279
|
|
|
|
|
|
|
one of the primary interface methods such as fetch_select or do_insert, but |
2280
|
|
|
|
|
|
|
there are also several convenience methods for use when you know you will |
2281
|
|
|
|
|
|
|
only be using named queries. |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
B These methods provide a simple way to use named queries. |
2284
|
|
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
=over 4 |
2286
|
|
|
|
|
|
|
|
2287
|
|
|
|
|
|
|
=item fetch_named_query() |
2288
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
$sqldb->fetch_named_query( $query_name, @params ) : $rows |
2290
|
|
|
|
|
|
|
$sqldb->fetch_named_query( $query_name, @params ) : ( $rows, $columns ) |
2291
|
|
|
|
|
|
|
|
2292
|
|
|
|
|
|
|
Calls fetch_select using the named query and arguments provided. |
2293
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
=item visit_named_query() |
2295
|
|
|
|
|
|
|
|
2296
|
|
|
|
|
|
|
$sqldb->visit_named_query($query_name, @params, $code) : @results |
2297
|
|
|
|
|
|
|
$sqldb->visit_named_query($code, $query_name, @params) : @results |
2298
|
|
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
Calls visit_select using the named query and arguments provided. |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
=item do_named_query() |
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
$sqldb->do_named_query( $query_name, @params ) : $row_count |
2304
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
Calls do_query using the named query and arguments provided. |
2306
|
|
|
|
|
|
|
|
2307
|
|
|
|
|
|
|
=back |
2308
|
|
|
|
|
|
|
|
2309
|
|
|
|
|
|
|
B These samples demonstrate use of the named_query feature. |
2310
|
|
|
|
|
|
|
|
2311
|
|
|
|
|
|
|
=over 2 |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
=item * |
2314
|
|
|
|
|
|
|
|
2315
|
|
|
|
|
|
|
A simple named query can be defined in SQL or as generator clauses: |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
$sqldb->define_named_query('all_students', 'select * from students'); |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
$sqldb->define_named_query('all_students', { table => 'students' }); |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
The results of a named select query can be retrieved in several equivalent ways: |
2322
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
$rows = $sqldb->fetch_named_query( 'all_students' ); |
2324
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
$rows = $sqldb->fetch_select( named_query => 'all_students' ); |
2326
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
@rows = $sqldb->visit_select( named_query => 'all_students', sub { $_[0] } ); |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
=item * |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
There are numerous ways of defining a query which accepts parameters; any of the following are basically equivalent: |
2332
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
$sqldb->define_named_query('student_by_id', |
2334
|
|
|
|
|
|
|
'select * from students where id = ?' ); |
2335
|
|
|
|
|
|
|
|
2336
|
|
|
|
|
|
|
$sqldb->define_named_query('student_by_id', |
2337
|
|
|
|
|
|
|
{ sql=>['select * from students where id = ?', \$1 ] } ); |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
$sqldb->define_named_query('student_by_id', |
2340
|
|
|
|
|
|
|
{ table=>'students', where=>[ 'id = ?', \$1 ] } ); |
2341
|
|
|
|
|
|
|
|
2342
|
|
|
|
|
|
|
$sqldb->define_named_query('student_by_id', |
2343
|
|
|
|
|
|
|
{ table=>'students', where=>{ 'id' => \$1 } } ); |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
$sqldb->define_named_query('student_by_id', |
2346
|
|
|
|
|
|
|
{ action=>'select', table=>'students', where=>{ 'id'=>\$1 } } ); |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
Using a named query with parameters requires that the arguments be passed after the name: |
2349
|
|
|
|
|
|
|
|
2350
|
|
|
|
|
|
|
$rows = $sqldb->fetch_named_query( 'student_by_id', $my_id ); |
2351
|
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
$rows = $sqldb->fetch_select(named_query=>['student_by_id', $my_id]); |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
If the query is defined using a plain string, as in the first line of the student_by_id example, no checking is done to ensure that the correct number of parameters have been passed; the result will depend on your database server, but will presumably be a fatal error. In contrast, the definitions that use the \$1 format will have their parameters counted and arranged before being executed. |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
=item * |
2357
|
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
|
Queries which insert, update, or delete can be defined in much the same way as select queries are; again, all of the following are roughly equivalent: |
2359
|
|
|
|
|
|
|
|
2360
|
|
|
|
|
|
|
$sqldb->define_named_query('delete_student', |
2361
|
|
|
|
|
|
|
'delete from students where id = ?'); |
2362
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
$sqldb->define_named_query('delete_student', |
2364
|
|
|
|
|
|
|
[ 'delete from students where id = ?', \$1 ]); |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
$sqldb->define_named_query('delete_student', |
2367
|
|
|
|
|
|
|
{ action=>'delete', table=>'students', where=>{ id=>\$1 } }); |
2368
|
|
|
|
|
|
|
|
2369
|
|
|
|
|
|
|
These modification queries can be invoked with one of the do_ methods: |
2370
|
|
|
|
|
|
|
|
2371
|
|
|
|
|
|
|
$sqldb->do_named_query( 'delete_student', 201 ); |
2372
|
|
|
|
|
|
|
|
2373
|
|
|
|
|
|
|
$sqldb->do_query( named_query => [ 'delete_student', 201 ] ); |
2374
|
|
|
|
|
|
|
|
2375
|
|
|
|
|
|
|
$sqldb->do_delete( named_query => [ 'delete_student', 201 ] ); |
2376
|
|
|
|
|
|
|
|
2377
|
|
|
|
|
|
|
=item * |
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
Queries can be defined using subroutines: |
2380
|
|
|
|
|
|
|
|
2381
|
|
|
|
|
|
|
$sqldb->define_named_query('name_search', sub { |
2382
|
|
|
|
|
|
|
my $name = lc( shift ); |
2383
|
|
|
|
|
|
|
return "select * from students where name like '%$name%'" |
2384
|
|
|
|
|
|
|
}); |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
$rows = $sqldb->fetch_named_query( 'name_search', 'DAV' ); |
2387
|
|
|
|
|
|
|
|
2388
|
|
|
|
|
|
|
=item * |
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
Query definitions can be stored in external text files or database tables and then evaluated into data structures or code references. The below code loads a simple text file of query definitions |
2391
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
open( QUERIES, '/path/to/my/queries' ); |
2393
|
|
|
|
|
|
|
my %queries = map { split /\:\s*/, $_, 2 } grep { /^[^#]/ } ; |
2394
|
|
|
|
|
|
|
close QUERIES; |
2395
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
$sqldb->define_named_queries_from_text( %queries ); |
2397
|
|
|
|
|
|
|
|
2398
|
|
|
|
|
|
|
Placing the following text in the target file will define all of the queries used above: |
2399
|
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
|
# Simple query that doesn't take any parameters |
2401
|
|
|
|
|
|
|
all_students: select * from students |
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
# Query with one required parameter |
2404
|
|
|
|
|
|
|
student_by_id: [ 'select * from students where id = ?', \$1 ] |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
# Generated query using hash format |
2407
|
|
|
|
|
|
|
delete_student: { action=>'delete', table=>'students', where=>{ id=>\$1 } } |
2408
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
# Perl expression to be turned into a query generating subroutine |
2410
|
|
|
|
|
|
|
name_search: "select * from students where name like '%\L$_[0]\E%'" |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
=back |
2413
|
|
|
|
|
|
|
|
2414
|
|
|
|
|
|
|
=cut |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
# ( $row_hashes, $column_hashes ) = $sqldb->fetch_named_query( $name, @args ) |
2417
|
|
|
|
|
|
|
sub fetch_named_query { |
2418
|
|
|
|
|
|
|
(shift)->fetch_select( named_query => [ @_ ] ); |
2419
|
|
|
|
|
|
|
} |
2420
|
|
|
|
|
|
|
|
2421
|
|
|
|
|
|
|
# @results = $sqldb->visit_named_query( $name, @args, $code_ref ) |
2422
|
|
|
|
|
|
|
sub visit_named_query { |
2423
|
|
|
|
|
|
|
(shift)->visit_select( ( ref($_[0]) ? shift : pop ), named_query => [ @_ ] ); |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
# $result = $sqldb->do_named_query( $name, @args ) |
2427
|
|
|
|
|
|
|
sub do_named_query { |
2428
|
|
|
|
|
|
|
(shift)->do_query( named_query => [ @_ ] ); |
2429
|
|
|
|
|
|
|
} |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
######################################################################## |
2432
|
|
|
|
|
|
|
|
2433
|
|
|
|
|
|
|
# $row_count = $sqldb->do_query( %clauses ); |
2434
|
|
|
|
|
|
|
sub do_query { |
2435
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
2436
|
|
|
|
|
|
|
|
2437
|
|
|
|
|
|
|
if ( my $named = delete $clauses{'named_query'} ) { |
2438
|
|
|
|
|
|
|
my %named = $self->interpret_named_query( ref($named) ? @$named : $named ); |
2439
|
|
|
|
|
|
|
%clauses = ( %named, %clauses ); |
2440
|
|
|
|
|
|
|
} |
2441
|
|
|
|
|
|
|
|
2442
|
|
|
|
|
|
|
my ($sql, @params); |
2443
|
|
|
|
|
|
|
if ( my $action = delete $clauses{'action'} ) { |
2444
|
|
|
|
|
|
|
my $method = "sql_$action"; |
2445
|
|
|
|
|
|
|
($sql, @params) = $self->$method( %clauses ); |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
} elsif ( my $literal = delete $clauses{'sql'} ) { |
2448
|
|
|
|
|
|
|
($sql, @params) = ( ref($literal) eq 'ARRAY' ) ? @$literal : $literal; |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
} else { |
2451
|
|
|
|
|
|
|
croak( "Can't call do_query without either action or sql clauses" ); |
2452
|
|
|
|
|
|
|
} |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
$self->do_sql( $sql, @params ); |
2455
|
|
|
|
|
|
|
} |
2456
|
|
|
|
|
|
|
|
2457
|
|
|
|
|
|
|
######################################################################## |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
######################################################################## |
2460
|
|
|
|
|
|
|
|
2461
|
|
|
|
|
|
|
=head1 DEFINING STRUCTURES (SQL DDL) |
2462
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
The schema of a DBI database is controlled through the Data Definition Language features of SQL. |
2464
|
|
|
|
|
|
|
|
2465
|
|
|
|
|
|
|
=head2 Detect Tables and Columns |
2466
|
|
|
|
|
|
|
|
2467
|
|
|
|
|
|
|
B These methods provide information about existing tables. |
2468
|
|
|
|
|
|
|
|
2469
|
|
|
|
|
|
|
=over 4 |
2470
|
|
|
|
|
|
|
|
2471
|
|
|
|
|
|
|
=item detect_table_names() |
2472
|
|
|
|
|
|
|
|
2473
|
|
|
|
|
|
|
$sqldb->detect_table_names () : @table_names |
2474
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
Attempts to collect a list of the available tables in the database we have connected to. Uses the DBI tables() method. |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
=item detect_table() |
2478
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
$sqldb->detect_table ( $tablename ) : @columns_or_empty |
2480
|
|
|
|
|
|
|
$sqldb->detect_table ( $tablename, 1 ) : @columns_or_empty |
2481
|
|
|
|
|
|
|
|
2482
|
|
|
|
|
|
|
Attempts to query the given table without retrieving many (or any) rows. Uses a server-specific "trivial" or "guaranteed" query provided by sql_detect_any. |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
If succssful, the columns contained in this table are returned as an array of hash references, as described in the Column Information section below. |
2485
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
Catches any exceptions; if the query fails for any reason we return an empty list. The reason for the failure is logged via warn() unless an additional argument with a true value is passed to surpress those error messages. |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
=back |
2489
|
|
|
|
|
|
|
|
2490
|
|
|
|
|
|
|
B These methods are called by the public detect methods. |
2491
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
=over 4 |
2493
|
|
|
|
|
|
|
|
2494
|
|
|
|
|
|
|
=item sql_detect_table() |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
$sqldb->sql_detect_table ( $tablename ) : %sql_select_clauses |
2497
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
Subclass hook. Retrieve something from the given table that is guaranteed to exist but does not return many rows, without knowning its table structure. |
2499
|
|
|
|
|
|
|
|
2500
|
|
|
|
|
|
|
Defaults to "select * from table where 1 = 0", which may not work on all platforms. Your subclass might prefer "select * from table limit 1" or a local equivalent. |
2501
|
|
|
|
|
|
|
|
2502
|
|
|
|
|
|
|
=back |
2503
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
=cut |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
sub detect_table_names { |
2507
|
|
|
|
|
|
|
my $self = shift; |
2508
|
|
|
|
|
|
|
$self->get_dbh()->tables(); |
2509
|
|
|
|
|
|
|
} |
2510
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
sub detect_table { |
2512
|
|
|
|
|
|
|
my $self = shift; |
2513
|
|
|
|
|
|
|
my $tablename = shift; |
2514
|
|
|
|
|
|
|
my $quietly = shift; |
2515
|
|
|
|
|
|
|
my @sql; |
2516
|
|
|
|
|
|
|
my $columns; |
2517
|
|
|
|
|
|
|
eval { |
2518
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
2519
|
|
|
|
|
|
|
@sql = $self->sql_detect_table( $tablename ); |
2520
|
|
|
|
|
|
|
( my($rows), $columns ) = $self->fetch_select( @sql ); |
2521
|
|
|
|
|
|
|
}; |
2522
|
|
|
|
|
|
|
if ( ! $@ ) { |
2523
|
|
|
|
|
|
|
return @$columns; |
2524
|
|
|
|
|
|
|
} else { |
2525
|
|
|
|
|
|
|
warn "Unable to detect_table $tablename: $@" unless $quietly; |
2526
|
|
|
|
|
|
|
return; |
2527
|
|
|
|
|
|
|
} |
2528
|
|
|
|
|
|
|
} |
2529
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
sub sql_detect_table { |
2531
|
|
|
|
|
|
|
my ($self, $tablename) = @_; |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
# Your subclass might prefer one of these... |
2534
|
|
|
|
|
|
|
# return ( sql => "select * from $tablename limit 1" ) |
2535
|
|
|
|
|
|
|
# return ( sql => "select * from $tablename where 1 = 0" ) |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
return ( |
2538
|
|
|
|
|
|
|
table => $tablename, |
2539
|
|
|
|
|
|
|
where => '1 = 0', |
2540
|
|
|
|
|
|
|
) |
2541
|
|
|
|
|
|
|
} |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
######################################################################## |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
=head2 Create and Drop Tables |
2546
|
|
|
|
|
|
|
|
2547
|
|
|
|
|
|
|
B These methods attempt to create and drop tables. |
2548
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
=over 4 |
2550
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
=item create_table() |
2552
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
$sqldb->create_table( $tablename, $column_hash_ary ) |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
Create a table. |
2556
|
|
|
|
|
|
|
|
2557
|
|
|
|
|
|
|
The columns to be created in this table are defined as an array of hash references, as described in the Column Information section below. |
2558
|
|
|
|
|
|
|
|
2559
|
|
|
|
|
|
|
=item drop_table() |
2560
|
|
|
|
|
|
|
|
2561
|
|
|
|
|
|
|
$sqldb->drop_table( $tablename ) |
2562
|
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
Delete the named table. |
2564
|
|
|
|
|
|
|
|
2565
|
|
|
|
|
|
|
=back |
2566
|
|
|
|
|
|
|
|
2567
|
|
|
|
|
|
|
=cut |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
# $rows = $self->create_table( $tablename, $columns ); |
2570
|
|
|
|
|
|
|
sub create_table { |
2571
|
|
|
|
|
|
|
my $self = shift; |
2572
|
|
|
|
|
|
|
$self->do_sql( $self->sql_create_table( @_ ) ); |
2573
|
|
|
|
|
|
|
} |
2574
|
|
|
|
|
|
|
sub do_create_table { &create_table } |
2575
|
|
|
|
|
|
|
|
2576
|
|
|
|
|
|
|
# $rows = $self->drop_table( $tablename ); |
2577
|
|
|
|
|
|
|
sub drop_table { |
2578
|
|
|
|
|
|
|
my $self = shift; |
2579
|
|
|
|
|
|
|
$self->do_sql( $self->sql_drop_table( @_ ) ); |
2580
|
|
|
|
|
|
|
} |
2581
|
|
|
|
|
|
|
sub do_drop_table { &drop_table } |
2582
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
=pod |
2584
|
|
|
|
|
|
|
|
2585
|
|
|
|
|
|
|
B: The information about columns is presented as an array of hash references, each containing the following keys: |
2586
|
|
|
|
|
|
|
|
2587
|
|
|
|
|
|
|
=over 4 |
2588
|
|
|
|
|
|
|
|
2589
|
|
|
|
|
|
|
=item * |
2590
|
|
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
C $column_name_string> |
2592
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
Defines the name of the column. |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
B No case or length restrictions are imposed on column names, but for incresased compatibility, you may wish to stick with single-case strings of moderate length. |
2596
|
|
|
|
|
|
|
|
2597
|
|
|
|
|
|
|
=item * |
2598
|
|
|
|
|
|
|
|
2599
|
|
|
|
|
|
|
C $column_type_constant_string> |
2600
|
|
|
|
|
|
|
|
2601
|
|
|
|
|
|
|
Specifies the type of column to create. Discussed further below. |
2602
|
|
|
|
|
|
|
|
2603
|
|
|
|
|
|
|
=item * |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
C $not_nullable_boolean> |
2606
|
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
|
Indicates whether a value for this column is required; if not, unspecified or undefined values will be stored as NULL values. Defaults to false. |
2608
|
|
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
=item * |
2610
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
C $max_chars_integer> |
2612
|
|
|
|
|
|
|
|
2613
|
|
|
|
|
|
|
Only applicable to column of C 'text'>. |
2614
|
|
|
|
|
|
|
|
2615
|
|
|
|
|
|
|
Indicates the maximum number of ASCII characters that can be stored in this column. |
2616
|
|
|
|
|
|
|
|
2617
|
|
|
|
|
|
|
=back |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
B The above public methods use the following sql_ methods to generate SQL DDL statements. |
2620
|
|
|
|
|
|
|
|
2621
|
|
|
|
|
|
|
=over 4 |
2622
|
|
|
|
|
|
|
|
2623
|
|
|
|
|
|
|
=item sql_create_table() |
2624
|
|
|
|
|
|
|
|
2625
|
|
|
|
|
|
|
$sqldb->sql_create_table ($tablename, $columns) : $sql_stmt |
2626
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
Generate a SQL create-table statement based on the column information. Text columns are checked with sql_create_column_text_length() to provide server-appropriate types. |
2628
|
|
|
|
|
|
|
|
2629
|
|
|
|
|
|
|
=item sql_create_columns() |
2630
|
|
|
|
|
|
|
|
2631
|
|
|
|
|
|
|
$sqldb->sql_create_columns( $column, $fragment_array_ref ) : $sql_fragment |
2632
|
|
|
|
|
|
|
|
2633
|
|
|
|
|
|
|
Generates the SQL fragment to define a column in a create table statement. |
2634
|
|
|
|
|
|
|
|
2635
|
|
|
|
|
|
|
=item sql_drop_table() |
2636
|
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
|
$sqldb->sql_drop_table ($tablename) : $sql_stmt |
2638
|
|
|
|
|
|
|
|
2639
|
|
|
|
|
|
|
=back |
2640
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
=cut |
2642
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
sub sql_create_table { |
2644
|
|
|
|
|
|
|
my($self, $table, $columns) = @_; |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
my @sql_columns; |
2647
|
|
|
|
|
|
|
foreach my $column ( @$columns ) { |
2648
|
|
|
|
|
|
|
push @sql_columns, $self->sql_create_columns($table, $column, \@sql_columns) |
2649
|
|
|
|
|
|
|
} |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
my $sql = "create table $table ( \n" . join(",\n", @sql_columns) . "\n)\n"; |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
$self->log_sql( $sql ); |
2654
|
|
|
|
|
|
|
return $sql; |
2655
|
|
|
|
|
|
|
} |
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
sub sql_create_columns { |
2658
|
|
|
|
|
|
|
my($self, $table, $column, $columns) = @_; |
2659
|
|
|
|
|
|
|
my $name = $column->{name}; |
2660
|
|
|
|
|
|
|
my $type = $self->sql_create_column_type( $table, $column, $columns ) ; |
2661
|
|
|
|
|
|
|
if ( $type eq 'primary' ) { |
2662
|
|
|
|
|
|
|
return "PRIMARY KEY ($name)"; |
2663
|
|
|
|
|
|
|
} else { |
2664
|
|
|
|
|
|
|
return ' ' . $name . |
2665
|
|
|
|
|
|
|
' ' x ( ( length($name) > 31 ) ? 1 : ( 32 - length($name) ) ) . |
2666
|
|
|
|
|
|
|
$type . |
2667
|
|
|
|
|
|
|
( $column->{required} ? " not null" : '' ); |
2668
|
|
|
|
|
|
|
} |
2669
|
|
|
|
|
|
|
} |
2670
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
sub sql_drop_table { |
2672
|
|
|
|
|
|
|
my ($self, $table) = @_; |
2673
|
|
|
|
|
|
|
my $sql = "drop table $table"; |
2674
|
|
|
|
|
|
|
$self->log_sql( $sql ); |
2675
|
|
|
|
|
|
|
return $sql; |
2676
|
|
|
|
|
|
|
} |
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
######################################################################## |
2679
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
=head2 Column Type Methods |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
The following methods are used by sql_create_table to specify column information in a DBMS-specific fashion. |
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
B These methods are used to build create table statements. |
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
=over 4 |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
=item sql_create_column_type() |
2689
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
$sqldb->sql_create_column_type ( $table, $column, $columns ) : $col_type_str |
2691
|
|
|
|
|
|
|
|
2692
|
|
|
|
|
|
|
Returns an appropriate |
2693
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
=item dbms_create_column_types() |
2695
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
$sqldb->dbms_create_column_types () : %column_type_codes |
2697
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
Subclass hook. Defaults to empty. Should return a hash mapping column type codes to the specific strings used in a SQL create statement for such a column. |
2699
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
Subclasses should provide at least two entries, for the symbolic types referenced elsewhere in this interface, "sequential" and "binary". |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
=item sql_create_column_text_length() |
2703
|
|
|
|
|
|
|
|
2704
|
|
|
|
|
|
|
$sqldb->sql_create_column_text_length ( $length ) : $col_type_str |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
Returns "varchar(length)" for values under 256, otherwise calls dbms_create_column_text_long_type. |
2707
|
|
|
|
|
|
|
|
2708
|
|
|
|
|
|
|
=item dbms_create_column_text_long_type() |
2709
|
|
|
|
|
|
|
|
2710
|
|
|
|
|
|
|
$sqldb->dbms_create_column_text_long_type () : $col_type_str |
2711
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
2713
|
|
|
|
|
|
|
|
2714
|
|
|
|
|
|
|
Subclasses should, based on the datasource's server_type, return the appropriate type of column for long text values, such as "BLOB", "TEXT", "LONGTEXT", or "MEMO". |
2715
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
=back |
2717
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
=cut |
2719
|
|
|
|
|
|
|
|
2720
|
|
|
|
|
|
|
sub sql_create_column_type { |
2721
|
|
|
|
|
|
|
my($self, $table, $column, $columns) = @_; |
2722
|
|
|
|
|
|
|
my $type = $column->{type}; |
2723
|
|
|
|
|
|
|
|
2724
|
|
|
|
|
|
|
my %dbms_types = $self->dbms_create_column_types; |
2725
|
|
|
|
|
|
|
if ( my $dbms_type = $dbms_types{ $type } ) { |
2726
|
|
|
|
|
|
|
$type = $dbms_type; |
2727
|
|
|
|
|
|
|
} |
2728
|
|
|
|
|
|
|
|
2729
|
|
|
|
|
|
|
if ( $type eq 'text' ) { |
2730
|
|
|
|
|
|
|
$type = $self->sql_create_column_text_length( $column->{length} || 255 ) ; |
2731
|
|
|
|
|
|
|
} elsif ( $type eq 'binary' ) { |
2732
|
|
|
|
|
|
|
$type = $self->sql_create_column_text_length( $column->{length} || 65535 ) ; |
2733
|
|
|
|
|
|
|
} |
2734
|
|
|
|
|
|
|
|
2735
|
|
|
|
|
|
|
return $type; |
2736
|
|
|
|
|
|
|
} |
2737
|
|
|
|
|
|
|
|
2738
|
|
|
|
|
|
|
sub sql_create_column_text_length { |
2739
|
|
|
|
|
|
|
my $self = shift; |
2740
|
|
|
|
|
|
|
my $length = shift; |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
return "varchar($length)" if ($length < 256); |
2743
|
|
|
|
|
|
|
return $self->dbms_create_column_text_long_type; |
2744
|
|
|
|
|
|
|
} |
2745
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
sub dbms_create_column_text_long_type { |
2747
|
|
|
|
|
|
|
confess("DBMS-Specific Function") |
2748
|
|
|
|
|
|
|
} |
2749
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
sub dbms_create_column_types { |
2751
|
|
|
|
|
|
|
return () |
2752
|
|
|
|
|
|
|
} |
2753
|
|
|
|
|
|
|
|
2754
|
|
|
|
|
|
|
######################################################################## |
2755
|
|
|
|
|
|
|
|
2756
|
|
|
|
|
|
|
=head2 Generating Schema and Record Objects |
2757
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
The object mapping layer provides classes for Record, Table and Column objects which fetch and store information from a SQLEngine Driver. |
2759
|
|
|
|
|
|
|
|
2760
|
|
|
|
|
|
|
Those objects relies on a Driver, typically passed to their constructor or initializer. The following convenience methods let you start this process from your current SQLEngine Driver object. |
2761
|
|
|
|
|
|
|
|
2762
|
|
|
|
|
|
|
B The following methods provide access to objects |
2763
|
|
|
|
|
|
|
which represent tables, columns and records in a given Driver. They |
2764
|
|
|
|
|
|
|
each ensure the necessary classes are loaded using require(). |
2765
|
|
|
|
|
|
|
|
2766
|
|
|
|
|
|
|
=over 4 |
2767
|
|
|
|
|
|
|
|
2768
|
|
|
|
|
|
|
=item tables() |
2769
|
|
|
|
|
|
|
|
2770
|
|
|
|
|
|
|
$sqldb->tables() : $tableset |
2771
|
|
|
|
|
|
|
|
2772
|
|
|
|
|
|
|
Returns a new DBIx::SQLEngine::Schema::TableSet object containing table objects with the names discovered by detect_table_names(). See L for more information on this object's interface. |
2773
|
|
|
|
|
|
|
|
2774
|
|
|
|
|
|
|
=item table() |
2775
|
|
|
|
|
|
|
|
2776
|
|
|
|
|
|
|
$sqldb->table( $tablename ) : $table |
2777
|
|
|
|
|
|
|
|
2778
|
|
|
|
|
|
|
Returns a new DBIx::SQLEngine::Schema::Table object with this SQLEngine Driver and the given table name. See L for more information on this object's interface. |
2779
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
=item record_class() |
2781
|
|
|
|
|
|
|
|
2782
|
|
|
|
|
|
|
$sqldb->record_class( $tablename ) : $record_class |
2783
|
|
|
|
|
|
|
$sqldb->record_class( $tablename, $classname ) : $record_class |
2784
|
|
|
|
|
|
|
$sqldb->record_class( $tablename, $classname, @traits ) : $record_class |
2785
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
Generates a Record::Class which corresponds to the given table name. Note that the record class is a class name, not an object. If no class name is provided, one is generated based on the table name. See L for more information on this object's interface. |
2787
|
|
|
|
|
|
|
|
2788
|
|
|
|
|
|
|
=back |
2789
|
|
|
|
|
|
|
|
2790
|
|
|
|
|
|
|
=cut |
2791
|
|
|
|
|
|
|
|
2792
|
|
|
|
|
|
|
sub tables { |
2793
|
|
|
|
|
|
|
my $self = shift; |
2794
|
|
|
|
|
|
|
require DBIx::SQLEngine::Schema::TableSet; |
2795
|
|
|
|
|
|
|
DBIx::SQLEngine::Schema::TableSet->new( |
2796
|
|
|
|
|
|
|
map { $self->table( $_ ) } $self->detect_table_names |
2797
|
|
|
|
|
|
|
) |
2798
|
|
|
|
|
|
|
} |
2799
|
|
|
|
|
|
|
|
2800
|
|
|
|
|
|
|
sub table { |
2801
|
|
|
|
|
|
|
require DBIx::SQLEngine::Schema::Table; |
2802
|
|
|
|
|
|
|
DBIx::SQLEngine::Schema::Table->new( sqlengine => (shift), name => (shift) ) |
2803
|
|
|
|
|
|
|
} |
2804
|
|
|
|
|
|
|
|
2805
|
|
|
|
|
|
|
sub record_class { |
2806
|
|
|
|
|
|
|
(shift)->table( shift )->record_class( @_ ) |
2807
|
|
|
|
|
|
|
} |
2808
|
|
|
|
|
|
|
|
2809
|
|
|
|
|
|
|
######################################################################## |
2810
|
|
|
|
|
|
|
|
2811
|
|
|
|
|
|
|
######################################################################## |
2812
|
|
|
|
|
|
|
|
2813
|
|
|
|
|
|
|
=head1 ADVANCED CAPABILITIES |
2814
|
|
|
|
|
|
|
|
2815
|
|
|
|
|
|
|
Not all of the below capabilities will be available on all database servers. |
2816
|
|
|
|
|
|
|
|
2817
|
|
|
|
|
|
|
For application reliability, call the relevant *_unsupported methods to confirm that the database you've connected to has the capabilities you require, and either exit with a warning or use some type of fallback strategy if they are not. |
2818
|
|
|
|
|
|
|
|
2819
|
|
|
|
|
|
|
=head2 Database Capability Information |
2820
|
|
|
|
|
|
|
|
2821
|
|
|
|
|
|
|
Note: this feature has been added recently, and the interface is subject to change. |
2822
|
|
|
|
|
|
|
|
2823
|
|
|
|
|
|
|
The following methods all default to returning undef, but may be overridden by subclasses to return a true or false value, indicating whether their connection has this limitation. |
2824
|
|
|
|
|
|
|
|
2825
|
|
|
|
|
|
|
B These methods return driver class capability information. |
2826
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
=over 4 |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
=item dbms_detect_tables_unsupported() |
2830
|
|
|
|
|
|
|
|
2831
|
|
|
|
|
|
|
Can the database driver return a list of tables that currently exist? (True for some simple drivers like CSV.) |
2832
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
=item dbms_joins_unsupported() |
2834
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
Does the database driver support select statements with joins across multiple tables? (True for some simple drivers like CSV.) |
2836
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
=item dbms_union_unsupported() |
2838
|
|
|
|
|
|
|
|
2839
|
|
|
|
|
|
|
Does the database driver support select queries with unions to join the results of multiple select statements? (True for many simple databases.) |
2840
|
|
|
|
|
|
|
|
2841
|
|
|
|
|
|
|
=item dbms_drop_column_unsupported() |
2842
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
Does the database driver have a problem removing a column from an existing table? (True for Postgres.) |
2844
|
|
|
|
|
|
|
|
2845
|
|
|
|
|
|
|
=item dbms_column_types_unsupported() |
2846
|
|
|
|
|
|
|
|
2847
|
|
|
|
|
|
|
Does the database driver store column type information, or are all columns the same type? (True for some simple drivers like CSV.) |
2848
|
|
|
|
|
|
|
|
2849
|
|
|
|
|
|
|
=item dbms_null_becomes_emptystring() |
2850
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
Does the database driver automatically convert null values in insert and update statements to empty strings? (True for some simple drivers like CSV.) |
2852
|
|
|
|
|
|
|
|
2853
|
|
|
|
|
|
|
=item dbms_emptystring_becomes_null() |
2854
|
|
|
|
|
|
|
|
2855
|
|
|
|
|
|
|
Does the database driver automatically convert empty strings in insert and update statements to null values? (True for Oracle.) |
2856
|
|
|
|
|
|
|
|
2857
|
|
|
|
|
|
|
=item dbms_placeholders_unsupported() |
2858
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
Does the database driver support having ? placehoders or not? (This is a problem for Linux users of DBD::Sybase connecting to MS SQL Servers on Windows.) |
2860
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
=item dbms_transactions_unsupported() |
2862
|
|
|
|
|
|
|
|
2863
|
|
|
|
|
|
|
Does the database driver support real transactions with rollback and commit or not? |
2864
|
|
|
|
|
|
|
|
2865
|
|
|
|
|
|
|
=item dbms_multi_sth_unsupported() |
2866
|
|
|
|
|
|
|
|
2867
|
|
|
|
|
|
|
Does the database driver support having multiple statement handles active at once or not? (This is a problem for several types of drivers.) |
2868
|
|
|
|
|
|
|
|
2869
|
|
|
|
|
|
|
=item dbms_indexes_unsupported() |
2870
|
|
|
|
|
|
|
|
2871
|
|
|
|
|
|
|
Does the database driver support server-side indexes or not? |
2872
|
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
|
=item dbms_storedprocs_unsupported() |
2874
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
Does the database driver support server-side stored procedures or not? |
2876
|
|
|
|
|
|
|
|
2877
|
|
|
|
|
|
|
=back |
2878
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
=cut |
2880
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
sub dbms_select_table_as_unsupported { undef } |
2882
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
sub dbms_joins_unsupported { undef } |
2884
|
|
|
|
|
|
|
sub dbms_join_on_unsupported { undef } |
2885
|
|
|
|
|
|
|
sub dbms_outer_join_unsupported { undef } |
2886
|
|
|
|
|
|
|
|
2887
|
|
|
|
|
|
|
sub dbms_union_unsupported { undef } |
2888
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
sub dbms_detect_tables_unsupported { undef } |
2890
|
|
|
|
|
|
|
sub dbms_drop_column_unsupported { undef } |
2891
|
|
|
|
|
|
|
|
2892
|
|
|
|
|
|
|
sub dbms_column_types_unsupported { undef } |
2893
|
|
|
|
|
|
|
sub dbms_null_becomes_emptystring { undef } |
2894
|
|
|
|
|
|
|
sub dbms_emptystring_becomes_null { undef } |
2895
|
|
|
|
|
|
|
|
2896
|
|
|
|
|
|
|
sub dbms_placeholders_unsupported { undef } |
2897
|
|
|
|
|
|
|
sub dbms_multi_sth_unsupported { undef } |
2898
|
|
|
|
|
|
|
|
2899
|
|
|
|
|
|
|
sub dbms_transactions_unsupported { undef } |
2900
|
|
|
|
|
|
|
sub dbms_indexes_unsupported { undef } |
2901
|
|
|
|
|
|
|
sub dbms_storedprocs_unsupported { undef } |
2902
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
######################################################################## |
2904
|
|
|
|
|
|
|
|
2905
|
|
|
|
|
|
|
=head2 Begin, Commit and Rollback Transactions |
2906
|
|
|
|
|
|
|
|
2907
|
|
|
|
|
|
|
Note: this feature has been added recently, and the interface is subject to change. |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
DBIx::SQLEngine assumes auto-commit is on by default, so unless otherwise specified, each query is executed as a separate transaction. To execute multiple queries within a single transaction, use the as_one_transaction method. |
2910
|
|
|
|
|
|
|
|
2911
|
|
|
|
|
|
|
B These methods invoke transaction functionality. |
2912
|
|
|
|
|
|
|
|
2913
|
|
|
|
|
|
|
=over 4 |
2914
|
|
|
|
|
|
|
|
2915
|
|
|
|
|
|
|
=item are_transactions_supported() |
2916
|
|
|
|
|
|
|
|
2917
|
|
|
|
|
|
|
$boolean = $sqldb->are_transactions_supported( ); |
2918
|
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
Checks to see if the database has transaction support. |
2920
|
|
|
|
|
|
|
|
2921
|
|
|
|
|
|
|
=item as_one_transaction() |
2922
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
@results = $sqldb->as_one_transaction( $sub_ref, @args ); |
2924
|
|
|
|
|
|
|
|
2925
|
|
|
|
|
|
|
Starts a transaction, calls the given subroutine with any arguments provided, |
2926
|
|
|
|
|
|
|
and then commits the transaction; if an exception occurs, the transaction is |
2927
|
|
|
|
|
|
|
rolled back instead. Will fail if we don't have transaction support. |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
For example: |
2930
|
|
|
|
|
|
|
|
2931
|
|
|
|
|
|
|
my $sqldb = DBIx::SQLEngine->new( ... ); |
2932
|
|
|
|
|
|
|
$sqldb->as_one_transaction( sub { |
2933
|
|
|
|
|
|
|
$sqldb->do_insert( ... ); |
2934
|
|
|
|
|
|
|
$sqldb->do_update( ... ); |
2935
|
|
|
|
|
|
|
$sqldb->do_delete( ... ); |
2936
|
|
|
|
|
|
|
} ); |
2937
|
|
|
|
|
|
|
|
2938
|
|
|
|
|
|
|
Or using a reference to a predefined subroutine: |
2939
|
|
|
|
|
|
|
|
2940
|
|
|
|
|
|
|
sub do_stuff { |
2941
|
|
|
|
|
|
|
my $sqldb = shift; |
2942
|
|
|
|
|
|
|
$sqldb->do_insert( ... ); |
2943
|
|
|
|
|
|
|
$sqldb->do_update( ... ); |
2944
|
|
|
|
|
|
|
$sqldb->do_delete( ... ); |
2945
|
|
|
|
|
|
|
1; |
2946
|
|
|
|
|
|
|
} |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
my $sqldb = DBIx::SQLEngine->new( ... ); |
2949
|
|
|
|
|
|
|
$sqldb->as_one_transaction( \&do_stuff, $sqldb ) |
2950
|
|
|
|
|
|
|
or warn "Unable to complete transaction"; |
2951
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
=item as_one_transaction_if_supported() |
2953
|
|
|
|
|
|
|
|
2954
|
|
|
|
|
|
|
@results = $sqldb->as_one_transaction_if_supported($sub_ref, @args) |
2955
|
|
|
|
|
|
|
|
2956
|
|
|
|
|
|
|
If transaction support is available, this is equivalent to as_one_transaction. |
2957
|
|
|
|
|
|
|
If transactions are not supported, simply performs the code in $sub_ref with |
2958
|
|
|
|
|
|
|
no transaction protection. |
2959
|
|
|
|
|
|
|
|
2960
|
|
|
|
|
|
|
This is obviously not very reliable, but may be of use in some ad-hoc utilities or test scripts. |
2961
|
|
|
|
|
|
|
|
2962
|
|
|
|
|
|
|
=back |
2963
|
|
|
|
|
|
|
|
2964
|
|
|
|
|
|
|
=cut |
2965
|
|
|
|
|
|
|
|
2966
|
|
|
|
|
|
|
sub are_transactions_supported { |
2967
|
|
|
|
|
|
|
my $self = shift; |
2968
|
|
|
|
|
|
|
my $dbh = $self->get_dbh; |
2969
|
|
|
|
|
|
|
eval { |
2970
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
2971
|
|
|
|
|
|
|
$dbh->begin_work; |
2972
|
|
|
|
|
|
|
$dbh->rollback; |
2973
|
|
|
|
|
|
|
}; |
2974
|
|
|
|
|
|
|
return ( $@ ) ? 0 : 1; |
2975
|
|
|
|
|
|
|
} |
2976
|
|
|
|
|
|
|
|
2977
|
|
|
|
|
|
|
sub as_one_transaction { |
2978
|
|
|
|
|
|
|
my $self = shift; |
2979
|
|
|
|
|
|
|
my $code = shift; |
2980
|
|
|
|
|
|
|
|
2981
|
|
|
|
|
|
|
my $dbh = $self->get_dbh; |
2982
|
|
|
|
|
|
|
my @results; |
2983
|
|
|
|
|
|
|
$dbh->begin_work; |
2984
|
|
|
|
|
|
|
my $wantarray = wantarray(); # Capture before eval which otherwise obscures it |
2985
|
|
|
|
|
|
|
eval { |
2986
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
2987
|
|
|
|
|
|
|
@results = $wantarray ? &$code( @_ ) : scalar( &$code( @_ ) ); |
2988
|
|
|
|
|
|
|
$dbh->commit; |
2989
|
|
|
|
|
|
|
}; |
2990
|
|
|
|
|
|
|
if ($@) { |
2991
|
|
|
|
|
|
|
warn "DBIx::SQLEngine Transaction Aborted: $@"; |
2992
|
|
|
|
|
|
|
$dbh->rollback; |
2993
|
|
|
|
|
|
|
} |
2994
|
|
|
|
|
|
|
$wantarray ? @results : $results[0] |
2995
|
|
|
|
|
|
|
} |
2996
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
sub as_one_transaction_if_supported { |
2998
|
|
|
|
|
|
|
my $self = shift; |
2999
|
|
|
|
|
|
|
my $code = shift; |
3000
|
|
|
|
|
|
|
|
3001
|
|
|
|
|
|
|
my $dbh = $self->get_dbh; |
3002
|
|
|
|
|
|
|
my @results; |
3003
|
|
|
|
|
|
|
my $in_transaction; |
3004
|
|
|
|
|
|
|
my $wantarray = wantarray(); # Capture before eval which otherwise obscures it |
3005
|
|
|
|
|
|
|
eval { |
3006
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
3007
|
|
|
|
|
|
|
$dbh->begin_work; |
3008
|
|
|
|
|
|
|
$in_transaction = 1; |
3009
|
|
|
|
|
|
|
}; |
3010
|
|
|
|
|
|
|
eval { |
3011
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
3012
|
|
|
|
|
|
|
@results = $wantarray ? &$code( @_ ) : scalar( &$code( @_ ) ); |
3013
|
|
|
|
|
|
|
$dbh->commit if ( $in_transaction ); |
3014
|
|
|
|
|
|
|
}; |
3015
|
|
|
|
|
|
|
if ($@) { |
3016
|
|
|
|
|
|
|
warn "DBIx::SQLEngine Transaction Aborted: $@"; |
3017
|
|
|
|
|
|
|
$dbh->rollback if ( $in_transaction ); |
3018
|
|
|
|
|
|
|
} |
3019
|
|
|
|
|
|
|
$wantarray ? @results : $results[0] |
3020
|
|
|
|
|
|
|
} |
3021
|
|
|
|
|
|
|
|
3022
|
|
|
|
|
|
|
######################################################################## |
3023
|
|
|
|
|
|
|
|
3024
|
|
|
|
|
|
|
=head2 Create and Drop Indexes |
3025
|
|
|
|
|
|
|
|
3026
|
|
|
|
|
|
|
Note: this feature has been added recently, and the interface is subject to change. |
3027
|
|
|
|
|
|
|
|
3028
|
|
|
|
|
|
|
B These methods create and drop indexes. |
3029
|
|
|
|
|
|
|
|
3030
|
|
|
|
|
|
|
=over 4 |
3031
|
|
|
|
|
|
|
|
3032
|
|
|
|
|
|
|
=item create_index() |
3033
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
$sqldb->create_index( %clauses ) |
3035
|
|
|
|
|
|
|
|
3036
|
|
|
|
|
|
|
=item drop_index() |
3037
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
$sqldb->drop_index( %clauses ) |
3039
|
|
|
|
|
|
|
|
3040
|
|
|
|
|
|
|
=back |
3041
|
|
|
|
|
|
|
|
3042
|
|
|
|
|
|
|
B These methods are called by the public index methods. |
3043
|
|
|
|
|
|
|
|
3044
|
|
|
|
|
|
|
=over 4 |
3045
|
|
|
|
|
|
|
|
3046
|
|
|
|
|
|
|
=item sql_create_index() |
3047
|
|
|
|
|
|
|
|
3048
|
|
|
|
|
|
|
$sqldb->sql_create_index( %clauses ) : $sql, @params |
3049
|
|
|
|
|
|
|
|
3050
|
|
|
|
|
|
|
=item sql_drop_index() |
3051
|
|
|
|
|
|
|
|
3052
|
|
|
|
|
|
|
$sqldb->sql_drop_index( %clauses ) : $sql, @params |
3053
|
|
|
|
|
|
|
|
3054
|
|
|
|
|
|
|
=back |
3055
|
|
|
|
|
|
|
|
3056
|
|
|
|
|
|
|
B These samples demonstrate use of the index feature. |
3057
|
|
|
|
|
|
|
|
3058
|
|
|
|
|
|
|
=over 2 |
3059
|
|
|
|
|
|
|
|
3060
|
|
|
|
|
|
|
=item * |
3061
|
|
|
|
|
|
|
|
3062
|
|
|
|
|
|
|
$sqldb->create_index( |
3063
|
|
|
|
|
|
|
table => $table_name, columns => @columns |
3064
|
|
|
|
|
|
|
); |
3065
|
|
|
|
|
|
|
|
3066
|
|
|
|
|
|
|
$sqldb->drop_index( |
3067
|
|
|
|
|
|
|
table => $table_name, columns => @columns |
3068
|
|
|
|
|
|
|
); |
3069
|
|
|
|
|
|
|
|
3070
|
|
|
|
|
|
|
=item * |
3071
|
|
|
|
|
|
|
|
3072
|
|
|
|
|
|
|
$sqldb->create_index( |
3073
|
|
|
|
|
|
|
name => $index_name, table => $table_name, columns => @columns |
3074
|
|
|
|
|
|
|
); |
3075
|
|
|
|
|
|
|
|
3076
|
|
|
|
|
|
|
$sqldb->drop_index( |
3077
|
|
|
|
|
|
|
name => $index_name |
3078
|
|
|
|
|
|
|
); |
3079
|
|
|
|
|
|
|
|
3080
|
|
|
|
|
|
|
=back |
3081
|
|
|
|
|
|
|
|
3082
|
|
|
|
|
|
|
=cut |
3083
|
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
|
sub create_index { |
3085
|
|
|
|
|
|
|
my $self = shift; |
3086
|
|
|
|
|
|
|
$self->do_sql( $self->sql_create_index( @_ ) ); |
3087
|
|
|
|
|
|
|
} |
3088
|
|
|
|
|
|
|
|
3089
|
|
|
|
|
|
|
sub drop_index { |
3090
|
|
|
|
|
|
|
my $self = shift; |
3091
|
|
|
|
|
|
|
$self->do_sql( $self->sql_drop_index( @_ ) ); |
3092
|
|
|
|
|
|
|
} |
3093
|
|
|
|
|
|
|
|
3094
|
|
|
|
|
|
|
sub sql_create_index { |
3095
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
my $keyword = 'create'; |
3098
|
|
|
|
|
|
|
my $obj_type = 'index'; |
3099
|
|
|
|
|
|
|
|
3100
|
|
|
|
|
|
|
my $table = delete $clauses{'table'}; |
3101
|
|
|
|
|
|
|
if ( ! $table ) { |
3102
|
|
|
|
|
|
|
confess("Table name is missing or empty"); |
3103
|
|
|
|
|
|
|
} elsif ( ! ref( $table ) and length( $table ) ) { |
3104
|
|
|
|
|
|
|
# should be a single table name |
3105
|
|
|
|
|
|
|
} else { |
3106
|
|
|
|
|
|
|
confess("Unsupported table spec '$table'"); |
3107
|
|
|
|
|
|
|
} |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
my $columns = delete $clauses{'column'} || delete $clauses{'columns'}; |
3110
|
|
|
|
|
|
|
if ( ! $columns ) { |
3111
|
|
|
|
|
|
|
confess("Column names is missing or empty"); |
3112
|
|
|
|
|
|
|
} elsif ( ! ref( $columns ) and length( $columns ) ) { |
3113
|
|
|
|
|
|
|
# should be one or more comma-separated column names |
3114
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($columns, 'column_names') ) { |
3115
|
|
|
|
|
|
|
$columns = join ', ', $columns->column_names; |
3116
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'ARRAY' ) { |
3117
|
|
|
|
|
|
|
$columns = join ', ', @$columns; |
3118
|
|
|
|
|
|
|
} else { |
3119
|
|
|
|
|
|
|
confess("Unsupported column spec '$columns'"); |
3120
|
|
|
|
|
|
|
} |
3121
|
|
|
|
|
|
|
|
3122
|
|
|
|
|
|
|
my $name = delete $clauses{'name'}; |
3123
|
|
|
|
|
|
|
if ( ! $name ) { |
3124
|
|
|
|
|
|
|
$name = join('_', $table, split(/\,\s*/, $columns), 'idx'); |
3125
|
|
|
|
|
|
|
} elsif ( ! ref( $name ) and length( $name ) ) { |
3126
|
|
|
|
|
|
|
# should be an index name |
3127
|
|
|
|
|
|
|
} else { |
3128
|
|
|
|
|
|
|
confess("Unsupported name spec '$name'"); |
3129
|
|
|
|
|
|
|
} |
3130
|
|
|
|
|
|
|
|
3131
|
|
|
|
|
|
|
if ( my $unique = delete $clauses{'unique'} ) { |
3132
|
|
|
|
|
|
|
$obj_type = "unique index"; |
3133
|
|
|
|
|
|
|
} |
3134
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
return "$keyword $obj_type $name on $table ( $columns )"; |
3136
|
|
|
|
|
|
|
} |
3137
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
sub sql_drop_index { |
3139
|
|
|
|
|
|
|
my ( $self, %clauses ) = @_; |
3140
|
|
|
|
|
|
|
|
3141
|
|
|
|
|
|
|
my $keyword = 'create'; |
3142
|
|
|
|
|
|
|
my $obj_type = 'index'; |
3143
|
|
|
|
|
|
|
|
3144
|
|
|
|
|
|
|
my $name = delete $clauses{'name'}; |
3145
|
|
|
|
|
|
|
if ( ! $name ) { |
3146
|
|
|
|
|
|
|
my $table = delete $clauses{'table'}; |
3147
|
|
|
|
|
|
|
if ( ! $table ) { |
3148
|
|
|
|
|
|
|
confess("Table name is missing or empty"); |
3149
|
|
|
|
|
|
|
} elsif ( ! ref( $table ) and length( $table ) ) { |
3150
|
|
|
|
|
|
|
# should be a single table name |
3151
|
|
|
|
|
|
|
} else { |
3152
|
|
|
|
|
|
|
confess("Unsupported table spec '$table'"); |
3153
|
|
|
|
|
|
|
} |
3154
|
|
|
|
|
|
|
|
3155
|
|
|
|
|
|
|
my $columns = delete $clauses{'column'} || delete $clauses{'columns'}; |
3156
|
|
|
|
|
|
|
if ( ! $columns ) { |
3157
|
|
|
|
|
|
|
confess("Column names is missing or empty"); |
3158
|
|
|
|
|
|
|
} elsif ( ! ref( $columns ) and length( $columns ) ) { |
3159
|
|
|
|
|
|
|
# should be one or more comma-separated column names |
3160
|
|
|
|
|
|
|
} elsif ( UNIVERSAL::can($columns, 'column_names') ) { |
3161
|
|
|
|
|
|
|
$columns = join ', ', $columns->column_names; |
3162
|
|
|
|
|
|
|
} elsif ( ref($columns) eq 'ARRAY' ) { |
3163
|
|
|
|
|
|
|
$columns = join ', ', @$columns; |
3164
|
|
|
|
|
|
|
} else { |
3165
|
|
|
|
|
|
|
confess("Unsupported column spec '$columns'"); |
3166
|
|
|
|
|
|
|
} |
3167
|
|
|
|
|
|
|
|
3168
|
|
|
|
|
|
|
$name = join('_', $table, split(/\,\s*/, $columns), 'idx'); |
3169
|
|
|
|
|
|
|
} elsif ( ! ref( $name ) and length( $name ) ) { |
3170
|
|
|
|
|
|
|
# should be an index name |
3171
|
|
|
|
|
|
|
} else { |
3172
|
|
|
|
|
|
|
confess("Unsupported name spec '$name'"); |
3173
|
|
|
|
|
|
|
} |
3174
|
|
|
|
|
|
|
|
3175
|
|
|
|
|
|
|
return "$keyword $obj_type $name"; |
3176
|
|
|
|
|
|
|
} |
3177
|
|
|
|
|
|
|
|
3178
|
|
|
|
|
|
|
######################################################################## |
3179
|
|
|
|
|
|
|
|
3180
|
|
|
|
|
|
|
=head2 Call, Create and Drop Stored Procedures |
3181
|
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
|
Note: this feature has been added recently, and the interface is subject to change. |
3183
|
|
|
|
|
|
|
|
3184
|
|
|
|
|
|
|
These methods are all subclass hooks. Fail with message "DBMS-Specific Function". |
3185
|
|
|
|
|
|
|
|
3186
|
|
|
|
|
|
|
B These methods create, drop, and use stored procedures. |
3187
|
|
|
|
|
|
|
|
3188
|
|
|
|
|
|
|
=over 4 |
3189
|
|
|
|
|
|
|
|
3190
|
|
|
|
|
|
|
=item fetch_storedproc() |
3191
|
|
|
|
|
|
|
|
3192
|
|
|
|
|
|
|
$sqldb->fetch_storedproc( $proc_name, @arguments ) : $rows |
3193
|
|
|
|
|
|
|
|
3194
|
|
|
|
|
|
|
=item do_storedproc() |
3195
|
|
|
|
|
|
|
|
3196
|
|
|
|
|
|
|
$sqldb->do_storedproc( $proc_name, @arguments ) : $row_count |
3197
|
|
|
|
|
|
|
|
3198
|
|
|
|
|
|
|
=item create_storedproc() |
3199
|
|
|
|
|
|
|
|
3200
|
|
|
|
|
|
|
$sqldb->create_storedproc( $proc_name, $definition ) |
3201
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
=item drop_storedproc() |
3203
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
$sqldb->drop_storedproc( $proc_name ) |
3205
|
|
|
|
|
|
|
|
3206
|
|
|
|
|
|
|
=back |
3207
|
|
|
|
|
|
|
|
3208
|
|
|
|
|
|
|
=cut |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
sub fetch_storedproc { confess("DBMS-Specific Function") } |
3211
|
|
|
|
|
|
|
sub do_storedproc { confess("DBMS-Specific Function") } |
3212
|
|
|
|
|
|
|
sub create_storedproc { confess("DBMS-Specific Function") } |
3213
|
|
|
|
|
|
|
sub drop_storedproc { confess("DBMS-Specific Function") } |
3214
|
|
|
|
|
|
|
|
3215
|
|
|
|
|
|
|
######################################################################## |
3216
|
|
|
|
|
|
|
|
3217
|
|
|
|
|
|
|
=head2 Create and Drop Databases |
3218
|
|
|
|
|
|
|
|
3219
|
|
|
|
|
|
|
Note: this feature has been added recently, and the interface is subject to change. |
3220
|
|
|
|
|
|
|
|
3221
|
|
|
|
|
|
|
B These methods create and drop database partitions. |
3222
|
|
|
|
|
|
|
|
3223
|
|
|
|
|
|
|
=over 4 |
3224
|
|
|
|
|
|
|
|
3225
|
|
|
|
|
|
|
=item create_database() |
3226
|
|
|
|
|
|
|
|
3227
|
|
|
|
|
|
|
$sqldb->create_database( $db_name ) |
3228
|
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
3230
|
|
|
|
|
|
|
|
3231
|
|
|
|
|
|
|
=item drop_database() |
3232
|
|
|
|
|
|
|
|
3233
|
|
|
|
|
|
|
$sqldb->drop_database( $db_name ) |
3234
|
|
|
|
|
|
|
|
3235
|
|
|
|
|
|
|
Fails with message "DBMS-Specific Function". |
3236
|
|
|
|
|
|
|
|
3237
|
|
|
|
|
|
|
=back |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
=cut |
3240
|
|
|
|
|
|
|
|
3241
|
|
|
|
|
|
|
sub create_database { confess("DBMS-Specific Function") } |
3242
|
|
|
|
|
|
|
sub drop_database { confess("DBMS-Specific Function") } |
3243
|
|
|
|
|
|
|
|
3244
|
|
|
|
|
|
|
sub sql_create_database { |
3245
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
3246
|
|
|
|
|
|
|
return "create database $name" |
3247
|
|
|
|
|
|
|
} |
3248
|
|
|
|
|
|
|
|
3249
|
|
|
|
|
|
|
sub sql_drop_database { |
3250
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
3251
|
|
|
|
|
|
|
return "drop database $name" |
3252
|
|
|
|
|
|
|
} |
3253
|
|
|
|
|
|
|
|
3254
|
|
|
|
|
|
|
######################################################################## |
3255
|
|
|
|
|
|
|
|
3256
|
|
|
|
|
|
|
######################################################################## |
3257
|
|
|
|
|
|
|
|
3258
|
|
|
|
|
|
|
=head1 CONNECTION METHODS (DBI DBH) |
3259
|
|
|
|
|
|
|
|
3260
|
|
|
|
|
|
|
The following methods manage the DBI database handle through which we communicate with the datasource. |
3261
|
|
|
|
|
|
|
|
3262
|
|
|
|
|
|
|
=head2 Accessing the DBH |
3263
|
|
|
|
|
|
|
|
3264
|
|
|
|
|
|
|
B You may use these methods to perform your own low-level DBI access. |
3265
|
|
|
|
|
|
|
|
3266
|
|
|
|
|
|
|
=over 4 |
3267
|
|
|
|
|
|
|
|
3268
|
|
|
|
|
|
|
=item get_dbh() |
3269
|
|
|
|
|
|
|
|
3270
|
|
|
|
|
|
|
$sqldb->get_dbh () : $dbh |
3271
|
|
|
|
|
|
|
|
3272
|
|
|
|
|
|
|
Get the current DBH |
3273
|
|
|
|
|
|
|
|
3274
|
|
|
|
|
|
|
=item dbh_func() |
3275
|
|
|
|
|
|
|
|
3276
|
|
|
|
|
|
|
$sqldb->dbh_func ( $func_name, @args ) : @results |
3277
|
|
|
|
|
|
|
|
3278
|
|
|
|
|
|
|
Calls the DBI func() method on the database handle returned by get_dbh, passing the provided function name and arguments. See the documentation for your DBD driver to learn which functions it supports. |
3279
|
|
|
|
|
|
|
|
3280
|
|
|
|
|
|
|
=back |
3281
|
|
|
|
|
|
|
|
3282
|
|
|
|
|
|
|
=cut |
3283
|
|
|
|
|
|
|
|
3284
|
|
|
|
|
|
|
sub get_dbh { |
3285
|
|
|
|
|
|
|
# maybe add code here to check connection status. |
3286
|
|
|
|
|
|
|
# or maybe add check once every 10 get_dbh's... |
3287
|
|
|
|
|
|
|
my $self = shift; |
3288
|
|
|
|
|
|
|
( ref $self ) or ( confess("Not a class method") ); |
3289
|
|
|
|
|
|
|
return $self->{dbh}; |
3290
|
|
|
|
|
|
|
} |
3291
|
|
|
|
|
|
|
|
3292
|
|
|
|
|
|
|
sub dbh_func { |
3293
|
|
|
|
|
|
|
my $self = shift; |
3294
|
|
|
|
|
|
|
my $dbh = $self->get_dbh; |
3295
|
|
|
|
|
|
|
my $func = shift; |
3296
|
|
|
|
|
|
|
$dbh->func( $func, @_ ); |
3297
|
|
|
|
|
|
|
} |
3298
|
|
|
|
|
|
|
|
3299
|
|
|
|
|
|
|
######################################################################## |
3300
|
|
|
|
|
|
|
|
3301
|
|
|
|
|
|
|
=head2 Initialization and Reconnection |
3302
|
|
|
|
|
|
|
|
3303
|
|
|
|
|
|
|
B These methods are invoked automatically. |
3304
|
|
|
|
|
|
|
|
3305
|
|
|
|
|
|
|
=over 4 |
3306
|
|
|
|
|
|
|
|
3307
|
|
|
|
|
|
|
=item _init() |
3308
|
|
|
|
|
|
|
|
3309
|
|
|
|
|
|
|
$sqldb->_init () |
3310
|
|
|
|
|
|
|
|
3311
|
|
|
|
|
|
|
Empty subclass hook. Called by DBIx::AnyDBD after connection is made and class hierarchy has been juggled. |
3312
|
|
|
|
|
|
|
|
3313
|
|
|
|
|
|
|
=item reconnect() |
3314
|
|
|
|
|
|
|
|
3315
|
|
|
|
|
|
|
$sqldb->reconnect () |
3316
|
|
|
|
|
|
|
|
3317
|
|
|
|
|
|
|
Attempt to re-establish connection with original parameters |
3318
|
|
|
|
|
|
|
|
3319
|
|
|
|
|
|
|
=back |
3320
|
|
|
|
|
|
|
|
3321
|
|
|
|
|
|
|
=cut |
3322
|
|
|
|
|
|
|
|
3323
|
|
|
|
|
|
|
sub _init { } |
3324
|
|
|
|
|
|
|
|
3325
|
|
|
|
|
|
|
sub reconnect { |
3326
|
|
|
|
|
|
|
my $self = shift; |
3327
|
|
|
|
|
|
|
my $reconnector = $self->{'reconnector'} |
3328
|
|
|
|
|
|
|
or croak("Can't reconnect; reconnector is missing"); |
3329
|
|
|
|
|
|
|
if ( $self->{'dbh'} ) { |
3330
|
|
|
|
|
|
|
$self->{'dbh'}->disconnect; |
3331
|
|
|
|
|
|
|
} |
3332
|
|
|
|
|
|
|
$self->{'dbh'} = &$reconnector() |
3333
|
|
|
|
|
|
|
or croak("Can't reconnect; reconnector returned nothing"); |
3334
|
|
|
|
|
|
|
$self->rebless; |
3335
|
|
|
|
|
|
|
$self->_init if $self->can('_init'); |
3336
|
|
|
|
|
|
|
return $self; |
3337
|
|
|
|
|
|
|
} |
3338
|
|
|
|
|
|
|
|
3339
|
|
|
|
|
|
|
######################################################################## |
3340
|
|
|
|
|
|
|
|
3341
|
|
|
|
|
|
|
=head2 Checking For Connection |
3342
|
|
|
|
|
|
|
|
3343
|
|
|
|
|
|
|
To determine if the connection is working. |
3344
|
|
|
|
|
|
|
|
3345
|
|
|
|
|
|
|
B These methods are invoked automatically. |
3346
|
|
|
|
|
|
|
|
3347
|
|
|
|
|
|
|
=over 4 |
3348
|
|
|
|
|
|
|
|
3349
|
|
|
|
|
|
|
=item detect_any() |
3350
|
|
|
|
|
|
|
|
3351
|
|
|
|
|
|
|
$sqldb->detect_any () : $boolean |
3352
|
|
|
|
|
|
|
$sqldb->detect_any ( 1 ) : $boolean |
3353
|
|
|
|
|
|
|
|
3354
|
|
|
|
|
|
|
Attempts to confirm that values can be retreived from the database, |
3355
|
|
|
|
|
|
|
allowing us to determine if the connection is working, using a |
3356
|
|
|
|
|
|
|
server-specific "trivial" or "guaranteed" query provided by |
3357
|
|
|
|
|
|
|
sql_detect_any. |
3358
|
|
|
|
|
|
|
|
3359
|
|
|
|
|
|
|
Catches any exceptions; if the query fails for any reason we return |
3360
|
|
|
|
|
|
|
a false value. The reason for the failure is logged via warn() |
3361
|
|
|
|
|
|
|
unless an additional argument with a true value is passed to surpress |
3362
|
|
|
|
|
|
|
those error messages. |
3363
|
|
|
|
|
|
|
|
3364
|
|
|
|
|
|
|
=item sql_detect_any() |
3365
|
|
|
|
|
|
|
|
3366
|
|
|
|
|
|
|
$sqldb->sql_detect_any : %sql_select_clauses |
3367
|
|
|
|
|
|
|
|
3368
|
|
|
|
|
|
|
Subclass hook. Retrieve something from the database that is guaranteed to exist. |
3369
|
|
|
|
|
|
|
Defaults to SQL literal "select 1", which may not work on all platforms. Your database driver might prefer something else, like Oracle's "select 1 from dual". |
3370
|
|
|
|
|
|
|
|
3371
|
|
|
|
|
|
|
=item check_or_reconnect() |
3372
|
|
|
|
|
|
|
|
3373
|
|
|
|
|
|
|
$sqldb->check_or_reconnect () : $dbh |
3374
|
|
|
|
|
|
|
|
3375
|
|
|
|
|
|
|
Confirms the current DBH is available with detect_any() or calls reconnect(). |
3376
|
|
|
|
|
|
|
|
3377
|
|
|
|
|
|
|
=back |
3378
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
=cut |
3380
|
|
|
|
|
|
|
|
3381
|
|
|
|
|
|
|
sub detect_any { |
3382
|
|
|
|
|
|
|
my $self = shift; |
3383
|
|
|
|
|
|
|
my $quietly = shift; |
3384
|
|
|
|
|
|
|
my $result = 0; |
3385
|
|
|
|
|
|
|
eval { |
3386
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
3387
|
|
|
|
|
|
|
$self->fetch_one_value($self->sql_detect_any); |
3388
|
|
|
|
|
|
|
$result = 1; |
3389
|
|
|
|
|
|
|
}; |
3390
|
|
|
|
|
|
|
$result or warn "Unable to detect_any: $@" unless $quietly; |
3391
|
|
|
|
|
|
|
return $result; |
3392
|
|
|
|
|
|
|
} |
3393
|
|
|
|
|
|
|
|
3394
|
|
|
|
|
|
|
sub sql_detect_any { |
3395
|
|
|
|
|
|
|
return ( sql => 'select 1' ) |
3396
|
|
|
|
|
|
|
} |
3397
|
|
|
|
|
|
|
|
3398
|
|
|
|
|
|
|
sub check_or_reconnect { |
3399
|
|
|
|
|
|
|
my $self = shift; |
3400
|
|
|
|
|
|
|
$self->detect_any or $self->reconnect; |
3401
|
|
|
|
|
|
|
$self->get_dbh or confess("Failed to get_dbh after check_or_reconnect") |
3402
|
|
|
|
|
|
|
} |
3403
|
|
|
|
|
|
|
|
3404
|
|
|
|
|
|
|
######################################################################## |
3405
|
|
|
|
|
|
|
|
3406
|
|
|
|
|
|
|
######################################################################## |
3407
|
|
|
|
|
|
|
|
3408
|
|
|
|
|
|
|
=head1 STATEMENT METHODS (DBI STH) |
3409
|
|
|
|
|
|
|
|
3410
|
|
|
|
|
|
|
The following methods manipulate DBI statement handles as part of processing queries and their results. |
3411
|
|
|
|
|
|
|
|
3412
|
|
|
|
|
|
|
B These methods allow arbitrary SQL statements to be executed. |
3413
|
|
|
|
|
|
|
Note that no processing of the SQL query string is performed, so if you call |
3414
|
|
|
|
|
|
|
these low-level functions it is up to you to ensure that the query is correct |
3415
|
|
|
|
|
|
|
and will function as expected when passed to whichever data source the |
3416
|
|
|
|
|
|
|
SQLEngine Driver is using. |
3417
|
|
|
|
|
|
|
|
3418
|
|
|
|
|
|
|
=cut |
3419
|
|
|
|
|
|
|
|
3420
|
|
|
|
|
|
|
######################################################################## |
3421
|
|
|
|
|
|
|
|
3422
|
|
|
|
|
|
|
=head2 Generic Query Execution |
3423
|
|
|
|
|
|
|
|
3424
|
|
|
|
|
|
|
$db->do_sql('insert into table values (?, ?)', 'A', 1); |
3425
|
|
|
|
|
|
|
my $rows = $db->fetch_sql('select * from table where status = ?', 2); |
3426
|
|
|
|
|
|
|
|
3427
|
|
|
|
|
|
|
Execute and fetch some kind of result from a given SQL statement. Internally, these methods are used by the other do_, fetch_ and visit_ methods described above. Each one calls the try_query method with the provided query and parameters, and passes the name of a result method to be used in extracting values from the statement handle. |
3428
|
|
|
|
|
|
|
|
3429
|
|
|
|
|
|
|
B |
3430
|
|
|
|
|
|
|
|
3431
|
|
|
|
|
|
|
=over 4 |
3432
|
|
|
|
|
|
|
|
3433
|
|
|
|
|
|
|
=item do_sql() |
3434
|
|
|
|
|
|
|
|
3435
|
|
|
|
|
|
|
$sqldb->do_sql ($sql, @params) : $rowcount |
3436
|
|
|
|
|
|
|
|
3437
|
|
|
|
|
|
|
Execute a SQL query by sending it to the DBI connection, and returns the number of rows modified, or -1 if unknown. |
3438
|
|
|
|
|
|
|
|
3439
|
|
|
|
|
|
|
=item fetch_sql() |
3440
|
|
|
|
|
|
|
|
3441
|
|
|
|
|
|
|
$sqldb->fetch_sql ($sql, @params) : $row_hash_ary |
3442
|
|
|
|
|
|
|
$sqldb->fetch_sql ($sql, @params) : ( $row_hash_ary, $columnset ) |
3443
|
|
|
|
|
|
|
|
3444
|
|
|
|
|
|
|
Execute a SQL query by sending it to the DBI connection, and returns any rows that were produced, as an array of hashrefs, with the values in each entry keyed by column name. If called in a list context, also returns a reference to an array of information about the columns returned by the query. |
3445
|
|
|
|
|
|
|
|
3446
|
|
|
|
|
|
|
=item fetch_sql_rows() |
3447
|
|
|
|
|
|
|
|
3448
|
|
|
|
|
|
|
$sqldb->fetch_sql_rows ($sql, @params) : $row_ary_ary |
3449
|
|
|
|
|
|
|
$sqldb->fetch_sql_rows ($sql, @params) : ( $row_ary_ary, $columnset ) |
3450
|
|
|
|
|
|
|
|
3451
|
|
|
|
|
|
|
Execute a SQL query by sending it to the DBI connection, and returns any rows that were produced, as an array of arrayrefs, with the values in each entry keyed by column order. If called in a list context, also returns a reference to an array of information about the columns returned by the query. |
3452
|
|
|
|
|
|
|
|
3453
|
|
|
|
|
|
|
=item visit_sql() |
3454
|
|
|
|
|
|
|
|
3455
|
|
|
|
|
|
|
$sqldb->visit_sql ($coderef, $sql, @params) : @results |
3456
|
|
|
|
|
|
|
$sqldb->visit_sql ($sql, @params, $coderef) : @results |
3457
|
|
|
|
|
|
|
|
3458
|
|
|
|
|
|
|
Similar to fetch_sql, but calls your coderef on each row, passing it as a hashref, and returns the results of each of those calls. For your convenience, will accept a coderef as either the first or the last argument. |
3459
|
|
|
|
|
|
|
|
3460
|
|
|
|
|
|
|
=item visit_sql_rows() |
3461
|
|
|
|
|
|
|
|
3462
|
|
|
|
|
|
|
$sqldb->visit_sql ($coderef, $sql, @params) : @results |
3463
|
|
|
|
|
|
|
$sqldb->visit_sql ($sql, @params, $coderef) : @results |
3464
|
|
|
|
|
|
|
|
3465
|
|
|
|
|
|
|
Similar to fetch_sql, but calls your coderef on each row, passing it as a list of values, and returns the results of each of those calls. For your convenience, will accept a coderef as either the first or the last argument. |
3466
|
|
|
|
|
|
|
|
3467
|
|
|
|
|
|
|
=item fetchsub_sql() |
3468
|
|
|
|
|
|
|
|
3469
|
|
|
|
|
|
|
$sqldb->fetchsub_sql ($sql, @params) : $coderef |
3470
|
|
|
|
|
|
|
|
3471
|
|
|
|
|
|
|
Execute a SQL query by sending it to the DBI connection, and returns a code reference that can be called repeatedly to invoke the fetchrow_hashref() method on the statement handle. |
3472
|
|
|
|
|
|
|
|
3473
|
|
|
|
|
|
|
=item fetchsub_sql_rows() |
3474
|
|
|
|
|
|
|
|
3475
|
|
|
|
|
|
|
$sqldb->fetchsub_sql_rows ($sql, @params) : $coderef |
3476
|
|
|
|
|
|
|
|
3477
|
|
|
|
|
|
|
Execute a SQL query by sending it to the DBI connection, and returns a code reference that can be called repeatedly to invoke the fetchrow_array() method on the statement handle. |
3478
|
|
|
|
|
|
|
|
3479
|
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
|
=back |
3481
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
=cut |
3483
|
|
|
|
|
|
|
|
3484
|
|
|
|
|
|
|
# $rowcount = $self->do_sql($sql); |
3485
|
|
|
|
|
|
|
# $rowcount = $self->do_sql($sql, @params); |
3486
|
|
|
|
|
|
|
sub do_sql { |
3487
|
|
|
|
|
|
|
(shift)->try_query( (shift), [ @_ ], 'get_execute_rowcount' ) |
3488
|
|
|
|
|
|
|
} |
3489
|
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
# $array_of_hashes = $self->fetch_sql($sql); |
3491
|
|
|
|
|
|
|
# $array_of_hashes = $self->fetch_sql($sql, @params); |
3492
|
|
|
|
|
|
|
# ($array_of_hashes, $columns) = $self->fetch_sql($sql); |
3493
|
|
|
|
|
|
|
sub fetch_sql { |
3494
|
|
|
|
|
|
|
(shift)->try_query( (shift), [ @_ ], 'fetchall_hashref_columns' ) |
3495
|
|
|
|
|
|
|
} |
3496
|
|
|
|
|
|
|
|
3497
|
|
|
|
|
|
|
# $array_of_arrays = $self->fetch_sql_rows($sql); |
3498
|
|
|
|
|
|
|
# $array_of_arrays = $self->fetch_sql_rows($sql, @params); |
3499
|
|
|
|
|
|
|
# ($array_of_arrays, $columns) = $self->fetch_sql_rows($sql); |
3500
|
|
|
|
|
|
|
sub fetch_sql_rows { |
3501
|
|
|
|
|
|
|
(shift)->try_query( (shift), [ @_ ], 'fetchall_arrayref_columns' ) |
3502
|
|
|
|
|
|
|
} |
3503
|
|
|
|
|
|
|
|
3504
|
|
|
|
|
|
|
# @results = $self->visit_sql($coderef, $sql, @params); |
3505
|
|
|
|
|
|
|
# @results = $self->visit_sql($sql, @params, $coderef); |
3506
|
|
|
|
|
|
|
sub visit_sql { |
3507
|
|
|
|
|
|
|
my $self = shift; |
3508
|
|
|
|
|
|
|
my $coderef = ( ref($_[0]) ? shift : pop ); |
3509
|
|
|
|
|
|
|
$self->try_query( (shift), [ @_ ], 'visitall_hashref', $coderef ) |
3510
|
|
|
|
|
|
|
} |
3511
|
|
|
|
|
|
|
|
3512
|
|
|
|
|
|
|
# @results = $self->visit_sql_rows($coderef, $sql, @params); |
3513
|
|
|
|
|
|
|
# @results = $self->visit_sql_rows($sql, @params, $coderef); |
3514
|
|
|
|
|
|
|
sub visit_sql_rows { |
3515
|
|
|
|
|
|
|
my $self = shift; |
3516
|
|
|
|
|
|
|
my $coderef = ( ref($_[0]) ? shift : pop ); |
3517
|
|
|
|
|
|
|
$self->try_query( (shift), [ @_ ], 'visitall_array', $coderef ) |
3518
|
|
|
|
|
|
|
} |
3519
|
|
|
|
|
|
|
|
3520
|
|
|
|
|
|
|
# $coderef = $self->fetchsub_sql($sql, @params); |
3521
|
|
|
|
|
|
|
sub fetchsub_sql { |
3522
|
|
|
|
|
|
|
(shift)->try_query( (shift), [ @_ ], 'fetchsub_hashref' ) |
3523
|
|
|
|
|
|
|
} |
3524
|
|
|
|
|
|
|
|
3525
|
|
|
|
|
|
|
# $coderef = $self->fetchsub_sql_rows($sql, @params); |
3526
|
|
|
|
|
|
|
sub fetchsub_sql_rows { |
3527
|
|
|
|
|
|
|
(shift)->try_query( (shift), [ @_ ], 'fetchsub_array' ) |
3528
|
|
|
|
|
|
|
} |
3529
|
|
|
|
|
|
|
|
3530
|
|
|
|
|
|
|
######################################################################## |
3531
|
|
|
|
|
|
|
|
3532
|
|
|
|
|
|
|
=head2 Statement Error Handling |
3533
|
|
|
|
|
|
|
|
3534
|
|
|
|
|
|
|
B |
3535
|
|
|
|
|
|
|
|
3536
|
|
|
|
|
|
|
=over 4 |
3537
|
|
|
|
|
|
|
|
3538
|
|
|
|
|
|
|
=item try_query() |
3539
|
|
|
|
|
|
|
|
3540
|
|
|
|
|
|
|
$sqldb->try_query ( $sql, \@params, $result_method, @result_args ) : @results |
3541
|
|
|
|
|
|
|
|
3542
|
|
|
|
|
|
|
Error handling wrapper around the internal execute_query method. |
3543
|
|
|
|
|
|
|
|
3544
|
|
|
|
|
|
|
The $result_method should be the name of a method supported by that |
3545
|
|
|
|
|
|
|
Driver instance, typically one of those shown in the "Retrieving |
3546
|
|
|
|
|
|
|
Rows from an Executed Statement" section below. The @result_args, |
3547
|
|
|
|
|
|
|
if any, are passed to the named method along with the active |
3548
|
|
|
|
|
|
|
statement handle. |
3549
|
|
|
|
|
|
|
|
3550
|
|
|
|
|
|
|
=item catch_query_exception() |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
$sqldb->catch_query_exception ( $exception, $sql, \@params, |
3553
|
|
|
|
|
|
|
$result_method, @result_args ) : $resolution |
3554
|
|
|
|
|
|
|
|
3555
|
|
|
|
|
|
|
Exceptions are passed to catch_query_exception; if it returns "REDO" |
3556
|
|
|
|
|
|
|
the query will be retried up to five times. The superclass checks |
3557
|
|
|
|
|
|
|
the error message against the recoverable_query_exceptions; subclasses |
3558
|
|
|
|
|
|
|
may wish to override this to provide specialized handling. |
3559
|
|
|
|
|
|
|
|
3560
|
|
|
|
|
|
|
=item recoverable_query_exceptions() |
3561
|
|
|
|
|
|
|
|
3562
|
|
|
|
|
|
|
$sqldb->recoverable_query_exceptions() : @common_error_messages |
3563
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
Subclass hook. Defaults to empty. Subclasses may provide a list of |
3565
|
|
|
|
|
|
|
error messages which represent common communication failures or |
3566
|
|
|
|
|
|
|
other incidental errors. |
3567
|
|
|
|
|
|
|
|
3568
|
|
|
|
|
|
|
=back |
3569
|
|
|
|
|
|
|
|
3570
|
|
|
|
|
|
|
=cut |
3571
|
|
|
|
|
|
|
|
3572
|
|
|
|
|
|
|
# $results = $self->try_query($sql, \@params, $result_method, @result_args); |
3573
|
|
|
|
|
|
|
# @results = $self->try_query($sql, \@params, $result_method, @result_args); |
3574
|
|
|
|
|
|
|
sub try_query { |
3575
|
|
|
|
|
|
|
my $self = shift; |
3576
|
|
|
|
|
|
|
|
3577
|
|
|
|
|
|
|
my $attempts = 0; |
3578
|
|
|
|
|
|
|
my @results; |
3579
|
|
|
|
|
|
|
my $wantarray = wantarray(); # Capture before eval which otherwise obscures it |
3580
|
|
|
|
|
|
|
ATTEMPT: { |
3581
|
|
|
|
|
|
|
$attempts ++; |
3582
|
|
|
|
|
|
|
eval { |
3583
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
3584
|
|
|
|
|
|
|
|
3585
|
|
|
|
|
|
|
@results = $wantarray ? $self->execute_query(@_) |
3586
|
|
|
|
|
|
|
: scalar $self->execute_query(@_); |
3587
|
|
|
|
|
|
|
}; |
3588
|
|
|
|
|
|
|
if ( my $error = $@ ) { |
3589
|
|
|
|
|
|
|
my $catch = $self->catch_query_exception($error, @_); |
3590
|
|
|
|
|
|
|
if ( ! $catch ) { |
3591
|
|
|
|
|
|
|
die "DBIx::SQLEngine Query failed: $_[0]\n$error\n"; |
3592
|
|
|
|
|
|
|
} elsif ( $catch eq 'OK' ) { |
3593
|
|
|
|
|
|
|
return; |
3594
|
|
|
|
|
|
|
} elsif ( $catch eq 'REDO' ) { |
3595
|
|
|
|
|
|
|
if ( $attempts < 5 ) { |
3596
|
|
|
|
|
|
|
warn "DBIx::SQLEngine Retrying query after failure: $_[0]\n$error"; |
3597
|
|
|
|
|
|
|
redo ATTEMPT; |
3598
|
|
|
|
|
|
|
} else { |
3599
|
|
|
|
|
|
|
confess("DBIx::SQLEngine Query failed on $attempts consecutive attempts: $_[0]\n$error\n"); |
3600
|
|
|
|
|
|
|
} |
3601
|
|
|
|
|
|
|
} else { |
3602
|
|
|
|
|
|
|
confess("DBIx::SQLEngine Query failed: $_[0]\n$error" . |
3603
|
|
|
|
|
|
|
"Unknown return from exception handler '$catch'"); |
3604
|
|
|
|
|
|
|
} |
3605
|
|
|
|
|
|
|
} |
3606
|
|
|
|
|
|
|
$wantarray ? @results : $results[0] |
3607
|
|
|
|
|
|
|
} |
3608
|
|
|
|
|
|
|
} |
3609
|
|
|
|
|
|
|
|
3610
|
|
|
|
|
|
|
sub catch_query_exception { |
3611
|
|
|
|
|
|
|
my $self = shift; |
3612
|
|
|
|
|
|
|
my $error = shift; |
3613
|
|
|
|
|
|
|
|
3614
|
|
|
|
|
|
|
foreach my $pattern ( $self->recoverable_query_exceptions() ) { |
3615
|
|
|
|
|
|
|
if ( $error =~ /$pattern/i ) { |
3616
|
|
|
|
|
|
|
$self->reconnect() and return 'REDO'; |
3617
|
|
|
|
|
|
|
} |
3618
|
|
|
|
|
|
|
} |
3619
|
|
|
|
|
|
|
|
3620
|
|
|
|
|
|
|
return; |
3621
|
|
|
|
|
|
|
} |
3622
|
|
|
|
|
|
|
|
3623
|
|
|
|
|
|
|
sub recoverable_query_exceptions { |
3624
|
|
|
|
|
|
|
return () |
3625
|
|
|
|
|
|
|
} |
3626
|
|
|
|
|
|
|
|
3627
|
|
|
|
|
|
|
######################################################################## |
3628
|
|
|
|
|
|
|
|
3629
|
|
|
|
|
|
|
=head2 Statement Handle Lifecycle |
3630
|
|
|
|
|
|
|
|
3631
|
|
|
|
|
|
|
These are internal methods for query operations |
3632
|
|
|
|
|
|
|
|
3633
|
|
|
|
|
|
|
B |
3634
|
|
|
|
|
|
|
|
3635
|
|
|
|
|
|
|
=over 4 |
3636
|
|
|
|
|
|
|
|
3637
|
|
|
|
|
|
|
=item execute_query() |
3638
|
|
|
|
|
|
|
|
3639
|
|
|
|
|
|
|
$sqldb->execute_query($sql, \@params, $result_method, @result_args) : @results |
3640
|
|
|
|
|
|
|
|
3641
|
|
|
|
|
|
|
This overall lifecycle method calls prepare_execute(), runs the $result_method, and then calls done_with_query(). |
3642
|
|
|
|
|
|
|
|
3643
|
|
|
|
|
|
|
The $result_method should be the name of a method supported by that Driver instance, typically one of those shown in the "Retrieving Rows from an Executed Statement" section below. The @result_args, if any, are passed to the named method along with the active statement handle. |
3644
|
|
|
|
|
|
|
|
3645
|
|
|
|
|
|
|
=item prepare_execute() |
3646
|
|
|
|
|
|
|
|
3647
|
|
|
|
|
|
|
$sqldb->prepare_execute ($sql, @params) : $sth |
3648
|
|
|
|
|
|
|
|
3649
|
|
|
|
|
|
|
Prepare, bind, and execute a SQL statement to create a DBI statement handle. |
3650
|
|
|
|
|
|
|
|
3651
|
|
|
|
|
|
|
Uses the DBI prepare_cached(), bind_param(), and execute() methods. |
3652
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
If you need to pass type information with your parameters, pass a reference to an array of the parameter and the type information. |
3654
|
|
|
|
|
|
|
|
3655
|
|
|
|
|
|
|
=item done_with_query() |
3656
|
|
|
|
|
|
|
|
3657
|
|
|
|
|
|
|
$sqldb->done_with_query ($sth) : () |
3658
|
|
|
|
|
|
|
|
3659
|
|
|
|
|
|
|
Called when we're done with the $sth. |
3660
|
|
|
|
|
|
|
|
3661
|
|
|
|
|
|
|
=back |
3662
|
|
|
|
|
|
|
|
3663
|
|
|
|
|
|
|
=cut |
3664
|
|
|
|
|
|
|
|
3665
|
|
|
|
|
|
|
# $results = $self->execute_query($sql, \@params, $result_method, @result_args); |
3666
|
|
|
|
|
|
|
# @results = $self->execute_query($sql, \@params, $result_method, @result_args); |
3667
|
|
|
|
|
|
|
sub execute_query { |
3668
|
|
|
|
|
|
|
my $self = shift; |
3669
|
|
|
|
|
|
|
|
3670
|
|
|
|
|
|
|
my ($sql, $params) = (shift, shift); |
3671
|
|
|
|
|
|
|
my @query = ( $sql, ( $params ? @$params : () ) ); |
3672
|
|
|
|
|
|
|
|
3673
|
|
|
|
|
|
|
my ($method, @args) = @_; |
3674
|
|
|
|
|
|
|
$method ||= 'do_nothing'; |
3675
|
|
|
|
|
|
|
|
3676
|
|
|
|
|
|
|
my $timer = $self->log_start( @query ) if $self->DBILogging; |
3677
|
|
|
|
|
|
|
|
3678
|
|
|
|
|
|
|
my ( $sth, @results ); |
3679
|
|
|
|
|
|
|
my $wantarray = wantarray(); # Capture before eval which otherwise obscures it |
3680
|
|
|
|
|
|
|
eval { |
3681
|
|
|
|
|
|
|
local $SIG{__DIE__}; |
3682
|
|
|
|
|
|
|
$sth = $self->prepare_execute( @query ); |
3683
|
|
|
|
|
|
|
@results = $wantarray ? ( $self->$method( $sth, @args ) ) |
3684
|
|
|
|
|
|
|
: scalar ( $self->$method( $sth, @args ) ); |
3685
|
|
|
|
|
|
|
}; |
3686
|
|
|
|
|
|
|
if ( $@ ) { |
3687
|
|
|
|
|
|
|
$self->done_with_query($sth) if $sth; |
3688
|
|
|
|
|
|
|
$self->log_stop( $timer, "ERROR: $@" ) if $self->DBILogging; |
3689
|
|
|
|
|
|
|
die $@; |
3690
|
|
|
|
|
|
|
} else { |
3691
|
|
|
|
|
|
|
$self->done_with_query($sth) if $sth; |
3692
|
|
|
|
|
|
|
|
3693
|
|
|
|
|
|
|
$self->log_stop( $timer, \@results ) if $self->DBILogging; |
3694
|
|
|
|
|
|
|
|
3695
|
|
|
|
|
|
|
return ( $wantarray ? @results : $results[0] ) |
3696
|
|
|
|
|
|
|
} |
3697
|
|
|
|
|
|
|
} |
3698
|
|
|
|
|
|
|
|
3699
|
|
|
|
|
|
|
# $sth = $self->prepare_execute($sql); |
3700
|
|
|
|
|
|
|
# $sth = $self->prepare_execute($sql, @params); |
3701
|
|
|
|
|
|
|
sub prepare_execute { |
3702
|
|
|
|
|
|
|
my ($self, $sql, @params) = @_; |
3703
|
|
|
|
|
|
|
|
3704
|
|
|
|
|
|
|
my $sth; |
3705
|
|
|
|
|
|
|
$sth = $self->prepare_cached($sql); |
3706
|
|
|
|
|
|
|
for my $param_no ( 0 .. $#params ) { |
3707
|
|
|
|
|
|
|
my $param_v = $params[$param_no]; |
3708
|
|
|
|
|
|
|
my @param_v = ( ref($param_v) eq 'ARRAY' ) ? @$param_v : $param_v; |
3709
|
|
|
|
|
|
|
$sth->bind_param( $param_no+1, @param_v ); |
3710
|
|
|
|
|
|
|
} |
3711
|
|
|
|
|
|
|
$self->{_last_sth_execute} = $sth->execute(); |
3712
|
|
|
|
|
|
|
|
3713
|
|
|
|
|
|
|
return $sth; |
3714
|
|
|
|
|
|
|
} |
3715
|
|
|
|
|
|
|
|
3716
|
|
|
|
|
|
|
# $self->done_with_query( $sth ); |
3717
|
|
|
|
|
|
|
sub done_with_query { |
3718
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3719
|
|
|
|
|
|
|
|
3720
|
|
|
|
|
|
|
$sth->finish; |
3721
|
|
|
|
|
|
|
} |
3722
|
|
|
|
|
|
|
|
3723
|
|
|
|
|
|
|
######################################################################## |
3724
|
|
|
|
|
|
|
|
3725
|
|
|
|
|
|
|
=head2 Retrieving Rows from a Statement |
3726
|
|
|
|
|
|
|
|
3727
|
|
|
|
|
|
|
B |
3728
|
|
|
|
|
|
|
|
3729
|
|
|
|
|
|
|
=over 4 |
3730
|
|
|
|
|
|
|
|
3731
|
|
|
|
|
|
|
=item do_nothing() |
3732
|
|
|
|
|
|
|
|
3733
|
|
|
|
|
|
|
$sqldb->do_nothing ($sth) : () |
3734
|
|
|
|
|
|
|
|
3735
|
|
|
|
|
|
|
Does nothing. |
3736
|
|
|
|
|
|
|
|
3737
|
|
|
|
|
|
|
=item get_execute_rowcount() |
3738
|
|
|
|
|
|
|
|
3739
|
|
|
|
|
|
|
$sqldb->get_execute_rowcount ($sth) : $row_count |
3740
|
|
|
|
|
|
|
|
3741
|
|
|
|
|
|
|
Returns the row count reported by the last statement executed. |
3742
|
|
|
|
|
|
|
|
3743
|
|
|
|
|
|
|
=item fetchall_hashref() |
3744
|
|
|
|
|
|
|
|
3745
|
|
|
|
|
|
|
$sqldb->fetchall_hashref ($sth) : $array_of_hashes |
3746
|
|
|
|
|
|
|
|
3747
|
|
|
|
|
|
|
Calls the STH's fetchall_arrayref method with an empty hashref to retrieve all of the result rows into an array of hashrefs. |
3748
|
|
|
|
|
|
|
|
3749
|
|
|
|
|
|
|
=item fetchall_hashref_columns() |
3750
|
|
|
|
|
|
|
|
3751
|
|
|
|
|
|
|
$sqldb->fetchall_hashref ($sth) : $array_of_hashes |
3752
|
|
|
|
|
|
|
$sqldb->fetchall_hashref ($sth) : ( $array_of_hashes, $column_info ) |
3753
|
|
|
|
|
|
|
|
3754
|
|
|
|
|
|
|
Calls the STH's fetchall_arrayref method with an empty hashref, and if called in a list context, also retrieves information about the columns used in the query result set. |
3755
|
|
|
|
|
|
|
|
3756
|
|
|
|
|
|
|
=item fetchall_arrayref() |
3757
|
|
|
|
|
|
|
|
3758
|
|
|
|
|
|
|
$sqldb->fetchall_arrayref ($sth) : $array_of_arrays |
3759
|
|
|
|
|
|
|
|
3760
|
|
|
|
|
|
|
Calls the STH's fetchall_arrayref method to retrieve all of the result rows into an array of arrayrefs. |
3761
|
|
|
|
|
|
|
|
3762
|
|
|
|
|
|
|
=item fetchall_arrayref_columns() |
3763
|
|
|
|
|
|
|
|
3764
|
|
|
|
|
|
|
$sqldb->fetchall_hashref ($sth) : $array_of_arrays |
3765
|
|
|
|
|
|
|
$sqldb->fetchall_hashref ($sth) : ( $array_of_arrays, $column_info ) |
3766
|
|
|
|
|
|
|
|
3767
|
|
|
|
|
|
|
Calls the STH's fetchall_arrayref method, and if called in a list context, also retrieves information about the columns used in the query result set. |
3768
|
|
|
|
|
|
|
|
3769
|
|
|
|
|
|
|
=item visitall_hashref() |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
$sqldb->visitall_hashref ($sth, $coderef) : () |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
Calls coderef on each row with values as hashref, and returns a list of results. |
3774
|
|
|
|
|
|
|
|
3775
|
|
|
|
|
|
|
=item visitall_array() |
3776
|
|
|
|
|
|
|
|
3777
|
|
|
|
|
|
|
$sqldb->visitall_array ($sth, $coderef) : () |
3778
|
|
|
|
|
|
|
|
3779
|
|
|
|
|
|
|
Calls coderef on each row with values as list, and returns a list of results. |
3780
|
|
|
|
|
|
|
|
3781
|
|
|
|
|
|
|
=item fetchsub_hashref() |
3782
|
|
|
|
|
|
|
|
3783
|
|
|
|
|
|
|
$sqldb->fetchsub_hashref ($sth, $name_uc_or_lc) : $coderef |
3784
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
Returns a code reference that can be called repeatedly to invoke the fetchrow_hashref() method on the statement handle. |
3786
|
|
|
|
|
|
|
|
3787
|
|
|
|
|
|
|
The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method. |
3788
|
|
|
|
|
|
|
|
3789
|
|
|
|
|
|
|
=item fetchsub_array() |
3790
|
|
|
|
|
|
|
|
3791
|
|
|
|
|
|
|
$sqldb->fetchsub_hashref ($sth) : $coderef |
3792
|
|
|
|
|
|
|
|
3793
|
|
|
|
|
|
|
Returns a code reference that can be called repeatedly to invoke the fetchrow_array() method on the statement handle. |
3794
|
|
|
|
|
|
|
|
3795
|
|
|
|
|
|
|
The code reference is blessed so that when it goes out of scope and is destroyed it can call the statement handle's finish() method. |
3796
|
|
|
|
|
|
|
|
3797
|
|
|
|
|
|
|
=back |
3798
|
|
|
|
|
|
|
|
3799
|
|
|
|
|
|
|
=cut |
3800
|
|
|
|
|
|
|
|
3801
|
|
|
|
|
|
|
sub do_nothing { |
3802
|
|
|
|
|
|
|
return; |
3803
|
|
|
|
|
|
|
} |
3804
|
|
|
|
|
|
|
|
3805
|
|
|
|
|
|
|
sub get_execute_rowcount { |
3806
|
|
|
|
|
|
|
my $self = shift; |
3807
|
|
|
|
|
|
|
return $self->{_last_sth_execute}; |
3808
|
|
|
|
|
|
|
} |
3809
|
|
|
|
|
|
|
|
3810
|
|
|
|
|
|
|
sub fetchall_arrayref { |
3811
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3812
|
|
|
|
|
|
|
$sth->fetchall_arrayref(); |
3813
|
|
|
|
|
|
|
} |
3814
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
sub fetchall_arrayref_columns { |
3816
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3817
|
|
|
|
|
|
|
my $cols = wantarray() ? $self->retrieve_columns( $sth ) : undef; |
3818
|
|
|
|
|
|
|
my $rows = $sth->fetchall_arrayref(); |
3819
|
|
|
|
|
|
|
wantarray ? ( $rows, $cols ) : $rows; |
3820
|
|
|
|
|
|
|
} |
3821
|
|
|
|
|
|
|
|
3822
|
|
|
|
|
|
|
sub fetchall_hashref { |
3823
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3824
|
|
|
|
|
|
|
$sth->fetchall_arrayref( {} ); |
3825
|
|
|
|
|
|
|
} |
3826
|
|
|
|
|
|
|
|
3827
|
|
|
|
|
|
|
sub fetchall_hashref_columns { |
3828
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3829
|
|
|
|
|
|
|
my $cols = wantarray() ? $self->retrieve_columns( $sth ) : undef; |
3830
|
|
|
|
|
|
|
my $rows = $sth->fetchall_arrayref( {} ); |
3831
|
|
|
|
|
|
|
wantarray ? ( $rows, $cols ) : $rows; |
3832
|
|
|
|
|
|
|
} |
3833
|
|
|
|
|
|
|
|
3834
|
|
|
|
|
|
|
# $self->visitall_hashref( $sth, $coderef ); |
3835
|
|
|
|
|
|
|
# Calls a codref for each row returned by the statement handle |
3836
|
|
|
|
|
|
|
sub visitall_hashref { |
3837
|
|
|
|
|
|
|
my ($self, $sth, $coderef) = @_; |
3838
|
|
|
|
|
|
|
my $rowhash; |
3839
|
|
|
|
|
|
|
my @results; |
3840
|
|
|
|
|
|
|
while ($rowhash = $sth->fetchrow_hashref) { |
3841
|
|
|
|
|
|
|
push @results, &$coderef( $rowhash ); |
3842
|
|
|
|
|
|
|
} |
3843
|
|
|
|
|
|
|
return @results; |
3844
|
|
|
|
|
|
|
} |
3845
|
|
|
|
|
|
|
|
3846
|
|
|
|
|
|
|
# $self->visitall_array( $sth, $coderef ); |
3847
|
|
|
|
|
|
|
# Calls a codref for each row returned by the statement handle |
3848
|
|
|
|
|
|
|
sub visitall_array { |
3849
|
|
|
|
|
|
|
my ($self, $sth, $coderef) = @_; |
3850
|
|
|
|
|
|
|
my @row; |
3851
|
|
|
|
|
|
|
my @results; |
3852
|
|
|
|
|
|
|
while (@row = $sth->fetchrow_array) { |
3853
|
|
|
|
|
|
|
push @results, &$coderef( @row ); |
3854
|
|
|
|
|
|
|
} |
3855
|
|
|
|
|
|
|
return @results; |
3856
|
|
|
|
|
|
|
} |
3857
|
|
|
|
|
|
|
|
3858
|
|
|
|
|
|
|
# $fetchsub = $self->fetchsub_hashref( $sth ) |
3859
|
|
|
|
|
|
|
# $fetchsub = $self->fetchsub_hashref( $sth, $name_uc_or_lc ) |
3860
|
|
|
|
|
|
|
sub fetchsub_hashref { |
3861
|
|
|
|
|
|
|
my ($self, $sth, @args) = @_; |
3862
|
|
|
|
|
|
|
$_[1] = undef; |
3863
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver::fetchsub->new( $sth, 'fetchrow_hashref', @args ); |
3864
|
|
|
|
|
|
|
} |
3865
|
|
|
|
|
|
|
|
3866
|
|
|
|
|
|
|
# $fetchsub = $self->fetchsub_array( $sth ) |
3867
|
|
|
|
|
|
|
sub fetchsub_array { |
3868
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3869
|
|
|
|
|
|
|
$_[1] = undef; |
3870
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver::fetchsub->new( $sth, 'fetchrow_array' ); |
3871
|
|
|
|
|
|
|
} |
3872
|
|
|
|
|
|
|
|
3873
|
|
|
|
|
|
|
FETCHSUB_CLASS: { |
3874
|
|
|
|
|
|
|
package DBIx::SQLEngine::Driver::fetchsub; |
3875
|
|
|
|
|
|
|
|
3876
|
|
|
|
|
|
|
my $Signal = \"Unique"; |
3877
|
|
|
|
|
|
|
|
3878
|
|
|
|
|
|
|
sub new { |
3879
|
|
|
|
|
|
|
my ( $package, $sth, $method, @args ) = @_; |
3880
|
|
|
|
|
|
|
my $coderef = sub { |
3881
|
|
|
|
|
|
|
unless ( $_[0] eq $Signal ) { |
3882
|
|
|
|
|
|
|
$sth->$method( @args, @_ ) |
3883
|
|
|
|
|
|
|
} elsif ( $_[1] eq 'DESTROY' ) { |
3884
|
|
|
|
|
|
|
$sth->finish() if $sth; |
3885
|
|
|
|
|
|
|
warn "Fetchsub finish for $sth\n"; |
3886
|
|
|
|
|
|
|
$sth = undef; |
3887
|
|
|
|
|
|
|
} elsif ( $_[1] eq 'handle' ) { |
3888
|
|
|
|
|
|
|
return $sth; |
3889
|
|
|
|
|
|
|
} else { |
3890
|
|
|
|
|
|
|
Carp::croak( "Unsupported signal to fetchsub: '$_[1]'" ); |
3891
|
|
|
|
|
|
|
} |
3892
|
|
|
|
|
|
|
}; |
3893
|
|
|
|
|
|
|
bless $coderef, $package; |
3894
|
|
|
|
|
|
|
} |
3895
|
|
|
|
|
|
|
|
3896
|
|
|
|
|
|
|
sub handle { |
3897
|
|
|
|
|
|
|
my $coderef = shift; |
3898
|
|
|
|
|
|
|
&$coderef( $Signal => 'handle' ) |
3899
|
|
|
|
|
|
|
} |
3900
|
|
|
|
|
|
|
|
3901
|
|
|
|
|
|
|
sub DESTROY { |
3902
|
|
|
|
|
|
|
my $coderef = shift; |
3903
|
|
|
|
|
|
|
&$coderef( $Signal => 'DESTROY' ) |
3904
|
|
|
|
|
|
|
} |
3905
|
|
|
|
|
|
|
} |
3906
|
|
|
|
|
|
|
|
3907
|
|
|
|
|
|
|
######################################################################## |
3908
|
|
|
|
|
|
|
|
3909
|
|
|
|
|
|
|
=head2 Retrieving Columns from a Statement |
3910
|
|
|
|
|
|
|
|
3911
|
|
|
|
|
|
|
B |
3912
|
|
|
|
|
|
|
|
3913
|
|
|
|
|
|
|
=over 4 |
3914
|
|
|
|
|
|
|
|
3915
|
|
|
|
|
|
|
=item retrieve_columns() |
3916
|
|
|
|
|
|
|
|
3917
|
|
|
|
|
|
|
$sqldb->retrieve_columns ($sth) : $columnset |
3918
|
|
|
|
|
|
|
|
3919
|
|
|
|
|
|
|
Obtains information about the columns used in the result set. |
3920
|
|
|
|
|
|
|
|
3921
|
|
|
|
|
|
|
=item column_type_codes() |
3922
|
|
|
|
|
|
|
|
3923
|
|
|
|
|
|
|
$sqldb->column_type_codes - Standard::Global:hash |
3924
|
|
|
|
|
|
|
|
3925
|
|
|
|
|
|
|
Maps the ODBC numeric constants used by DBI to the names we want to use for simplified internal representation. |
3926
|
|
|
|
|
|
|
|
3927
|
|
|
|
|
|
|
=back |
3928
|
|
|
|
|
|
|
|
3929
|
|
|
|
|
|
|
To Do: this should probably be using DBI's type_info methods. |
3930
|
|
|
|
|
|
|
|
3931
|
|
|
|
|
|
|
=cut |
3932
|
|
|
|
|
|
|
|
3933
|
|
|
|
|
|
|
# %@$columns = $self->retrieve_columns($sth) |
3934
|
|
|
|
|
|
|
#!# 'pri_key' => $sth->is_pri_key->[$i], |
3935
|
|
|
|
|
|
|
# is_pri_key causes the driver to fail with the following fatal error: |
3936
|
|
|
|
|
|
|
# relocation error: symbol not found: mysql_columnSeek |
3937
|
|
|
|
|
|
|
# or at least that happens in the version we last tested it with. -S. |
3938
|
|
|
|
|
|
|
|
3939
|
|
|
|
|
|
|
sub retrieve_columns { |
3940
|
|
|
|
|
|
|
my ($self, $sth) = @_; |
3941
|
|
|
|
|
|
|
|
3942
|
|
|
|
|
|
|
my $type_defs = $self->column_type_codes(); |
3943
|
|
|
|
|
|
|
my $names = $sth->{'NAME_lc'}; |
3944
|
|
|
|
|
|
|
|
3945
|
|
|
|
|
|
|
my $types = eval { $sth->{'TYPE'} || [] }; |
3946
|
|
|
|
|
|
|
# warn "Types: " . join(', ', map "'$_'", @$types); |
3947
|
|
|
|
|
|
|
my $type_codes = [ map { |
3948
|
|
|
|
|
|
|
my $typeinfo = scalar $self->type_info($_); |
3949
|
|
|
|
|
|
|
# warn "Type $typeinfo"; |
3950
|
|
|
|
|
|
|
ref($typeinfo) ? scalar $typeinfo->{'DATA_TYPE'} : $typeinfo; |
3951
|
|
|
|
|
|
|
} @$types ]; |
3952
|
|
|
|
|
|
|
my $sizes = eval { $sth->{PRECISION} || [] }; |
3953
|
|
|
|
|
|
|
my $nullable = eval { $sth->{'NULLABLE'} || [] }; |
3954
|
|
|
|
|
|
|
[ |
3955
|
|
|
|
|
|
|
map { |
3956
|
|
|
|
|
|
|
my $type = $type_defs->{ $type_codes->[$_] || 0 } || $type_codes->[$_]; |
3957
|
|
|
|
|
|
|
$type ||= 'text'; |
3958
|
|
|
|
|
|
|
# warn "New col: $names->[$_] ($type / $types->[$_] / $type_codes->[$_])"; |
3959
|
|
|
|
|
|
|
|
3960
|
|
|
|
|
|
|
{ |
3961
|
|
|
|
|
|
|
'name' => $names->[$_], |
3962
|
|
|
|
|
|
|
'type' => $type, |
3963
|
|
|
|
|
|
|
'required' => ! $nullable->[$_], |
3964
|
|
|
|
|
|
|
( $type eq 'text' ? ( 'length' => $sizes->[$_] ) : () ), |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
} |
3967
|
|
|
|
|
|
|
} (0 .. $#$names) |
3968
|
|
|
|
|
|
|
]; |
3969
|
|
|
|
|
|
|
} |
3970
|
|
|
|
|
|
|
|
3971
|
|
|
|
|
|
|
use Class::MakeMethods ( 'Standard::Global:hash' => 'column_type_codes' ); |
3972
|
|
|
|
|
|
|
use DBI ':sql_types'; |
3973
|
|
|
|
|
|
|
|
3974
|
|
|
|
|
|
|
# $code_to_name_hash = $self->determine_column_type_codes(); |
3975
|
|
|
|
|
|
|
__PACKAGE__->column_type_codes( |
3976
|
|
|
|
|
|
|
DBI::SQL_CHAR() => 'text', # char |
3977
|
|
|
|
|
|
|
DBI::SQL_VARCHAR() => 'text', # varchar |
3978
|
|
|
|
|
|
|
DBI::SQL_LONGVARCHAR() => 'text', # |
3979
|
|
|
|
|
|
|
253 => 'text', # MySQL varchar |
3980
|
|
|
|
|
|
|
252 => 'text', # MySQL blob |
3981
|
|
|
|
|
|
|
|
3982
|
|
|
|
|
|
|
DBI::SQL_NUMERIC() => 'float', # numeric (?) |
3983
|
|
|
|
|
|
|
DBI::SQL_DECIMAL() => 'float', # decimal |
3984
|
|
|
|
|
|
|
DBI::SQL_FLOAT() => 'float', # float |
3985
|
|
|
|
|
|
|
DBI::SQL_REAL() => 'float', # real |
3986
|
|
|
|
|
|
|
DBI::SQL_DOUBLE() => 'float', # double |
3987
|
|
|
|
|
|
|
|
3988
|
|
|
|
|
|
|
DBI::SQL_INTEGER() => 'int', # integer |
3989
|
|
|
|
|
|
|
DBI::SQL_SMALLINT() => 'int', # smallint |
3990
|
|
|
|
|
|
|
-6 => 'int', # MySQL tinyint |
3991
|
|
|
|
|
|
|
|
3992
|
|
|
|
|
|
|
DBI::SQL_DATE() => 'time', # date |
3993
|
|
|
|
|
|
|
DBI::SQL_TIME() => 'time', # time |
3994
|
|
|
|
|
|
|
DBI::SQL_TIMESTAMP() => 'time', # datetime |
3995
|
|
|
|
|
|
|
); |
3996
|
|
|
|
|
|
|
|
3997
|
|
|
|
|
|
|
######################################################################## |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
######################################################################## |
4000
|
|
|
|
|
|
|
|
4001
|
|
|
|
|
|
|
=head1 LOGGING |
4002
|
|
|
|
|
|
|
|
4003
|
|
|
|
|
|
|
=head2 DBI Logging |
4004
|
|
|
|
|
|
|
|
4005
|
|
|
|
|
|
|
B |
4006
|
|
|
|
|
|
|
|
4007
|
|
|
|
|
|
|
=over 4 |
4008
|
|
|
|
|
|
|
|
4009
|
|
|
|
|
|
|
=item DBILogging() |
4010
|
|
|
|
|
|
|
|
4011
|
|
|
|
|
|
|
$sqldb->DBILogging : $value |
4012
|
|
|
|
|
|
|
$sqldb->DBILogging( $value ) |
4013
|
|
|
|
|
|
|
|
4014
|
|
|
|
|
|
|
Set this to a true value to turn on logging of DBI interactions. Can be called on the class to set a shared default for all instances, or on any instance to set the value for it alone. |
4015
|
|
|
|
|
|
|
|
4016
|
|
|
|
|
|
|
=back |
4017
|
|
|
|
|
|
|
|
4018
|
|
|
|
|
|
|
B |
4019
|
|
|
|
|
|
|
|
4020
|
|
|
|
|
|
|
=over 4 |
4021
|
|
|
|
|
|
|
|
4022
|
|
|
|
|
|
|
=item log_connect() |
4023
|
|
|
|
|
|
|
|
4024
|
|
|
|
|
|
|
$sqldb->log_connect ( $dsn ) |
4025
|
|
|
|
|
|
|
|
4026
|
|
|
|
|
|
|
Writes out connection logging message. |
4027
|
|
|
|
|
|
|
|
4028
|
|
|
|
|
|
|
=item log_start() |
4029
|
|
|
|
|
|
|
|
4030
|
|
|
|
|
|
|
$sqldb->log_start( $sql ) : $timer |
4031
|
|
|
|
|
|
|
|
4032
|
|
|
|
|
|
|
Called at start of query execution. |
4033
|
|
|
|
|
|
|
|
4034
|
|
|
|
|
|
|
=item log_stop() |
4035
|
|
|
|
|
|
|
|
4036
|
|
|
|
|
|
|
$sqldb->log_stop( $timer ) : () |
4037
|
|
|
|
|
|
|
|
4038
|
|
|
|
|
|
|
Called at end of query execution. |
4039
|
|
|
|
|
|
|
|
4040
|
|
|
|
|
|
|
=back |
4041
|
|
|
|
|
|
|
|
4042
|
|
|
|
|
|
|
=cut |
4043
|
|
|
|
|
|
|
|
4044
|
|
|
|
|
|
|
use Class::MakeMethods ( 'Standard::Inheritable:scalar' => 'DBILogging' ); |
4045
|
|
|
|
|
|
|
|
4046
|
|
|
|
|
|
|
# $self->log_connect( $dsn ); |
4047
|
|
|
|
|
|
|
sub log_connect { |
4048
|
|
|
|
|
|
|
my ($self, $dsn) = @_; |
4049
|
|
|
|
|
|
|
my $class = ref($self) || $self; |
4050
|
|
|
|
|
|
|
warn "DBI: Connecting to $dsn\n"; |
4051
|
|
|
|
|
|
|
} |
4052
|
|
|
|
|
|
|
|
4053
|
|
|
|
|
|
|
# $timer = $self->log_start( $sql ); |
4054
|
|
|
|
|
|
|
sub log_start { |
4055
|
|
|
|
|
|
|
my ($self, $sql, @params) = @_; |
4056
|
|
|
|
|
|
|
my $class = ref($self) || $self; |
4057
|
|
|
|
|
|
|
|
4058
|
|
|
|
|
|
|
my $start_time = time; |
4059
|
|
|
|
|
|
|
|
4060
|
|
|
|
|
|
|
my $params = join( ', ', map { defined $_ ? "'" . printable($_) . "'" : 'undef' } @params ); |
4061
|
|
|
|
|
|
|
warn "DBI: $sql; $params\n"; |
4062
|
|
|
|
|
|
|
|
4063
|
|
|
|
|
|
|
return $start_time; |
4064
|
|
|
|
|
|
|
} |
4065
|
|
|
|
|
|
|
|
4066
|
|
|
|
|
|
|
# $self->log_stop( $timer ); |
4067
|
|
|
|
|
|
|
# $self->log_stop( $timer, $error_message ); |
4068
|
|
|
|
|
|
|
# $self->log_stop( $timer, @$return_values ); |
4069
|
|
|
|
|
|
|
sub log_stop { |
4070
|
|
|
|
|
|
|
my ($self, $start_time, $results) = @_; |
4071
|
|
|
|
|
|
|
my $class = ref($self) || $self; |
4072
|
|
|
|
|
|
|
|
4073
|
|
|
|
|
|
|
my $message; |
4074
|
|
|
|
|
|
|
if ( ! ref $results ) { |
4075
|
|
|
|
|
|
|
$message = "returning an error: $results"; |
4076
|
|
|
|
|
|
|
} elsif ( ref($results) eq 'ARRAY' ) { |
4077
|
|
|
|
|
|
|
# Successful return |
4078
|
|
|
|
|
|
|
if ( ! ref( $results->[0] ) ) { |
4079
|
|
|
|
|
|
|
if ( $results->[0] =~ /^\d+$/ ) { |
4080
|
|
|
|
|
|
|
$message = "affecting $results->[0] rows"; |
4081
|
|
|
|
|
|
|
} elsif ( $results->[0] eq '0E0' ) { |
4082
|
|
|
|
|
|
|
$message = "affecting 0 rows"; |
4083
|
|
|
|
|
|
|
} else { |
4084
|
|
|
|
|
|
|
$message = "producing a value of '$results->[0]'"; |
4085
|
|
|
|
|
|
|
} |
4086
|
|
|
|
|
|
|
} elsif ( ref( $results->[0] ) eq 'ARRAY' ) { |
4087
|
|
|
|
|
|
|
$message = "returning " . scalar(@{ $results->[0] }) . " items"; |
4088
|
|
|
|
|
|
|
} |
4089
|
|
|
|
|
|
|
} |
4090
|
|
|
|
|
|
|
my $seconds = (time() - $start_time or 'less than one' ); |
4091
|
|
|
|
|
|
|
|
4092
|
|
|
|
|
|
|
warn "DBI: Completed in $seconds seconds" . |
4093
|
|
|
|
|
|
|
(defined $message ? ", $message" : '') . "\n"; |
4094
|
|
|
|
|
|
|
|
4095
|
|
|
|
|
|
|
return; |
4096
|
|
|
|
|
|
|
} |
4097
|
|
|
|
|
|
|
|
4098
|
|
|
|
|
|
|
######################################################################## |
4099
|
|
|
|
|
|
|
|
4100
|
|
|
|
|
|
|
use vars qw( %Printable ); |
4101
|
|
|
|
|
|
|
%Printable = ( ( map { chr($_), unpack('H2', chr($_)) } (0..255) ), |
4102
|
|
|
|
|
|
|
"\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', "\""=>'"' ); |
4103
|
|
|
|
|
|
|
|
4104
|
|
|
|
|
|
|
# $special_characters_escaped = printable( $source_string ); |
4105
|
|
|
|
|
|
|
sub printable ($) { |
4106
|
|
|
|
|
|
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
4107
|
|
|
|
|
|
|
s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/\\$Printable{$1}/g; |
4108
|
|
|
|
|
|
|
return $_; |
4109
|
|
|
|
|
|
|
} |
4110
|
|
|
|
|
|
|
|
4111
|
|
|
|
|
|
|
######################################################################## |
4112
|
|
|
|
|
|
|
|
4113
|
|
|
|
|
|
|
=head2 SQL Logging |
4114
|
|
|
|
|
|
|
|
4115
|
|
|
|
|
|
|
B |
4116
|
|
|
|
|
|
|
|
4117
|
|
|
|
|
|
|
=over 4 |
4118
|
|
|
|
|
|
|
|
4119
|
|
|
|
|
|
|
=item SQLLogging() |
4120
|
|
|
|
|
|
|
|
4121
|
|
|
|
|
|
|
$sqldb->SQLLogging () : $value |
4122
|
|
|
|
|
|
|
$sqldb->SQLLogging( $value ) |
4123
|
|
|
|
|
|
|
|
4124
|
|
|
|
|
|
|
Set this to a true value to turn on logging of internally-generated SQL statements (all queries except for those with complete SQL statements explicitly passed in by the caller). Can be called on the class to set a shared default for all instances, or on any instance to set the value for it alone. |
4125
|
|
|
|
|
|
|
|
4126
|
|
|
|
|
|
|
=back |
4127
|
|
|
|
|
|
|
|
4128
|
|
|
|
|
|
|
B |
4129
|
|
|
|
|
|
|
|
4130
|
|
|
|
|
|
|
=over 4 |
4131
|
|
|
|
|
|
|
|
4132
|
|
|
|
|
|
|
=item log_sql() |
4133
|
|
|
|
|
|
|
|
4134
|
|
|
|
|
|
|
$sqldb->log_sql( $sql ) : () |
4135
|
|
|
|
|
|
|
|
4136
|
|
|
|
|
|
|
Called when SQL is generated. |
4137
|
|
|
|
|
|
|
|
4138
|
|
|
|
|
|
|
=back |
4139
|
|
|
|
|
|
|
|
4140
|
|
|
|
|
|
|
=cut |
4141
|
|
|
|
|
|
|
|
4142
|
|
|
|
|
|
|
use Class::MakeMethods ( 'Standard::Inheritable:scalar' => 'SQLLogging' ); |
4143
|
|
|
|
|
|
|
|
4144
|
|
|
|
|
|
|
# $self->log_sql( $sql ); |
4145
|
|
|
|
|
|
|
sub log_sql { |
4146
|
|
|
|
|
|
|
my ($self, $sql, @params) = @_; |
4147
|
|
|
|
|
|
|
return unless $self->SQLLogging; |
4148
|
|
|
|
|
|
|
my $class = ref($self) || $self; |
4149
|
|
|
|
|
|
|
my $params = join( ', ', map { defined $_ ? "'$_'" : 'undef' } @params ); |
4150
|
|
|
|
|
|
|
warn "SQL: $sql; $params\n"; |
4151
|
|
|
|
|
|
|
} |
4152
|
|
|
|
|
|
|
|
4153
|
|
|
|
|
|
|
######################################################################## |
4154
|
|
|
|
|
|
|
|
4155
|
|
|
|
|
|
|
######################################################################## |
4156
|
|
|
|
|
|
|
|
4157
|
|
|
|
|
|
|
=head2 About Driver Traits |
4158
|
|
|
|
|
|
|
|
4159
|
|
|
|
|
|
|
Some features that are shared by several Driver subclasses are implemented as a package in the Driver::Trait::* namespace. |
4160
|
|
|
|
|
|
|
|
4161
|
|
|
|
|
|
|
Because of the way DBIx::AnyDBD munges the inheritance tree, |
4162
|
|
|
|
|
|
|
DBIx::SQLEngine::Driver subclasses can not reliably inherit from mixins. |
4163
|
|
|
|
|
|
|
To work around this, we export all of the methods into their namespace using Exporter and @EXPORT. |
4164
|
|
|
|
|
|
|
|
4165
|
|
|
|
|
|
|
In addition we go through some effort to re-dispatch methods because we can't |
4166
|
|
|
|
|
|
|
rely on SUPER and we don't want to require NEXT. This isn't too complicated, |
4167
|
|
|
|
|
|
|
as we know the munged inheritance tree only uses single inheritance. |
4168
|
|
|
|
|
|
|
|
4169
|
|
|
|
|
|
|
Note: this mechanism has been added recently, and the implementation is subject to change. |
4170
|
|
|
|
|
|
|
|
4171
|
|
|
|
|
|
|
B |
4172
|
|
|
|
|
|
|
|
4173
|
|
|
|
|
|
|
=over 4 |
4174
|
|
|
|
|
|
|
|
4175
|
|
|
|
|
|
|
=item NEXT() |
4176
|
|
|
|
|
|
|
|
4177
|
|
|
|
|
|
|
$sqldb->NEXT( $method, @args ) : @results |
4178
|
|
|
|
|
|
|
|
4179
|
|
|
|
|
|
|
Used by driver traits to redispatch to base-class implementations. |
4180
|
|
|
|
|
|
|
|
4181
|
|
|
|
|
|
|
=back |
4182
|
|
|
|
|
|
|
|
4183
|
|
|
|
|
|
|
=cut |
4184
|
|
|
|
|
|
|
|
4185
|
|
|
|
|
|
|
sub NEXT { |
4186
|
|
|
|
|
|
|
my ( $self, $method, @args ) = @_; |
4187
|
|
|
|
|
|
|
|
4188
|
|
|
|
|
|
|
no strict 'refs'; |
4189
|
|
|
|
|
|
|
my $super = ${ ref($self) . '::ISA' }[0] . "::" . $method; |
4190
|
|
|
|
|
|
|
# warn "_super_d: $super " . wantarray() . "\n"; |
4191
|
|
|
|
|
|
|
$self->$super( @args ); |
4192
|
|
|
|
|
|
|
} |
4193
|
|
|
|
|
|
|
|
4194
|
|
|
|
|
|
|
######################################################################## |
4195
|
|
|
|
|
|
|
|
4196
|
|
|
|
|
|
|
######################################################################## |
4197
|
|
|
|
|
|
|
|
4198
|
|
|
|
|
|
|
=head1 SEE ALSO |
4199
|
|
|
|
|
|
|
|
4200
|
|
|
|
|
|
|
See L for the overall interface and developer documentation. |
4201
|
|
|
|
|
|
|
|
4202
|
|
|
|
|
|
|
For distribution, installation, support, copyright and license |
4203
|
|
|
|
|
|
|
information, see L. |
4204
|
|
|
|
|
|
|
|
4205
|
|
|
|
|
|
|
=cut |
4206
|
|
|
|
|
|
|
|
4207
|
|
|
|
|
|
|
######################################################################## |
4208
|
|
|
|
|
|
|
|
4209
|
|
|
|
|
|
|
1; |