File Coverage

blib/lib/Test/DBIC/SQLite.pm
Criterion Covered Total %
statement 47 47 100.0
branch 16 16 100.0
condition 8 8 100.0
subroutine 10 10 100.0
pod 5 5 100.0
total 86 86 100.0


line stmt bran cond sub pod time code
1             use Moo;
2 3     3   323432 with 'Test::DBIC::DBDConnector';
  3         25960  
  3         13  
3              
4             our $VERSION = "1.00_01";
5              
6             use parent 'Test::Builder::Module';
7 3     3   3695 our @EXPORT = qw( connect_dbic_sqlite_ok drop_dbic_sqlite_ok );
  3         5  
  3         13  
8              
9             $Test::DBIC::SQLite::LeaveCreatedDatabases //= 0;
10              
11             use Types::Standard qw( Bool Str );
12 3     3   1675 has '+dbi_connect_info' => (
  3         253809  
  3         30  
13             is => 'ro',
14             isa => Str,
15             default => sub {':memory:'},
16             );
17             has _did_create => (
18             is => 'rwp',
19             isa => Bool,
20             default => 0,
21             );
22              
23             # Keep a "singleton" around for the functional interface.
24             my $_tdbc_cache;
25              
26             my $self = shift;
27             if ($self->_did_create && !$Test::DBIC::SQLite::LeaveCreatedDatabases) {
28 16     16 1 26303 unlink($self->dbi_connect_info) if -e $self->dbi_connect_info;
29 16 100 100     106 }
30 2 100       83 $self->_set__did_create(0);
31             }
32 16         314  
33             my $class = __PACKAGE__;
34             my %args = $class->validate_positional_parameters(
35             [
36 10     10 1 13622 $class->parameter(schema_class => $class->Required),
37 10         48 $class->parameter(dbi_connect_info => $class->Optional),
38             $class->parameter(post_connect_hook => $class->Optional),
39             ],
40             \@_
41             );
42              
43             # if one provides a post_connect_hook but undef for dbi_connect_info of
44             # type Maybe[Str], the default cannot kick in.
45             $args{dbi_connect_info} //= ':memory:';
46             delete($args{post_connect_hook}) if @_ < 3;
47              
48 10   100     6504 $_tdbc_cache = $class->new(%args);
49 10 100       418  
50             local $Test::Builder::Level = $Test::Builder::Level + 1;
51 10         169 my $schema = $_tdbc_cache->connect_dbic_ok();
52              
53 10         4823 return $schema;
54 10         33 }
55              
56 10         1610 local $Test::Builder::Level = $Test::Builder::Level + 1;
57             my $result = $_tdbc_cache->drop_dbic_ok();
58              
59             undef($_tdbc_cache);
60 2     2 1 4601  
61 2         12 return $result;
62             }
63 2         1022  
64             my $self = shift;
65 2         178 my $dbname = $self->dbi_connect_info;
66             my $msg = "$dbname DROPPED";
67              
68             if ($dbname ne ':memory:') {
69 6     6 1 26932 my $count = unlink($dbname);
70 6         31 if (not $count) {
71 6         21 $self->builder->diag("Could not unlink($dbname): $!");
72             return $self->builder->ok(0, $msg);
73 6 100       28 }
74 4         463 $self->_set__did_create(0);
75 4 100       30 }
76 1         7 return $self->builder->ok(1, $msg);
77 1         164 }
78              
79 3         130 my $self = shift;
80             $self->validate_positional_parameters(
81 5         150 [
82             $self->parameter(
83             dbi_connect_info => $self->Required,
84             { store => \my $db_name }
85             ),
86             ],
87             \@_
88             );
89              
90             return [ "dbi:SQLite:dbname=$db_name" ];
91             }
92              
93             my $self = shift;
94             $self->validate_positional_parameters(
95             [
96             $self->parameter(
97             connection_info => $self->Required,
98             { store => \my $connection_params }
99             )
100 16     16 1 23 ],
101 16         46 \@_
102             );
103              
104             my ($db_name) = $connection_params->[0] =~ m{dbname=(.+)(?:;|$)};
105             my $wants_deploy = $db_name eq ':memory:'
106             ? 1
107             : ((not -e $db_name) ? 1 : 0);
108              
109             $self->_set__did_create(1) if ($db_name ne ':memory:') && (not -e $db_name);
110              
111 16         6970 return $wants_deploy;
112 16 100       220 }
    100          
