File Coverage

blib/lib/DBIx/Foo/SimpleQuery.pm
Criterion Covered Total %
statement 40 69 57.9
branch 12 26 46.1
condition 3 6 50.0
subroutine 8 13 61.5
pod 0 10 0.0
total 63 124 50.8


line stmt bran cond sub pod time code
1             package DBIx::Foo::SimpleQuery;
2              
3 4     4   25 use strict;
  4         10  
  4         201  
4              
5 4     4   4131 use Log::Any qw($log);
  4         13377  
  4         20  
6              
7 4     4   385 use Exporter;
  4         8  
  4         5903  
8              
9             our @ISA = qw(Exporter);
10             our @EXPORT = qw(selectrow selectrow_array selectrow_hashref selectall selectall_arrayref selectall_hashref dbh_do);
11              
12             our $VERSION = '0.01';
13              
14              
15             sub selectrow
16             {
17 0     0 0 0 my ($self, $sql, $opts, @args) = @_;
18              
19 0 0       0 nice_params(\$opts, \@args) if scalar @_ > 2;
20              
21 0         0 my $row = $self->dbh->selectrow_hashref($sql, $opts, @args);
22              
23 0         0 log_query($self->dbh, $sql, \@args);
24              
25 0         0 return $row;
26             }
27              
28             sub selectrow_hashref
29             {
30 0     0 0 0 my ($self, $sql, $opts, @args) = @_;
31              
32 0 0       0 nice_params(\$opts, \@args) if scalar @_ > 2;
33              
34 0         0 my $row = $self->dbh->selectrow_hashref($sql, $opts, @args);
35              
36 0         0 log_query($self->dbh, $sql, \@args);
37              
38 0         0 return $row;
39             }
40              
41             sub selectrow_array
42             {
43 2     2 0 7 my ($self, $sql, $opts, @args) = @_;
44              
45 2 50       9 nice_params(\$opts, \@args) if scalar @_ > 2;
46              
47 2         12 my @row = $self->dbh->selectrow_array($sql, $opts, @args);
48              
49 2         253 log_query($self->dbh, $sql, \@args);
50              
51 2 50       15 return $row[0] if scalar @row == 1; # for compatibility
52              
53 2         12 return @row;
54             }
55              
56             sub selectall
57             {
58 0     0 0 0 my ($self, $sql, @args) = @_;
59              
60 0         0 my $opts = { Slice => {} };
61              
62 0         0 my $rows = $self->dbh->selectall_arrayref($sql, $opts, @args);
63              
64 0         0 log_query($self->dbh, $sql, \@args);
65              
66 0         0 return $rows;
67             }
68              
69             sub selectall_arrayref
70             {
71 3     3 0 11 my ($self, $sql, $opts, @args) = @_;
72              
73 3 50       12 nice_params(\$opts, \@args) if scalar @_ > 2;
74              
75 3         13 my $rows = $self->dbh->selectall_arrayref($sql, $opts, @args);
76              
77 3         364 log_query($self->dbh, $sql, \@args);
78              
79 3         17 return $rows;
80             }
81              
82             sub selectall_hashref
83             {
84 0     0 0 0 my ($self, $sql, $key_field, $opts, @args) = @_;
85              
86 0 0       0 nice_params(\$opts, \@args) if scalar @_ > 3;
87              
88 0         0 my $rows = $self->dbh->selectall_hashref($sql, $key_field, $opts, @args);
89              
90 0         0 log_query($self->dbh, $sql, \@args);
91              
92 0         0 return $rows;
93             }
94              
95             sub dbh_do
96             {
97 24     24 0 78 my ($self, $sql, $opts, @args) = @_;
98              
99 24 100       140 nice_params(\$opts, \@args) if scalar @_ > 2;
100              
101             # MSSQL insert requires extra SCOPE_IDENTITY() call to give inserted value - current best solution MT (only way I can make it work...)
102 24 50 33     212 if ($self->dbh->get_info(17) eq 'Microsoft SQL Server' && $sql =~ /^insert/i) {
103              
104 0         0 return mssql_insert($self->dbh, $sql, $opts, @args);
105             }
106              
107 24         335 my $result = $self->dbh->do($sql, $opts, @args);
108              
109 23         702918 log_query($self->dbh, $sql, \@args);
110              
111 23 100 66     420 if ($result && $sql =~ /^insert into (\w+)/i) {
112              
113 19 50       98 if (my $newid = $self->dbh->last_insert_id(undef, undef, $1, undef)) {
114              
115 19         102 $log->debug("Got insertid : $newid");
116              
117 19         161 return $newid;
118             }
119             else {
120 0         0 return 1; # insert ok, but no insertid (not an auto inc)
121             }
122             }
123             else {
124              
125 4         30 return $result;
126             }
127             }
128              
129             sub mssql_insert
130             {
131 0     0 0 0 my ($dbh, $sql, $opts, @args) = @_;
132              
133 0 0       0 $sql .= ';' unless $sql =~ /;\s*/;
134 0         0 $sql .= "select SCOPE_IDENTITY();";
135              
136 0         0 my $newid = $dbh->selectrow_array($sql, $opts, @args);
137              
138 0         0 log_query($dbh, $sql, \@args);
139              
140 0         0 return $newid;
141             }
142              
143             sub log_query
144             {
145 28     28 0 89 my ($dbh, $sql, $args) = @_;
146              
147             # use the 'caller' function name to work out context
148 28         236 my $caller = ( caller(2) )[3];
149              
150 28 50       255 if ($dbh->err) {
151              
152 0         0 $log->error($dbh->errstr . " - $sql (" . join(",", @$args) . ") called by $caller");
153              
154             } else {
155              
156 28         426 $log->debug("$sql (" . join(",", @$args) . ") called by $caller");
157             }
158             }
159              
160             sub nice_params
161             {
162 15     15 0 35 my ($opts_ref, $args_ref) = @_;
163              
164 15         32 my $opts = $$opts_ref;
165              
166             #return unless defined $opts;
167              
168 15 100       61 unless (ref($opts) eq 'HASH') { #allow $opts hashref to be omitted
169              
170 12         36 unshift @$args_ref, $opts;
171 12         26 $$opts_ref = {};
172              
173 12         28 $opts_ref = \$opts;
174             }
175             }
176              
177             1;