File Coverage

blib/lib/Class/DBI/MockDBD.pm
Criterion Covered Total %
statement 72 87 82.7
branch 12 26 46.1
condition 1 6 16.6
subroutine 10 12 83.3
pod 5 5 100.0
total 100 136 73.5


line stmt bran cond sub pod time code
1             package Class::DBI::MockDBD;
2 2     2   109144 use strict;
  2         5  
  2         72  
3 2     2   11 use warnings;
  2         5  
  2         74  
4              
5             =head1 NAME
6              
7             Class::DBI::MockDBD - Mocked database interface for Class::DBI
8              
9             =head1 SYNOPSIS
10              
11             use base qw(Class::DBI::MockDBD);
12              
13             or
14              
15             # probably nicer ways to do this .. but classes won't need a single line of code changed (with any luck)
16              
17             use ClassName;
18              
19             unshift(@ClassName::ISA,'Class::DBI::MockDBD');
20              
21             # set up result
22              
23             ClassName->next_result([ [qw/foo_id foo_name foo_bar/],[1,'aaaa','bbbb',]...]);
24              
25             # run query
26              
27             my $iterator = ClassName->search(...);
28              
29             # get sql and params for query
30              
31             my $sql = ClassName->last_query_info('statement');
32              
33             my $params = ClassName->last_query_info('params');
34              
35             =head1 DESCRIPTION
36              
37             A Class::DBI subclass allowing you to 'Mock' a database for testing
38             and/or debugging purposes, using DBD::Mock, via some additional
39             API methods.
40              
41             =cut
42              
43              
44 2     2   12 use Carp;
  2         6  
  2         204  
45             # use Data::Dumper;
46              
47 2     2   11868 use overload ('bool' => sub { return 1; } );
  2     0   1265  
  2         26  
  0         0  
48 2     2   148 use base qw(Class::DBI Class::Data::Inheritable);
  2         4  
  2         2848  
