File Coverage

blib/lib/SQL/Easy.pm
Criterion Covered Total %
statement 12 124 9.6
branch 0 40 0.0
condition 0 6 0.0
subroutine 4 17 23.5
pod 9 9 100.0
total 25 196 12.7


line stmt bran cond sub pod time code
1             package SQL::Easy;
2             {
3             $SQL::Easy::VERSION = '2.0.0';
4             }
5              
6             # ABSTRACT: extremely easy access to sql data
7              
8              
9              
10 1     1   67735 use strict;
  1         1  
  1         33  
11 1     1   4 use warnings;
  1         2  
  1         22  
12              
13 1     1   2380 use DBI;
  1         26149  
  1         130  
14 1     1   13 use Carp;
  1         2  
  1         2745  
15              
16              
17              
18             sub new {
19 0     0 1   my ($class, @params) = @_;
20              
21 0 0         if (ref $params[0] eq 'HASH') {
22 0           croak "Incorrect usage of SQL::Easy->new()."
23             . " Since version 2.0.0 SQL::Easy->new() need to recieve hash, not hashref."
24             ;
25             }
26 0           my %params = @params;
27              
28 0           my $self = {};
29              
30 0           $self->{dbh} = $params{dbh};
31 0   0       $self->{connection_check_threshold} = $params{connection_check_threshold} || 30;
32 0           $self->{count} = 0;
33              
34 0 0         unless ($self->{dbh}) {
35 0   0       $self->{settings} = {
      0        
36             db => $params{database},
37             user => $params{user},
38             password => $params{password},
39             host => $params{host} || '127.0.0.1',
40             port => $params{port} || 3306,
41             };
42              
43 0           $self->{dbh} = _get_connection($self->{settings});
44             };
45              
46 0           $self->{last_connection_check} = time;
47              
48 0 0         if (defined $params{debug}) {
49 0           croak "Incorrect usage of SQL::Easy->new()."
50             . " Since version 2.0.0 SQL::Easy has no 'debug' parameter in new()."
51             ;
52             }
53              
54 0           my $cb_before_execute = delete $params{cb_before_execute};
55 0 0         if (defined $cb_before_execute) {
56 0 0         croak "cb_before_execute should be coderef"
57             if ref($cb_before_execute) ne 'CODE';
58 0           $self->{_cb_before_execute} = $cb_before_execute;
59             }
60              
61 0           bless($self, $class);
62 0           return $self;
63             }
64              
65              
66             sub get_dbh {
67 0     0 1   my ($self) = @_;
68              
69 0           $self->_reconnect_if_needed();
70              
71 0           return $self->{dbh};
72             }
73              
74              
75             sub get_one {
76 0     0 1   my ($self, $sql, @bind_variables) = @_;
77              
78 0           $self->_reconnect_if_needed();
79              
80 0           my $sth = $self->{dbh}->prepare($sql);
81 0           $self->_run_cb_before_execute($sql, @bind_variables);
82 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
83              
84 0           my @row = $sth->fetchrow_array;
85              
86 0           return $row[0];
87             }
88              
89              
90             sub get_row {
91 0     0 1   my ($self, $sql, @bind_variables) = @_;
92              
93 0           $self->_reconnect_if_needed();
94              
95 0           my $sth = $self->{dbh}->prepare($sql);
96 0           $self->_run_cb_before_execute($sql, @bind_variables);
97 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
98              
99 0           my @row = $sth->fetchrow_array;
100              
101 0           return @row;
102             }
103              
104              
105             sub get_col {
106 0     0 1   my ($self, $sql, @bind_variables) = @_;
107 0           my @return;
108              
109 0           $self->_reconnect_if_needed();
110              
111 0           my $sth = $self->{dbh}->prepare($sql);
112 0           $self->_run_cb_before_execute($sql, @bind_variables);
113 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
114              
115 0           while (my @row = $sth->fetchrow_array) {
116 0           push @return, $row[0];
117             }
118              
119 0           return @return;
120             }
121              
122              
123             sub get_data {
124 0     0 1   my ($self, $sql, @bind_variables) = @_;
125 0           my @return;
126              
127 0           $self->_reconnect_if_needed();
128              
129 0           my $sth = $self->{dbh}->prepare($sql);
130 0           $self->_run_cb_before_execute($sql, @bind_variables);
131 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
132              
133 0           my @cols = @{$sth->{NAME}};
  0            
134              
135 0           my @row;
136 0           my $line_counter = 0;
137 0           my $col_counter = 0;
138              
139 0           while (@row = $sth->fetchrow_array) {
140 0           $col_counter = 0;
141 0           foreach(@cols) {
142 0           $return[$line_counter]{$_} = ($row[$col_counter]);
143 0           $col_counter++;
144             }
145 0           $line_counter++;
146             }
147              
148 0           return \@return;
149             }
150              
151              
152             sub get_tsv_data {
153 0     0 1   my ($self, $sql, @bind_variables) = @_;
154 0           my $return;
155              
156 0           $self->_reconnect_if_needed();
157              
158 0           my $sth = $self->{dbh}->prepare($sql);
159 0           $self->_run_cb_before_execute($sql, @bind_variables);
160 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
161              
162 0           $return .= join ("\t", @{$sth->{NAME}}) . "\n";
  0            
163              
164 0           while (my @row = $sth->fetchrow_array) {
165 0           foreach (@row) {
166 0 0         $_ = '' unless defined;
167             }
168 0           $return .= join ("\t", @row) . "\n";
169             }
170              
171 0           return $return;
172             }
173              
174              
175             sub insert {
176 0     0 1   my ($self, $sql, @bind_variables) = @_;
177              
178 0           $self->_reconnect_if_needed();
179              
180 0           my $sth = $self->{dbh}->prepare($sql);
181 0           $self->_run_cb_before_execute($sql, @bind_variables);
182 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
183              
184 0           return $sth->{mysql_insertid};
185             }
186              
187              
188             sub execute {
189 0     0 1   my ($self, $sql, @bind_variables) = @_;
190              
191 0           $self->_reconnect_if_needed();
192              
193 0           my $sth = $self->{dbh}->prepare($sql);
194 0           $self->_run_cb_before_execute($sql, @bind_variables);
195 0 0         $sth->execute(@bind_variables) or croak $self->{dbh}->errstr;
196              
197 0           return 1;
198             }
199              
200              
201             sub _run_cb_before_execute {
202 0     0     my ($self, $sql, @bind_variables) = @_;
203              
204 0 0         if (defined $self->{_cb_before_execute}) {
205 0           $self->{_cb_before_execute}->(
206             sql => $sql,
207             bind_variables => \@bind_variables,
208             );
209             }
210              
211 0           return '';
212             }
213              
214              
215             sub _reconnect_if_needed {
216 0     0     my ($self) = @_;
217              
218 0 0         if (time - $self->{last_connection_check} > $self->{connection_check_threshold}) {
219 0 0         if (_check_connection($self->{dbh})) {
220 0           $self->{last_connection_check} = time;
221             } else {
222 0           $self->{dbh}= _get_connection($self->{settings});
223             }
224             }
225              
226             }
227              
228              
229             sub _get_connection {
230 0     0     my ($self) = @_;
231              
232 0           my $dsn = "DBI:mysql:database=" . $self->{db}
233             . ";host=" . $self->{host}
234             . ";port=" . $self->{port};
235              
236 0 0         my $dbh = DBI->connect(
237             $dsn,
238             $self->{user},
239             $self->{password},
240             {
241             PrintError => 0,
242             RaiseError => 1,
243             mysql_auto_reconnect => 0,
244             mysql_enable_utf8 => 1,
245             },
246             ) or croak "Can't connect to database. Error: " . $DBI::errstr . " . Stopped";
247              
248 0           return $dbh;
249             }
250              
251              
252             sub _check_connection {
253 0     0     my $dbh = shift;
254 0 0         return unless $dbh;
255 0 0         if (my $result = $dbh->ping) {
256 0 0         if (int($result)) {
257             # DB driver itself claims all is OK, trust it:
258 0           return 1;
259             } else {
260             # It was "0 but true", meaning the default DBI ping implementation
261             # Implement our own basic check, by performing a real simple
262             # query.
263 0           my $ok;
264 0           eval {
265 0           $ok = $dbh->do('select 1');
266             };
267 0           return $ok;
268             }
269             } else {
270 0           return;
271             }
272             }
273              
274              
275             1;
276              
277             __END__