113              
114             around ValidationTemplates => sub {
115             my $vt = shift;
116 16 100 100     247 my $class = shift;
117              
118 16         180 use Types::Standard qw( ArrayRef Maybe Str );
119              
120             my $validation_templates = $class->$vt();
121             return {
122             %$validation_templates,
123             dbi_connect_info => { type => Maybe[Str], default => ':memory:' },
124             connection_info => { type => ArrayRef },
125 3     3   4241 };
  3         6  
  3         14  
126             };
127              
128             use namespace::autoclean 0.16;
129             1;
130              
131             =pod
132              
133             =head1 NAME
134              
135 3     3   3171 Test::DBIC::SQLite - Connect to and deploy a L<DBIx::Class::Schema> on SQLite
  3         28974  
  3         14  
136              
137             =head1 SYNOPSIS
138              
139             The preferred way:
140              
141             #! perl -w
142             use Test::More;
143             use Test::DBIC::SQLite;
144              
145             my $t = Test::DBIC::SQLite->new(
146             schema_class => 'My::Schema',
147             pre_deploy_hook => \&define_functions,
148             );
149             my $schema = $t->connect_dbic_ok();
150              
151             my $thing = $schema->resultset('MyTable')->search(
152             { name => 'Anything' },
153             { columns => [ { ul_name => \'uc_last(name)' } ] }
154             )->first;
155             is(
156             $thing->get_column('ul_name'),
157             'anythinG',
158             "SELECT uc_last(name) AS ul_name FROM ...; works!"
159             );
160              
161             $schema->storage->disconnect;
162             $t->drop_dbic_ok();
163             done_testing();
164              
165             # select uc_last('Stupid'); -- stupiD
166             # these functions will only exist within this database connection
167             sub define_functions {
168             my ($schema) = @_;
169             my $dbh = $schema->storage->dbh;
170             $dbh->sqlite_create_function(
171             'uc_last',
172             1,
173             sub { my ($str) = @_; $str =~ s{(.*)(.)$}{\L$1\U$2}; return $str },
174             );
175             }
176              
177              
178             The compatible with C<v0.01> way:
179              
180             #! perl -w
181             use Test::More;
182             use Test::DBIC::SQLite;
183             my $schema = connect_dbic_sqlite_ok('My::Schema');
184             ...
185             drop_dbic_sqlite_ok();
186             done_testing();
187              
188             =head1 DESCRIPTION
189              
190             This is a re-implementation of C<Test::DBIC::SQLite v0.01> that uses the
191             L<Moo::Role>: L<Test::DBIC::DBDConnector>.
192              
193             It will C<import()> L<warnings> and L<strict> for you.
194              
195             =head2 C<< Test::DBIC::SQLite->new >>
196              
197             my $t = Test::DBIC::SQLite->new(%parameters);
198             my $schema = $t->connect_dbic_ok();
199             ...
200             $schema->storage->disconnect;
201             $t->drop_dbic_ok();
202              
203             =head3 Parameters
204              
205             Named, list:
206              
207             =over
208              
209             =item B<< I<C<schema_class>> => C<$schema_class> >>(I<Required>)
210              
211             The class name of the L<DBIx::Class::Schema> to use for the database connection.
212              
213              
214             =item B<< I<C<dbi_connect_info>> => C<$sqlite_dbname> >> (I<Optional>, C<:memory:>)
215              
216             The default is B<C<:memory:>> which will create a temporary in-memory database.
217             One can also pass a file name for a database on disk. See
218             L<MyDBD_connection_parameters|/implementation-of-mydbd_connection_parameters>.
219              
220              
221             =item B<< I<C<pre_deploy_hook>> => C<$pre_deploy_hook> >> (I<Optional>)
222              
223             This is an optional C<CodeRef> that will be executed right after the connection
224             is established but before C<< $schema->deploy >> is called. The CodeRef will
225             only be called if deploy is also needed. See
226             L<MyDBD_check_wants_deploy|/implementation-of-mydbd_check_wants_deploy>.
227              
228              
229             =item B<< I<C<post_connect_hook>> => C<$post_connect_hook> >> (I<Optional>)
230              
231             This is an optional C<CodeRef> that will be executed right after deploy (if any)
232             and just before returning the schema instance. Useful for populating the
233             database.
234              
235             =back
236              
237             =head3 Returns
238              
239             An initialised instance of C<Test::DBIC::SQLite>.
240              
241             =head2 C<< $td->connect_dbic_ok >>
242              
243             This method is inherited from L<Test::DBIC::DBDConnector>.
244              
245             =head3 Returns
246              
247             An initialised instance of C<$schema_class>.
248              
249             =head2 C<< $td->drop_dbic_ok >>
250              
251             This method implements C<< rm $dbname >>, in order not to litter your test
252             directory with left over test databases.
253              
254             B<NOTE>: Make sure you called C<< $schema->storage->disconnect() >> first.
255              
256             B<NOTE>: If the test-object goes out of scope without calling C<<
257             $td->drop_dbic_ok() >>, the destructor will try to remove the file. Use
258             C<$Test::DBIC::SQLite::LeaveCreatedDatabases = 1> to keep the file for
259             debugging.
260              
261             =head2 C<connect_dbic_sqlite_ok(@parameters)>
262              
263             Create a SQLite3 database and deploy a dbic_schema. This function is provided
264             for compatibility with C<v0.01> of this module.
265              
266             See L<< Test::DBIC::SQLite->new|/Test::DBIC::SQLite->new >> for further information,
267             although only these 3 arguments are supported.
268              
269             =head3 Parameters
270              
271             Positional:
272              
273             =over
274              
275             =item 1. B<< C<$schema_class> >> (I<Required>)
276              
277             The class name of the L<DBIx::Class::Schema> to use for the database connection.
278              
279             =item 2. B<< C<$sqlite_dbname> >> (I<Optional>, C<:memory:>)
280              
281             The default is B<C<:memory:>> which will create a temporary in-memory database.
282             One can also pass a file name for a database on disk. See L<MyDBD_connection_parameters|/implementation-of-mydbd_connection_parameters>.
283              
284             =item 3. B<< C<$post_connect_hook> >> (I<Optional>)
285              
286             This is an optional C<CodeRef> that will be executed right after deploy (if any)
287             and just before returning the schema instance. Useful for populating the
288             database.
289              
290             =back
291              
292             =head3 Returns
293              
294             An initialised instance of C<$schema_class>.
295              
296             =head2 C<drop_dbic_sqlite_ok()>
297              
298             This function uses the cached information of the call to C<connect_dbic_sqlite_ok()>
299             and clears it after the database is dropped, using another temporary connection
300             to the template database.
301              
302             See L<the C<drop_dbic_ok()> method|/"-td-drop_dbic_ok">.
303              
304             =head2 Implementation of C<MyDBD_connection_parameters>
305              
306             The value of the C<dbi_connect_info> parameter to the `new()`
307             constructor, is passed to this method. For this I<SQLite3> implementation this is a
308             single string that should contain the name of the database on disk, that can be
309             accessed with C<sqlite3 (1)>. By default we use the "special" value of
310             B<C<:memory:>> to create a temporary in-memory database.
311              
312             This method returns a list of parameters to be passed to
313             C<< DBIx::Class::Schema->connect() >>. Keep in mind that the last argument
314             (options-hash) will always be augmented with key-value pair: C<< ignore_version => 1 >>.
315              
316             =head3 Note
317              
318             At this moment we do not support the C<uri=file:$db_file_name?mode=rwc> style of
319             I<dsn>, only the C<dbname=$db_file_name> style, as we only support
320             C<$sqlite_dbname> as a single parameter.
321              
322              
323             =head2 Implementation of C<MyDBD_check_wants_deploy>
324              
325             For in-memory databases this will always return B<true>. For databases on disk
326             this will return B<true> if the file does not exist and B<false> if it does.
327              
328             =begin devel_cover_pod
329              
330             =head2 DEMOLISH
331              
332             Remove created database files when the object goes out of scope.
333              
334             =end devel_cover_pod
335              
336             =head1 AUTHOR
337              
338             E<copy> MMXV-MMXXI - Abe Timmerman <abeltje@cpan.org>
339              
340             =head1 LICENSE
341              
342             This program is free software; you can redistribute it and/or modify
343             it under the same terms as Perl itself.
344              
345             This program is distributed in the hope that it will be useful,
346             but WITHOUT ANY WARRANTY; without even the implied warranty of
347             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
348              
349             =cut