line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::RunSQL; |
2
|
11
|
|
|
11
|
|
580976
|
use strict; |
|
11
|
|
|
|
|
94
|
|
|
11
|
|
|
|
|
269
|
|
3
|
11
|
|
|
11
|
|
46
|
use warnings; |
|
11
|
|
|
|
|
16
|
|
|
11
|
|
|
|
|
247
|
|
4
|
11
|
|
|
11
|
|
14567
|
use DBI; |
|
11
|
|
|
|
|
163027
|
|
|
11
|
|
|
|
|
565
|
|
5
|
11
|
|
|
11
|
|
5119
|
use Module::Load 'load'; |
|
11
|
|
|
|
|
10273
|
|
|
11
|
|
|
|
|
60
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.22'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
DBIx::RunSQL - run SQL from a file |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
18
|
|
|
|
|
|
|
use strict; |
19
|
|
|
|
|
|
|
use DBIx::RunSQL; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $test_dbh = DBIx::RunSQL->create( |
22
|
|
|
|
|
|
|
dsn => 'dbi:SQLite:dbname=:memory:', |
23
|
|
|
|
|
|
|
sql => 'sql/create.sql', |
24
|
|
|
|
|
|
|
force => 1, |
25
|
|
|
|
|
|
|
verbose => 1, |
26
|
|
|
|
|
|
|
formatter => 'Text::Table', |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# now run your tests with a DB setup fresh from setup.sql |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 METHODS |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->create ARGS >> |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->run ARGS >> |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Runs the SQL commands and returns the database handle. |
38
|
|
|
|
|
|
|
In list context, it returns the database handle and the |
39
|
|
|
|
|
|
|
suggested exit code. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=over 4 |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=item * |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
C - name of the file containing the SQL statements |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
The default is C |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
If C is a reference to a glob or a filehandle, |
50
|
|
|
|
|
|
|
the SQL will be read from that. B |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
If C is undefined, the C<$::DATA> or the C<0> filehandle will |
53
|
|
|
|
|
|
|
be read until exhaustion. B |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This allows one to create SQL-as-programs as follows: |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#!/usr/bin/perl -w -MDBIx::RunSQL -e 'create()' |
58
|
|
|
|
|
|
|
create table ... |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
If you want to run SQL statements from a scalar, |
61
|
|
|
|
|
|
|
you can simply pass in a reference to a scalar containing the SQL: |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sql => \"update mytable set foo='bar';", |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=item * |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
C, C, C, C - DBI parameters for connecting to the DB |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=item * |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
C - a premade database handle to be used instead of C |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item * |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
C - continue even if errors are encountered |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item * |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
C - print each SQL statement as it is run |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item * |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
C - callback to call with each SQL statement instead of C |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item * |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
C - filehandle to write to instead of C |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=back |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub create { |
94
|
0
|
|
|
0
|
1
|
0
|
my ($self,%args) = @_; |
95
|
0
|
|
0
|
|
|
0
|
$args{sql} ||= 'sql/create.sql'; |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
0
|
|
|
0
|
$args{options} ||= {}; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
0
|
my $dbh = delete $args{ dbh }; |
100
|
0
|
0
|
|
|
|
0
|
if (! $dbh) { |
101
|
|
|
|
|
|
|
$dbh = DBI->connect($args{dsn}, $args{user}, $args{password}, $args{options}) |
102
|
0
|
0
|
|
|
|
0
|
or die "Couldn't connect to DSN '$args{dsn}' : " . DBI->errstr; |
103
|
|
|
|
|
|
|
}; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
my $errors = $self->run_sql_file( |
106
|
|
|
|
|
|
|
dbh => $dbh, |
107
|
|
|
|
|
|
|
%args, |
108
|
|
|
|
|
|
|
); |
109
|
0
|
0
|
|
|
|
0
|
return wantarray ? ($dbh, $errors) : $dbh; |
110
|
|
|
|
|
|
|
}; |
111
|
|
|
|
|
|
|
*run = *run = \&create; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->run_sql_file ARGS >> |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
my $dbh = DBI->connect(...) |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
for my $file (sort glob '*.sql') { |
118
|
|
|
|
|
|
|
DBIx::RunSQL->run_sql_file( |
119
|
|
|
|
|
|
|
verbose => 1, |
120
|
|
|
|
|
|
|
dbh => $dbh, |
121
|
|
|
|
|
|
|
sql => $file, |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Runs an SQL file on a prepared database handle. |
126
|
|
|
|
|
|
|
Returns the number of errors encountered. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
If the statement returns rows, these are printed |
129
|
|
|
|
|
|
|
separated with tabs. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=over 4 |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=item * |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
C - a premade database handle |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item * |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
C - name of the file containing the SQL statements |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item * |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
C - filehandle to the file containing the SQL statements |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item * |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
C - continue even if errors are encountered |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item * |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
C - print each SQL statement as it is run |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item * |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
C - callback to call with each SQL statement instead of |
156
|
|
|
|
|
|
|
C |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item * |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
C - filehandle to write to instead of C |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item * |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
C - whether to exit with a nonzero exit code if any row is found |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
This makes the function return a nonzero value even if there is no error |
167
|
|
|
|
|
|
|
but a row was found. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=item * |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
C - whether to output the (one) row and column, without any |
172
|
|
|
|
|
|
|
headers |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item * |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
C - see the C<> option of C<< ->format_results >> |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=back |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=cut |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub run_sql_file { |
183
|
0
|
|
|
0
|
1
|
0
|
my ($self,%args) = @_; |
184
|
0
|
|
|
|
|
0
|
my @sql; |
185
|
0
|
0
|
|
|
|
0
|
if( ! $args{ fh }) { |
186
|
|
|
|
|
|
|
open $args{ fh }, "<", $args{sql} |
187
|
0
|
0
|
|
|
|
0
|
or die "Couldn't read '$args{sql}' : $!"; |
188
|
|
|
|
|
|
|
}; |
189
|
|
|
|
|
|
|
{ |
190
|
|
|
|
|
|
|
# potentially this should become C<< $/ = ";\n"; >> |
191
|
|
|
|
|
|
|
# and a while loop to handle large SQL files |
192
|
0
|
|
|
|
|
0
|
local $/; |
|
0
|
|
|
|
|
0
|
|
193
|
0
|
|
|
|
|
0
|
$args{ sql }= readline $args{ fh }; # sluuurp |
194
|
|
|
|
|
|
|
}; |
195
|
0
|
|
|
|
|
0
|
$self->run_sql( |
196
|
|
|
|
|
|
|
%args |
197
|
|
|
|
|
|
|
); |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->run_sql ARGS >> |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $dbh = DBI->connect(...) |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
DBIx::RunSQL->run_sql( |
205
|
|
|
|
|
|
|
verbose => 1, |
206
|
|
|
|
|
|
|
dbh => $dbh, |
207
|
|
|
|
|
|
|
sql => \@sql_statements, |
208
|
|
|
|
|
|
|
); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Runs an SQL string on a prepared database handle. |
211
|
|
|
|
|
|
|
Returns the number of errors encountered. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
If the statement returns rows, these are printed |
214
|
|
|
|
|
|
|
separated with tabs, but see the C and C options. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=over 4 |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item * |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
C - a premade database handle |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=item * |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
C - string or array reference containing the SQL statements |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item * |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
C - continue even if errors are encountered |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item * |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
C - print each SQL statement as it is run |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item * |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
C - callback to call with each SQL statement instead of C |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item * |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
C - filehandle to write to instead of C |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item * |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
C - whether to exit with a nonzero exit code if any row is found |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
This makes the function return a nonzero value even if there is no error |
247
|
|
|
|
|
|
|
but a row was found. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item * |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
C - whether to output the (one) row and column, without any headers |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item * |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
C - see the C<> option of C<< ->format_results >> |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=back |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=cut |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub run_sql { |
262
|
0
|
|
|
0
|
1
|
0
|
my ($self,%args) = @_; |
263
|
0
|
|
|
|
|
0
|
my $errors = 0; |
264
|
|
|
|
|
|
|
my @sql= 'ARRAY' eq ref $args{ sql } |
265
|
0
|
|
|
|
|
0
|
? @{ $args{ sql }} |
266
|
0
|
0
|
|
|
|
0
|
: $args{ sql }; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
$args{ verbose_handler } ||= sub { |
269
|
0
|
|
0
|
0
|
|
0
|
$args{ verbose_fh } ||= \*main::STDOUT; |
270
|
0
|
|
|
|
|
0
|
print { $args{ verbose_fh } } "$_[0]\n"; |
|
0
|
|
|
|
|
0
|
|
271
|
0
|
|
0
|
|
|
0
|
}; |
272
|
0
|
|
|
|
|
0
|
my $status = delete $args{ verbose_handler }; |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Because we blindly split above on /;\n/ |
275
|
|
|
|
|
|
|
# we need to reconstruct multi-line CREATE TRIGGER statements here again |
276
|
0
|
|
|
|
|
0
|
my $trigger; |
277
|
0
|
|
|
|
|
0
|
for my $statement ($self->split_sql( $args{ sql })) { |
278
|
|
|
|
|
|
|
# skip "statements" that consist only of comments |
279
|
0
|
0
|
|
|
|
0
|
next unless $statement =~ /^\s*[A-Z][A-Z]/mi; |
280
|
0
|
0
|
|
|
|
0
|
$status->($statement) if $args{verbose}; |
281
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
my $sth = $args{dbh}->prepare($statement); |
283
|
0
|
0
|
|
|
|
0
|
if(! $sth) { |
284
|
0
|
0
|
|
|
|
0
|
if (!$args{force}) { |
285
|
0
|
|
|
|
|
0
|
die "[SQL ERROR]: $statement\n"; |
286
|
|
|
|
|
|
|
} else { |
287
|
0
|
|
|
|
|
0
|
warn "[SQL ERROR]: $statement\n"; |
288
|
|
|
|
|
|
|
}; |
289
|
|
|
|
|
|
|
} else { |
290
|
0
|
|
|
|
|
0
|
my $status= $sth->execute(); |
291
|
0
|
0
|
0
|
|
|
0
|
if(! $status) { |
|
|
0
|
|
|
|
|
|
292
|
0
|
0
|
|
|
|
0
|
if (!$args{force}) { |
293
|
0
|
|
|
|
|
0
|
die "[SQL ERROR]: $statement\n"; |
294
|
|
|
|
|
|
|
} else { |
295
|
0
|
|
|
|
|
0
|
warn "[SQL ERROR]: $statement\n"; |
296
|
|
|
|
|
|
|
}; |
297
|
|
|
|
|
|
|
} elsif( defined $sth->{NUM_OF_FIELDS} and 0 < $sth->{NUM_OF_FIELDS} ) { |
298
|
|
|
|
|
|
|
# SELECT statement, output results |
299
|
0
|
0
|
|
|
|
0
|
if( $args{ output_bool }) { |
|
|
0
|
|
|
|
|
|
300
|
0
|
|
|
|
|
0
|
my $res = $self->format_results( |
301
|
|
|
|
|
|
|
sth => $sth, |
302
|
|
|
|
|
|
|
no_header_when_empty => 1, |
303
|
|
|
|
|
|
|
%args |
304
|
|
|
|
|
|
|
); |
305
|
0
|
|
|
|
|
0
|
print $res; |
306
|
|
|
|
|
|
|
# Set the exit code depending on the length of $res because |
307
|
|
|
|
|
|
|
# we lost the information on how many rows the result |
308
|
|
|
|
|
|
|
# set had ... |
309
|
0
|
|
|
|
|
0
|
$errors = length $res > 0; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
} elsif( $args{ output_string }) { |
312
|
0
|
|
|
|
|
0
|
local $args{formatter} = 'tab'; |
313
|
0
|
|
|
|
|
0
|
print $self->format_results( |
314
|
|
|
|
|
|
|
sth => $sth, |
315
|
|
|
|
|
|
|
no_header_when_empty => 1, |
316
|
|
|
|
|
|
|
%args |
317
|
|
|
|
|
|
|
); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
} else { |
320
|
0
|
|
|
|
|
0
|
print $self->format_results( sth => $sth, %args ); |
321
|
|
|
|
|
|
|
}; |
322
|
|
|
|
|
|
|
}; |
323
|
|
|
|
|
|
|
}; |
324
|
|
|
|
|
|
|
}; |
325
|
0
|
|
|
|
|
0
|
$errors |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->format_results %options >> |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
my $sth= $dbh->prepare( 'select * from foo' ); |
331
|
|
|
|
|
|
|
$sth->execute(); |
332
|
|
|
|
|
|
|
print DBIx::RunSQL->format_results( sth => $sth ); |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
Executes C<< $sth->fetchall_arrayref >> and returns |
335
|
|
|
|
|
|
|
the results either as tab separated string |
336
|
|
|
|
|
|
|
or formatted using L if the module is available. |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
If you find yourself using this often to create reports, |
339
|
|
|
|
|
|
|
you may really want to look at L instead. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=over 4 |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=item * |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
C - the executed statement handle |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item * |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
C - if you want to force C or C |
350
|
|
|
|
|
|
|
usage, you can do it through that parameter. |
351
|
|
|
|
|
|
|
In fact, the module will use anything other than C |
352
|
|
|
|
|
|
|
as the class name and assume that the interface is compatible |
353
|
|
|
|
|
|
|
to C. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=back |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Note that the query results are returned as one large string, |
358
|
|
|
|
|
|
|
so you really do not want to run this for large(r) result |
359
|
|
|
|
|
|
|
sets. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=cut |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub format_results { |
364
|
0
|
|
|
0
|
1
|
0
|
my( $self, %options )= @_; |
365
|
0
|
|
|
|
|
0
|
my $sth= delete $options{ sth }; |
366
|
|
|
|
|
|
|
|
367
|
0
|
0
|
|
|
|
0
|
if( ! $options{ formatter }) { |
368
|
0
|
0
|
|
|
|
0
|
if( eval { require "Text/Table.pm" }) { |
|
0
|
|
|
|
|
0
|
|
369
|
0
|
|
|
|
|
0
|
$options{ formatter }= 'Text::Table'; |
370
|
|
|
|
|
|
|
} else { |
371
|
0
|
|
|
|
|
0
|
$options{ formatter }= 'tab'; |
372
|
|
|
|
|
|
|
}; |
373
|
|
|
|
|
|
|
}; |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
0
|
my @columns= @{ $sth->{NAME} }; |
|
0
|
|
|
|
|
0
|
|
376
|
0
|
|
|
|
|
0
|
my $no_header_when_empty = $options{ no_header_when_empty }; |
377
|
0
|
|
0
|
|
|
0
|
my $print_header = not exists $options{ header } || $options{ header }; |
378
|
0
|
|
|
|
|
0
|
my $res= $sth->fetchall_arrayref(); |
379
|
0
|
|
|
|
|
0
|
my $result=''; |
380
|
0
|
0
|
|
|
|
0
|
if( @columns ) { |
381
|
|
|
|
|
|
|
# Output as print statement |
382
|
0
|
0
|
0
|
|
|
0
|
if( $no_header_when_empty and ! @$res ) { |
|
|
0
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# Nothing to do |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
} elsif( 'tab' eq $options{ formatter } ) { |
386
|
|
|
|
|
|
|
$result = join "\n", |
387
|
|
|
|
|
|
|
$print_header ? join( "\t", @columns ) : (), |
388
|
0
|
0
|
|
|
|
0
|
map { join( "\t", @$_ ) } @$res |
|
0
|
|
|
|
|
0
|
|
389
|
|
|
|
|
|
|
; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
} else { |
392
|
0
|
|
|
|
|
0
|
my $class = $options{ formatter }; |
393
|
|
|
|
|
|
|
|
394
|
0
|
0
|
0
|
|
|
0
|
if( !( $class->can('table') || $class->can('new'))) { |
395
|
|
|
|
|
|
|
# Try to load the module, just in case it isn't present in |
396
|
|
|
|
|
|
|
# memory already |
397
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
0
|
eval { load $class; }; |
|
0
|
|
|
|
|
0
|
|
399
|
|
|
|
|
|
|
}; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# Now dispatch according to the apparent type |
402
|
0
|
0
|
0
|
|
|
0
|
if( !$class->isa('Text::Table') and my $table = $class->can('table') ) { |
403
|
|
|
|
|
|
|
# Text::Table::Any interface |
404
|
0
|
|
|
|
|
0
|
$result = $table->( header_row => 1, |
405
|
|
|
|
|
|
|
rows => [\@columns, @$res ], |
406
|
|
|
|
|
|
|
); |
407
|
|
|
|
|
|
|
} else {; |
408
|
|
|
|
|
|
|
# Text::Table interface |
409
|
0
|
|
|
|
|
0
|
my $t= $options{formatter}->new(@columns); |
410
|
0
|
|
|
|
|
0
|
$t->load( @$res ); |
411
|
0
|
|
|
|
|
0
|
$result= $t; |
412
|
|
|
|
|
|
|
}; |
413
|
|
|
|
|
|
|
}; |
414
|
|
|
|
|
|
|
}; |
415
|
0
|
|
|
|
|
0
|
"$result"; # Yes, sorry - we stringify everything |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->split_sql ARGS >> |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
my @statements= DBIx::RunSQL->split_sql( <<'SQL'); |
421
|
|
|
|
|
|
|
create table foo (name varchar(64)); |
422
|
|
|
|
|
|
|
create trigger foo_insert on foo before insert; |
423
|
|
|
|
|
|
|
new.name= 'foo-'||old.name; |
424
|
|
|
|
|
|
|
end; |
425
|
|
|
|
|
|
|
insert into foo name values ('bar'); |
426
|
|
|
|
|
|
|
SQL |
427
|
|
|
|
|
|
|
# Returns three elements |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
This is a helper subroutine to split a sequence of (semicolon-newline-delimited) |
430
|
|
|
|
|
|
|
SQL statements into separate statements. It is documented because |
431
|
|
|
|
|
|
|
it is not a very smart subroutine and you might want to |
432
|
|
|
|
|
|
|
override or replace it. It might also be useful outside the context |
433
|
|
|
|
|
|
|
of L if you need to split up a large blob |
434
|
|
|
|
|
|
|
of SQL statements into smaller pieces. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
The subroutine needs the whole sequence of SQL statements in memory. |
437
|
|
|
|
|
|
|
If you are attempting to restore a large SQL dump backup into your |
438
|
|
|
|
|
|
|
database, this approach might not be suitable. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=cut |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub split_sql { |
443
|
1
|
|
|
1
|
1
|
740
|
my( $self, $sql )= @_; |
444
|
1
|
|
|
|
|
8
|
my @sql = split /;[ \t]*\r?\n/, $sql; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# Because we blindly split above on /;\n/ |
447
|
|
|
|
|
|
|
# we need to reconstruct multi-line CREATE TRIGGER statements here again |
448
|
1
|
|
|
|
|
3
|
my @res; |
449
|
|
|
|
|
|
|
my $trigger; |
450
|
1
|
|
|
|
|
3
|
for my $statement (@sql) { |
451
|
3
|
100
|
|
|
|
12
|
next unless $statement =~ /\S/; |
452
|
2
|
50
|
|
|
|
28
|
if( $statement =~ /^\s*CREATE\s+TRIGGER\b/i ) { |
|
|
50
|
|
|
|
|
|
453
|
0
|
|
|
|
|
0
|
$trigger = $statement; |
454
|
|
|
|
|
|
|
next |
455
|
0
|
0
|
|
|
|
0
|
if( $statement !~ /END$/i ); |
456
|
0
|
|
|
|
|
0
|
$statement = $trigger; |
457
|
0
|
|
|
|
|
0
|
undef $trigger; |
458
|
|
|
|
|
|
|
} elsif( $trigger ) { |
459
|
0
|
|
|
|
|
0
|
$trigger .= ";\n$statement"; |
460
|
|
|
|
|
|
|
next |
461
|
0
|
0
|
|
|
|
0
|
if( $statement !~ /END$/i ); |
462
|
0
|
|
|
|
|
0
|
$statement = $trigger; |
463
|
0
|
|
|
|
|
0
|
undef $trigger; |
464
|
|
|
|
|
|
|
}; |
465
|
2
|
|
|
|
|
4
|
push @res, $statement; |
466
|
|
|
|
|
|
|
}; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
@res |
469
|
1
|
|
|
|
|
4
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
1; |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->parse_command_line >> |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
my $options = DBIx::RunSQL->parse_command_line( 'my_application', \@ARGV ); |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
Helper function to turn a command line array into options for DBIx::RunSQL |
478
|
|
|
|
|
|
|
invocations. The array of command line items is modified in-place. |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
If the reference to the array of command line items is missing, C<@ARGV> |
481
|
|
|
|
|
|
|
will be modified instead. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=cut |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub parse_command_line { |
486
|
4
|
|
|
4
|
1
|
9
|
my ($package,$appname,$argv) = @_; |
487
|
4
|
|
|
|
|
681
|
require Getopt::Long; Getopt::Long->import('GetOptionsFromArray'); |
|
4
|
|
|
|
|
9032
|
|
488
|
|
|
|
|
|
|
|
489
|
4
|
100
|
|
|
|
255
|
if (! $argv) { $argv = \@ARGV }; |
|
1
|
|
|
|
|
3
|
|
490
|
|
|
|
|
|
|
|
491
|
4
|
50
|
|
|
|
15
|
if (GetOptionsFromArray( $argv, |
492
|
|
|
|
|
|
|
'user:s' => \my $user, |
493
|
|
|
|
|
|
|
'password:s' => \my $password, |
494
|
|
|
|
|
|
|
'dsn:s' => \my $dsn, |
495
|
|
|
|
|
|
|
'verbose' => \my $verbose, |
496
|
|
|
|
|
|
|
'force|f' => \my $force, |
497
|
|
|
|
|
|
|
'sql:s' => \my $sql, |
498
|
|
|
|
|
|
|
'bool' => \my $output_bool, |
499
|
|
|
|
|
|
|
'string' => \my $output_string, |
500
|
|
|
|
|
|
|
'quiet' => \my $no_header_when_empty, |
501
|
|
|
|
|
|
|
'format:s' => \my $formatter_class, |
502
|
|
|
|
|
|
|
'help|h' => \my $help, |
503
|
|
|
|
|
|
|
'man' => \my $man, |
504
|
|
|
|
|
|
|
)) { |
505
|
11
|
|
|
11
|
|
13185
|
no warnings 'newline'; |
|
11
|
|
|
|
|
21
|
|
|
11
|
|
|
|
|
3121
|
|
506
|
4
|
|
100
|
|
|
2686
|
$sql ||= join " ", @$argv; |
507
|
4
|
100
|
66
|
|
|
61
|
if( $sql and ! -f $sql ) { |
508
|
2
|
|
|
|
|
8
|
$sql = \"$sql", |
509
|
|
|
|
|
|
|
}; |
510
|
4
|
|
|
|
|
5
|
my $fh; |
511
|
4
|
50
|
66
|
|
|
12
|
if( ! $sql and not @$argv) { |
512
|
|
|
|
|
|
|
# Assume we'll read the SQL from stdin |
513
|
2
|
|
|
|
|
4
|
$fh = \*STDIN; |
514
|
|
|
|
|
|
|
}; |
515
|
|
|
|
|
|
|
return { |
516
|
4
|
|
|
|
|
39
|
user => $user, |
517
|
|
|
|
|
|
|
password => $password, |
518
|
|
|
|
|
|
|
dsn => $dsn, |
519
|
|
|
|
|
|
|
verbose => $verbose, |
520
|
|
|
|
|
|
|
force => $force, |
521
|
|
|
|
|
|
|
sql => $sql, |
522
|
|
|
|
|
|
|
fh => $fh, |
523
|
|
|
|
|
|
|
no_header_when_empty => $no_header_when_empty, |
524
|
|
|
|
|
|
|
output_bool => $output_bool, |
525
|
|
|
|
|
|
|
output_string => $output_string, |
526
|
|
|
|
|
|
|
formatter => $formatter_class, |
527
|
|
|
|
|
|
|
help => $help, |
528
|
|
|
|
|
|
|
man => $man, |
529
|
|
|
|
|
|
|
}; |
530
|
|
|
|
|
|
|
} else { |
531
|
0
|
|
|
|
|
0
|
return undef; |
532
|
|
|
|
|
|
|
}; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
sub handle_command_line { |
536
|
4
|
|
|
4
|
1
|
1864
|
my ($package,$appname,$argv) = @_; |
537
|
4
|
|
|
|
|
463
|
require Pod::Usage; Pod::Usage->import(); |
|
4
|
|
|
|
|
41877
|
|
538
|
|
|
|
|
|
|
|
539
|
4
|
50
|
|
|
|
17
|
my $opts = $package->parse_command_line($appname,$argv) |
540
|
|
|
|
|
|
|
or pod2usage(2); |
541
|
4
|
50
|
|
|
|
11
|
pod2usage(1) if $opts->{help}; |
542
|
4
|
50
|
|
|
|
9
|
pod2usage(-verbose => 2) if $opts->{man}; |
543
|
|
|
|
|
|
|
|
544
|
4
|
|
66
|
|
|
32
|
$opts->{dsn} ||= sprintf 'dbi:SQLite:dbname=db/%s.sqlite', $appname; |
545
|
4
|
|
|
|
|
30
|
my( $dbh, $exitcode) = $package->create( |
546
|
|
|
|
|
|
|
%$opts |
547
|
|
|
|
|
|
|
); |
548
|
4
|
|
|
|
|
42
|
return $exitcode |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head2 C<< DBIx::RunSQL->handle_command_line >> |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
DBIx::RunSQL->handle_command_line( 'my_application', \@ARGV ); |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
Helper function to run the module functionality from the command line. See below |
556
|
|
|
|
|
|
|
how to use this function in a good self-contained script. |
557
|
|
|
|
|
|
|
This function |
558
|
|
|
|
|
|
|
passes the following command line arguments and options to C<< ->create >>: |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
--user |
561
|
|
|
|
|
|
|
--password |
562
|
|
|
|
|
|
|
--dsn |
563
|
|
|
|
|
|
|
--sql |
564
|
|
|
|
|
|
|
--quiet |
565
|
|
|
|
|
|
|
--format |
566
|
|
|
|
|
|
|
--force |
567
|
|
|
|
|
|
|
--verbose |
568
|
|
|
|
|
|
|
--bool |
569
|
|
|
|
|
|
|
--string |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
In addition, it handles the following switches through L: |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
--help |
574
|
|
|
|
|
|
|
--man |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
If no SQL is given, this function will read the SQL from STDIN. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
If no dsn is given, this function will use |
579
|
|
|
|
|
|
|
C< dbi:SQLite:dbname=db/$appname.sqlite > |
580
|
|
|
|
|
|
|
as the default database. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
See also the section PROGRAMMER USAGE for a sample program to set |
583
|
|
|
|
|
|
|
up a database from an SQL file. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head1 PROGRAMMER USAGE |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
This module abstracts away the "run these SQL statements to set up |
588
|
|
|
|
|
|
|
your database" into a module. In some situations you want to give the |
589
|
|
|
|
|
|
|
setup SQL to a database admin, but in other situations, for example testing, |
590
|
|
|
|
|
|
|
you want to run the SQL statements against an in-memory database. This |
591
|
|
|
|
|
|
|
module abstracts away the reading of SQL from a file and allows for various |
592
|
|
|
|
|
|
|
command line parameters to be passed in. A skeleton C |
593
|
|
|
|
|
|
|
looks like this: |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
596
|
|
|
|
|
|
|
use strict; |
597
|
|
|
|
|
|
|
use DBIx::RunSQL; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
my $exitcode = DBIx::RunSQL->handle_command_line('myapp', \@ARGV); |
600
|
|
|
|
|
|
|
exit $exitcode; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=head1 NAME |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
create-db.pl - Create the database |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=head1 SYNOPSIS |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
create-db.pl "select * from mytable where 1=0" |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=head1 ABSTRACT |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
This sets up the database. The following |
613
|
|
|
|
|
|
|
options are recognized: |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head1 OPTIONS |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=over 4 |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=item C<--user> USERNAME |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
=item C<--password> PASSWORD |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=item C<--dsn> DSN |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
The DBI DSN to use for connecting to |
626
|
|
|
|
|
|
|
the database |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=item C<--sql> SQLFILE |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
The alternative SQL file to use |
631
|
|
|
|
|
|
|
instead of C. |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=item C<--quiet> |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
Output no headers for empty SELECT resultsets |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=item C<--bool> |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
Set the exit code to 1 if at least one result row was found |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=item C<--string> |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
Output the (single) column that the query returns as a string without |
644
|
|
|
|
|
|
|
any headers |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=item C<--format> formatter |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Use a different formatter for table output. Supported formatters are |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
tab - output results as tab delimited columns |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
Text::Table - output results as ASCII table |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=item C<--force> |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
Don't stop on errors |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=item C<--help> |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
Show this message. |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=back |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=cut |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head1 NOTES |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
=head2 COMMENT FILTERING |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
The module tries to keep the SQL as much verbatim as possible. It |
671
|
|
|
|
|
|
|
filters all lines that end in semicolons but contain only SQL comments. All |
672
|
|
|
|
|
|
|
other comments are passed through to the database with the next statement. |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=head2 TRIGGER HANDLING |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
This module uses a very simplicistic approach to recognize triggers. |
677
|
|
|
|
|
|
|
Triggers are problematic because they consist of multiple SQL statements |
678
|
|
|
|
|
|
|
and this module does not implement a full SQL parser. An trigger is |
679
|
|
|
|
|
|
|
recognized by the following sequence of lines |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
CREATE TRIGGER |
682
|
|
|
|
|
|
|
... |
683
|
|
|
|
|
|
|
END; |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
If your SQL dialect uses a different syntax, it might still work to put |
686
|
|
|
|
|
|
|
the whole trigger on a single line in the input file. |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=head2 OTHER APPROACHES |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
If you find yourself wanting to write SELECT statements, |
691
|
|
|
|
|
|
|
consider looking at L instead, which is geared towards that |
692
|
|
|
|
|
|
|
and even has an interface for Excel or HTML output. |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
If you find yourself wanting to write parametrized queries as |
695
|
|
|
|
|
|
|
C<.sql> files, consider looking at L |
696
|
|
|
|
|
|
|
or potentially L. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=head1 SEE ALSO |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
L |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
L - SQLite setup/teardown for tests, mostly geared towards |
703
|
|
|
|
|
|
|
testing, not general database setup |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=head1 REPOSITORY |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
The public repository of this module is |
708
|
|
|
|
|
|
|
L. |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=head1 SUPPORT |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
The public support forum of this module is |
713
|
|
|
|
|
|
|
L. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=head1 BUG TRACKER |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
Please report bugs in this module via the RT CPAN bug queue at |
718
|
|
|
|
|
|
|
L |
719
|
|
|
|
|
|
|
or via mail to L. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=head1 AUTHOR |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
Max Maischein C |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=head1 COPYRIGHT (c) |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
Copyright 2009-2021 by Max Maischein C. |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=head1 LICENSE |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
This module is released under the same terms as Perl itself. |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=cut |