49              
50             __PACKAGE__->mk_classdata('mocked_params');
51             __PACKAGE__->mk_classdata('mocked_statement');
52             __PACKAGE__->mk_classdata('mocked_statement_handle');
53              
54             __PACKAGE__->connection('dbi:Mock:', '', '', {});
55              
56             our $VERSION = '0.03';
57              
58             =head1 METHODS
59              
60             Calling a method that touches the database without specifying the results with next_result or
61             next_result_session method first will result in a fatal error.
62              
63             =head2 next_result
64              
65             This class method prepares the set of results to be provided to the next query made
66             to the mocked database.
67              
68             # set up result before calling method that will interact with mocked database
69              
70             ClassName->next_result([ [qw/foo_id foo_name foo_bar/],[1,'aaaa','bbbb',]...]);
71              
72             ClassName->search(foo_bar => 'bbbb');
73              
74             =head2 next_result_session
75              
76             ClassName->next_result_session([
77             { statement => 'select * from tablename where field = ?', results => [ .. ], bound_params => [ 10, qr/\d+/ ], },
78             { statement => 'select * from tablename where field = ?', results => [ .. ], bound_params => [ 10, qr/\d+/ ], },
79             { statement => 'select * from tablename where field = ?', results => [ .. ], bound_params => [ 10, qr/\d+/ ], },
80             ]);
81              
82             ClassName->search(foo_bar => 'bbbb');
83              
84             =head2 last_query_info
85              
86             This class method provides the statement and params of the last query to the mocked database.
87              
88             my $sql = ClassName->last_query_info('statement');
89              
90             my $params = ClassName->last_query_info('params');
91              
92             It takes an argument specifying what information you want back : 'params' or 'statement'.
93              
94             Query parameters are returned as an arrayref, SQL statement is returned as a string.
95              
96             =cut
97              
98             sub next_result {
99 3     3 1 5517 my ($class,$result) = @_;
100 3         19 $class->db_Main->{mock_add_resultset} = $result;
101 3         21306 $class->mocked_statement_handle(undef);
102 3         99 return;
103             };
104              
105             sub next_result_session {
106 1     1 1 888 my ($class,$results) = @_;
107 1         12 my $session = DBD::Mock::Session->new('next_result_session' => (@$results) );
108 1         86 $class->db_Main->{mock_session} = $session;
109 1         49 $class->mocked_statement_handle(undef);
110 1         15 return;
111             }
112              
113             sub last_query_info {
114 0     0 1 0 my ($class,$type) = @_;
115 0         0 my $return;
116              
117 0 0       0 if ($type eq 'params') {
    0          
118 0         0 my $sth = $class->mocked_statement_handle();
119 0 0 0     0 croak("Class::DBI::MockDBD -- last_query_info can't be called with params without executing query") unless ($sth && ($sth->{mock_is_executed} eq 'yes'));
120 0         0 $return = $class->mocked_params;
121             } elsif ($type eq 'statement') {
122 0         0 $return = $class->mocked_statement;
123             } else {
124 0         0 carp "Class::DBI::MockDBD -- $type not recognised as argument to last_query_info";
125             }
126              
127 0         0 return $return;
128             }
129              
130             =head1 METHODS OVER-RIDDEN/REDEFINED
131              
132             MockDBD over-rides and/or redefines the following class and object methods :
133              
134             =over 4
135              
136             =item * sth_to_objects : Class method over-rides that inherited from Class::DBI
137              
138             =item * update : Class method over-rides that inherited from Class::DBI
139              
140             =item * _insert_row : Class method over-rides that inherited from Class::DBI
141              
142             =back
143              
144             =cut
145              
146              
147             sub sth_to_objects {
148 3     3 1 3347 my ($class,$sth,$args) = (shift,@_);
149              
150             # check arguments and state of handles
151 3 50       14 croak("Class::DBI::MockDBD -- sth_to_objects needs a statement handle") unless ($sth);
152 3 50       19 carp("Class::DBI::MockDBD -- no records to instantiate into objects - did you set results via next_result?") unless ($sth->{mock_num_records});
153              
154             # handle Ima::DBI sql_foo methods
155 3 50       103 unless (UNIVERSAL::isa($sth => "DBI::st")) {
156 0         0 my $meth = "sql_$sth";
157 0         0 $sth = $class->$meth();
158             }
159              
160 3         7 my $rows = [];
161 3 100       7 eval { $sth->execute(@$args) unless $sth->{Active};
  3         15  
162             # set last statement handle to check state in other methods later
163 2         261 $class->mocked_statement_handle($sth);
164              
165             # set mock::dbd info
166 2         26 $class->mocked_params($sth->{mock_params});
167 2         93 $class->mocked_statement($sth->{mock_statement});
168              
169 2         90 while (my $data = $sth->fetchrow_hashref()) {
170 4         279 push (@$rows, $data);
171             }
172             };
173              
174 3 100       344 return $class->_croak("Class::DBI::MockDBD -- $class can't $sth->{Statement}: $@", err => $@)
175             if $@;
176 2         17 return $class->_ids_to_objects($rows);
177             }
178              
179             sub _insert_row {
180 1     1   1116 my $self = shift;
181 1         2 my $class = ref($self);
182 1         2 my $data = shift;
183 1         2 eval {
184 1         5 my @columns = keys %$data;
185 1         7 my $sth = $self->sql_MakeNewObj(
186             join(', ', @columns),
187             join(', ', map $self->_column_placeholder($_), @columns),
188             );
189 1         323 $self->_bind_param($sth, \@columns);
190 1         23 $sth->execute(values %$data);
191              
192             # set last statement handle to check state in other methods later
193 1         173 $class->mocked_statement_handle($sth);
194              
195             # set mock::dbd info
196 1         20 $class->mocked_params($sth->{mock_params});
197 1         35 $class->mocked_statement($sth->{mock_statement});
198              
199 1         31 my @primary_columns = $self->primary_columns;
200 1 50 33     27 $data->{ $primary_columns[0] } = $self->_auto_increment_value
201             if @primary_columns == 1
202             && !defined $data->{ $primary_columns[0] };
203             };
204 1 50       18 if ($@) {
205 0         0 my $class = ref $self;
206 0         0 return $self->_db_error(
207             msg => "Can't insert new $class: $@",
208             err => $@,
209             method => 'insert'
210             );
211             }
212 1         10 return 1;
213             }
214              
215              
216             sub update {
217 1     1 1 8 my $self = shift;
218 1 50       5 my $class = ref($self)
219             or return $self->_croak("Class::DBI::MockDBD -- Can't call update as a class method");
220              
221 1         5 $self->call_trigger('before_update');
222 1 50       126 return -1 unless my @changed_cols = $self->is_changed;
223 1         57 $self->call_trigger('deflate_for_update');
224 1         124 my @primary_columns = $self->primary_columns;
225 1         26 my $sth = $self->sql_update($self->_update_line);
226              
227             # set last statement handle to check state in other methods later
228 1         434 $class->mocked_statement_handle($sth);
229              
230 1         14 $class->_bind_param($sth, \@changed_cols);
231 1         20 my $rows = eval { $sth->execute($self->_update_vals, $self->id); };
  1         9  
232              
233             # set mock::dbd info
234 1         274 $class->mocked_params($sth->{mock_params});
235 1         35 $class->mocked_statement($sth->{mock_statement});
236              
237              
238 1 50       33 if ($@) {
239 0         0 return $self->_db_error(
240             msg => "Can't update $self: $@",
241             err => $@,
242             method => 'update'
243             );
244             }
245              
246             # enable this once new fixed DBD::SQLite is released:
247 1         1 if (0 and $rows != 1) { # should always only update one row
248             $self->_croak("Can't update $self: row not found") if $rows == 0;
249             $self->_croak("Can't update $self: updated more than one row");
250             }
251              
252 1         13 $self->call_trigger('after_update', discard_columns => \@changed_cols);
253              
254             # delete columns that changed (in case adding to DB modifies them again)
255 1         132 $self->_attribute_delete(@changed_cols);
256 1         8 delete $self->{__Changed};
257 1         5 return 1;
258             }
259              
260              
261             ##############################################################################
262              
263             1;
264              
265             __END__