File Coverage

blib/lib/SimpleMock/Model/DBI.pm
Criterion Covered Total %
statement 60 60 100.0
branch 11 12 91.6
condition 12 13 92.3
subroutine 10 10 100.0
pod 0 1 0.0
total 93 96 96.8


line stmt bran cond sub pod time code
1             package SimpleMock::Model::DBI;
2 5     5   30 use strict;
  5         16  
  5         163  
3 5     5   15 use warnings;
  5         5  
  5         217  
4 5     5   17 use DBI;
  5         5  
  5         277  
5 5     5   18 use Storable qw(dclone);
  5         6  
  5         357  
6 5     5   17 use Data::Dumper;
  5         26  
  5         249  
7              
8 5         3252 use SimpleMock::Util qw(
9             generate_args_sha
10 5     5   16 );
  5         4  
11              
12             our $VERSION = '0.05';
13              
14             our $drh = DBI->install_driver('SimpleMock');
15              
16             our @valid_global_meta_keys = (
17             # 0|1 allow queries that are not mocked to run with a default empty result set
18             'allow_unmocked_queries',
19              
20             # 0|1 if true, then $dbh->connect returns undef (use for error checking tests)
21             'connect_fail',
22              
23             # 0|1 if true, then $dbh->prepare fails with invalid SQL error
24             'prepare_fail',
25              
26             # 0|1 if true, then $sth->execute returns undef (use for error checking tests)
27             'execute_fail',
28             );
29              
30             our %valid_global_meta_keys_lookup;
31             undef @valid_global_meta_keys_lookup{ @valid_global_meta_keys };
32              
33             # lowercase and remove double spaces - I know some DBs are case sensitive, but
34             # this can simplify catching typos in tests
35             sub _normalize_sql {
36 22     22   34 my ($sql) = @_;
37 22         37 $sql = lc($sql);
38 22         157 $sql =~ s/\s+/ /g;
39 22         131 $sql =~ s/^ | $//g;
40 22         35 return $sql;
41             }
42              
43             sub validate_mocks {
44 11     11 0 34 my $mocks_data = shift;
45              
46 11         16 my $new_mocks = {};
47              
48 11   100     71 my $meta = $mocks_data->{META} || {};
49             # only one option initially, but add more as needed
50 11         25 META: foreach my $key (keys %$meta) {
51 5 100       18 die "unknown meta key: $key" unless exists $valid_global_meta_keys_lookup{$key};
52 4         11 $new_mocks->{DBI}->{_meta}->{$key} = $meta->{$key};
53             }
54              
55 10   100     28 my $queries = $mocks_data->{QUERIES} || [];
56              
57 10         13 QUERY: foreach my $query (@$queries) {
58 7         15 my $normalized_sql = _normalize_sql($query->{sql});
59 7   100     21 my $cols = $query->{cols} || [];
60 7 100       7 RESULT: foreach my $result (@{$query->{results} || [{ data => [[]] }]}) {
  7         24  
61 10   50     24 my $data = $result->{data} || [[]];
62 10         30 my $sha = generate_args_sha($result->{args});
63             my $mock = {
64             data => $data,
65             cols => $cols,
66 10   100     259 args => $result->{args} || [],
67             };
68 10         677 $new_mocks->{DBI}->{$normalized_sql}->{$sha} = dclone($mock);
69             }
70             }
71 10         28 return $new_mocks;
72             }
73              
74             sub _get_dbi_meta {
75 44     44   72 my $key = shift;
76 44         85 for my $layer (reverse @SimpleMock::MOCK_STACK) {
77             return $layer->{DBI}{_meta}{$key}
78 49 100       114 if exists $layer->{DBI}{_meta}{$key};
79             }
80 40         77 return undef;
81             }
82              
83             sub _get_mock_for {
84 15     15   21 my ($sql, $args) = @_;
85 15         20 my $normalized = _normalize_sql($sql);
86 15         38 my $sha = generate_args_sha($args);
87              
88 15         765 for my $layer (reverse @SimpleMock::MOCK_STACK) {
89 16 50       36 my $dbi = $layer->{DBI} or next;
90 16   100     48 my $mock = $dbi->{$normalized}{$sha} || $dbi->{$normalized}{'_default'};
91 16 100       531 return dclone($mock) if $mock;
92             }
93              
94             # allow_unmocked_queries can be set in any layer
95 2         3 for my $layer (reverse @SimpleMock::MOCK_STACK) {
96 2 100       88 return dclone({ data => [[]] }) if $layer->{DBI}{_meta}{allow_unmocked_queries};
97             }
98              
99             # something isn't right, so provide a dump of all the (hopefully!) useful info
100 1         1 my %DBI_MOCKS;
101 1         2 for my $layer (@SimpleMock::MOCK_STACK) {
102 1         1 foreach my $key (keys %{ $layer->{DBI} }) {
  1         3  
103 5         7 $DBI_MOCKS{$key} = $layer->{DBI}->{$key}
104             }
105             }
106 1         1 local $Data::Dumper::Indent = 1;
107 1         4 die "No mock data found:". Dumper({ normalized_query => $normalized, args => $args, sha => $sha, dbi_mocks => \%DBI_MOCKS });
108             }
109              
110             1;
111              
112             =head1 NAME
113              
114             SimpleMock::Model::DBI - A mock model for DBI queries
115              
116             =head1 DESCRIPTION
117              
118             This module provides a mock model for DBI queries, allowing you to register
119             mock queries and their results. It normalizes queries and handles argument-based mocking.
120              
121             Metadata can be set to control behavior such as allowing unmocked queries, or to force
122             failure on certain operations like `prepare`, `execute` or `connect`.
123              
124             =head1 USAGE
125              
126             You probably won't want to use this module directly, but rather use the SimpleMock
127             module in your tests instead:
128              
129             use SimpleMock qw(register_mocks);
130              
131             register_mocks(
132             DBI => {
133             # all meta values default to false if not explicitly set
134             META => {
135             # 0|1 allow queries that are not mocked to run with a default empty result set
136             'allow_unmocked_queries' => 1,
137              
138             # 0|1 if true, then $dbh->connect returns undef (use for error checking tests)
139             'connect_fail' => 0,
140              
141             # 0|1 if true, then $dbh->prepare fails with invalid SQL error
142             'prepare_fail' => 0,
143            
144             # 0|1 if true, then $sth->execute returns undef (use for error checking tests)
145             'execute_fail' => 0,
146             },
147             # QUERIES is an array of individual sql statements and what to return when executed
148             # with specific args
149             QUERIES => [
150             {
151             sql => 'SELECT name, email FROM users WHERE id = ?',
152             results => [
153              
154             # specific result data for arg sent
155             { args => [1],
156             data => [ ['Alice', 'alice@example.com'] ] },
157              
158             # specific result data for arg sent
159             { args => [2],
160             data => [ ['Bob', 'bob@example.com'] ] },
161              
162             # result data for all other args
163             { data => [ ['Default', 'default@example.com'] ] },
164              
165             ],
166             },
167             ],
168             },
169             );
170              
171             For each query, specify the SQL statement. Then, in the results array, provide the
172             placeholder args and data to return for each, and an optional default result that only
173             has a data element to use as a default for query executions where there is no args match
174              
175             =cut