line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::DB::Mssql; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
19950
|
use 5.014; |
|
1
|
|
|
|
|
4
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
6
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use Venus::Class; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
with 'Venus::Role::Optional'; |
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
1859
|
use DBI; |
|
1
|
|
|
|
|
17863
|
|
|
1
|
|
|
|
|
1159
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# VERSION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.10'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# ATTRIBUTES |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
attr 'dbh'; |
21
|
|
|
|
|
|
|
attr 'dsn'; |
22
|
|
|
|
|
|
|
attr 'hostname'; |
23
|
|
|
|
|
|
|
attr 'hostport'; |
24
|
|
|
|
|
|
|
attr 'initial'; |
25
|
|
|
|
|
|
|
attr 'uri'; |
26
|
|
|
|
|
|
|
attr 'username'; |
27
|
|
|
|
|
|
|
attr 'password'; |
28
|
|
|
|
|
|
|
attr 'database'; |
29
|
|
|
|
|
|
|
attr 'template'; |
30
|
|
|
|
|
|
|
attr 'odbcdsn'; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# OPTIONS |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub lazy_build_dbh { |
35
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
36
|
|
|
|
|
|
|
|
37
|
0
|
|
0
|
|
|
|
$data ||= DBI->connect($self->dsn, $self->username, $self->password, { |
38
|
|
|
|
|
|
|
RaiseError => 1, |
39
|
|
|
|
|
|
|
AutoCommit => 1 |
40
|
|
|
|
|
|
|
}); |
41
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
|
return $data; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub lazy_build_dsn { |
46
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
|
return $self->dsngen($self->database); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub lazy_build_hostname { |
52
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
53
|
|
|
|
|
|
|
|
54
|
0
|
0
|
|
|
|
|
return $data ? $data : $ENV{TESTDB_HOSTNAME}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub lazy_build_hostport { |
58
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
return $data ? $data : $ENV{TESTDB_HOSTPORT}; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub lazy_build_initial { |
64
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
65
|
|
|
|
|
|
|
|
66
|
0
|
0
|
0
|
|
|
|
return $data ? $data : $ENV{TESTDB_INITIAL} || 'master'; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub lazy_build_uri { |
70
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
return $self->urigen($self->database); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub lazy_build_username { |
76
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
77
|
|
|
|
|
|
|
|
78
|
0
|
0
|
0
|
|
|
|
return $data ? $data : $ENV{TESTDB_USERNAME} || 'sa'; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub lazy_build_password { |
82
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
83
|
|
|
|
|
|
|
|
84
|
0
|
0
|
0
|
|
|
|
return $data ? $data : $ENV{TESTDB_PASSWORD} || ''; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub lazy_build_database { |
88
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
89
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
|
return $data ? $data : join '_', 'testing_db', time, $$, sprintf "%04d", rand 999; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub lazy_build_template { |
94
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
|
return $data ? $data : $ENV{TESTDB_TEMPLATE}; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub lazy_build_odbcdsn { |
100
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
101
|
|
|
|
|
|
|
|
102
|
0
|
0
|
|
|
|
|
return $data ? $data : $ENV{TESTDB_ODBCDSN}; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# METHODS |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub clone { |
108
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
my $source = $self->template; |
111
|
0
|
|
|
|
|
|
my $initial = $self->initial; |
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
my $dbh = DBI->connect($self->dsngen($initial), |
114
|
|
|
|
|
|
|
$self->username, |
115
|
|
|
|
|
|
|
$self->password, |
116
|
|
|
|
|
|
|
{ |
117
|
|
|
|
|
|
|
RaiseError => 1, |
118
|
|
|
|
|
|
|
AutoCommit => 1 |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
); |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare(qq(DBCC CLONEDATABASE([$source], [@{[$self->database]}]))); |
|
0
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
$sth->execute; |
125
|
0
|
|
|
|
|
|
$dbh->disconnect; |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
|
$self->dbh; |
128
|
0
|
|
|
|
|
|
$self->uri; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
return $self; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub create { |
134
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
my $dbh = DBI->connect($self->dsngen($self->initial), |
137
|
|
|
|
|
|
|
$self->username, |
138
|
|
|
|
|
|
|
$self->password, |
139
|
|
|
|
|
|
|
{ |
140
|
|
|
|
|
|
|
RaiseError => 1, |
141
|
|
|
|
|
|
|
AutoCommit => 1 |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
); |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare(qq(CREATE DATABASE [@{[$self->database]}])); |
|
0
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$sth->execute; |
148
|
0
|
|
|
|
|
|
$dbh->disconnect; |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
$self->dbh; |
151
|
0
|
|
|
|
|
|
$self->uri; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
return $self; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub destroy { |
157
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
158
|
|
|
|
|
|
|
|
159
|
0
|
0
|
|
|
|
|
$self->dbh->disconnect if $self->{dbh}; |
160
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
my $dbh = DBI->connect($self->dsngen($self->initial), |
162
|
|
|
|
|
|
|
$self->username, |
163
|
|
|
|
|
|
|
$self->password, |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
RaiseError => 1, |
166
|
|
|
|
|
|
|
AutoCommit => 1 |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
); |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare(qq(DROP DATABASE [@{[$self->database]}])); |
|
0
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
$sth->execute; |
173
|
0
|
|
|
|
|
|
$dbh->disconnect; |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
|
|
|
|
return $self; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub dsngen { |
179
|
0
|
|
|
0
|
0
|
|
my ($self, $name) = @_; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
my $hostname = $self->hostname; |
182
|
0
|
|
|
|
|
|
my $hostport = $self->hostport; |
183
|
|
|
|
|
|
|
|
184
|
0
|
0
|
|
|
|
|
return join ';', "dbi:ODBC:DSN=@{[$self->odbcdsn]};database=$name", join ';', |
|
0
|
0
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
($hostname ? ("host=@{[$hostname]}") : ()), |
186
|
0
|
|
|
|
|
|
($hostport ? ("port=@{[$hostport]}") : ()) |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub urigen { |
190
|
0
|
|
|
0
|
0
|
|
my ($self, $name) = @_; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
my $username = $self->username; |
193
|
0
|
|
|
|
|
|
my $password = $self->password; |
194
|
0
|
|
|
|
|
|
my $hostname = $self->hostname; |
195
|
0
|
|
|
|
|
|
my $hostport = $self->hostport; |
196
|
|
|
|
|
|
|
|
197
|
0
|
0
|
|
|
|
|
return join( |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
198
|
|
|
|
|
|
|
'/', 'mssql', |
199
|
|
|
|
|
|
|
($username ? '' : ()), |
200
|
|
|
|
|
|
|
( |
201
|
|
|
|
|
|
|
$username |
202
|
|
|
|
|
|
|
? join('@', |
203
|
|
|
|
|
|
|
join(':', $username ? ($username, ($password ? $password : ())) : ()), |
204
|
|
|
|
|
|
|
$hostname |
205
|
|
|
|
|
|
|
? ($hostport ? (join(':', $hostname, $hostport)) : $hostname) |
206
|
|
|
|
|
|
|
: '') |
207
|
|
|
|
|
|
|
: () |
208
|
|
|
|
|
|
|
), |
209
|
|
|
|
|
|
|
$name |
210
|
|
|
|
|
|
|
) |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
1; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head1 NAME |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Test::DB::Mssql - Temporary Testing Databases for Mssql |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 ABSTRACT |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
Temporary Mssql Database for Testing |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=cut |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 VERSION |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
0.10 |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=cut |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 SYNOPSIS |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
package main; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
use Test::DB::Mssql; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my $tdbo = Test::DB::Mssql->new; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# my $dbh = $tdbo->create->dbh; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head1 DESCRIPTION |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
This package provides methods for generating and destroying Mssql databases |
250
|
|
|
|
|
|
|
for testing purposes. The attributes can be set using their respective |
251
|
|
|
|
|
|
|
environment variables: C, C, |
252
|
|
|
|
|
|
|
C, C, C, and |
253
|
|
|
|
|
|
|
C. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=cut |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
This package has the following attributes: |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head2 dbh |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
dbh(Object) |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Object)> values, and is optional. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=cut |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head2 dsn |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
dsn(Str) |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head2 database |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
database(Str) |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head2 hostname |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
hostname(Str) |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=cut |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head2 hostport |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
hostport(Str) |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=cut |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=head2 uri |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
uri(Str) |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=cut |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head2 username |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
username(Str) |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=cut |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head2 password |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
password(Str) |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
This attribute is read-only, accepts C<(Str)> values, and is optional. |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=cut |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head1 METHODS |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
This package provides the following methods: |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=cut |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=head2 clone |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
clone(Str $source) : Object |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
The clone method creates a temporary database from a database template. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=over 4 |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=item clone example 1 |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# given: synopsis |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
$tdbo->clone('template0'); |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=back |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=cut |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head2 create |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
create() : Object |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
The create method creates a temporary database and returns the invocant. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=over 4 |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=item create example 1 |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# given: synopsis |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
$tdbo->create; |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=back |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=cut |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=head2 destroy |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
destroy() : Object |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
The destroy method destroys (drops) the database and returns the invocant. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=over 4 |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=item destroy example 1 |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# given: synopsis |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
$tdbo->create; |
386
|
|
|
|
|
|
|
$tdbo->destroy; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=back |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |