File Coverage

blib/lib/Connector/Proxy/DBI.pm
Criterion Covered Total %
statement 98 118 83.0
branch 18 30 60.0
condition 12 20 60.0
subroutine 12 14 85.7
pod 6 6 100.0
total 146 188 77.6


line stmt bran cond sub pod time code
1             # Connector::Proxy::DBI
2             #
3             # Proxy class for fetching a value from using DBI
4             #
5             # Written by Oliver Welter and Martin Bartosch for the OpenXPKI project 2013
6              
7             package Connector::Proxy::DBI;
8              
9 1     1   194879 use strict;
  1         12  
  1         30  
10 1     1   13 use warnings;
  1         1  
  1         30  
11 1     1   5 use English;
  1         2  
  1         11  
12 1     1   440 use DBI;
  1         3  
  1         40  
13 1     1   636 use Data::Dumper;
  1         7065  
  1         64  
14              
15 1     1   565 use Moose;
  1         467659  
  1         6  
16             extends 'Connector::Proxy';
17              
18              
19             has dbuser => (
20             is => 'rw',
21             isa => 'Str',
22             );
23              
24             has password => (
25             is => 'rw',
26             isa => 'Str',
27             );
28              
29             has table => (
30             is => 'rw',
31             isa => 'Str',
32             );
33              
34             has column => (
35             is => 'rw',
36             isa => 'Str|HashRef',
37             );
38              
39             has condition => (
40             is => 'rw',
41             isa => 'Str',
42             );
43              
44             has ambiguous => (
45             is => 'rw',
46             isa => 'Str',
47             default => 'empty',
48             );
49              
50             has _dbi => (
51             is => 'ro',
52             isa => 'Object',
53             lazy => 1,
54             builder => '_dbi_handle'
55             );
56              
57              
58             sub _dbi_handle {
59              
60 3     3   7 my $self = shift;
61              
62 3         94 my $dsn = $self->LOCATION();
63              
64 3         7 my $dbh;
65 3         6 eval {
66 3         97 $dbh = DBI->connect($dsn, $self->dbuser(), $self->password(),
67             { RaiseError => 1, LongReadLen => 1024 });
68             };
69              
70 3 50 33     1791 if ($EVAL_ERROR || !$dbh) {
71 0         0 $self->log()->error('DBI connect failed. DSN: '.$dsn. ' - Error: ' . $EVAL_ERROR );
72 0         0 die "DBI connect failed."
73             }
74 3         125 return $dbh;
75              
76             }
77              
78             sub get {
79              
80 5     5 1 40 my $self = shift;
81 5         69 my @path = $self->_build_path( shift );
82              
83 5         189 my $column = $self->column();
84 5 50 33     37 if (!$column || ref $column ne '') {
85 0         0 die "column must be a singe column name when using get";
86             }
87              
88 5         161 my $query = sprintf "SELECT %s FROM %s WHERE %s",
89             $column, $self->table(), $self->condition();
90              
91 5         135 $self->log()->debug('Query is ' . $query);
92              
93 5         187 my $sth = $self->_dbi()->prepare($query);
94 5         1284 $sth->execute( @path );
95              
96 5         96 my $row = $sth->fetchrow_arrayref();
97              
98 5         195 $self->log()->trace('result is ' . Dumper $row );
99              
100 5         388 my $result;
101 5 50 100     189 if (!$row) {
    100          
102 0         0 return $self->_node_not_exists( @path );
103              
104             } elsif (($self->ambiguous() ne 'return') && $sth->fetchrow_arrayref()) {
105              
106 2         59 $self->log()->error('Ambiguous (multi-valued) result');
107 2 100       1027 if ($self->ambiguous() eq 'die') {
108 1         37 die "Ambiguous (multi-valued) result";
109             }
110 1         12 return $self->_node_not_exists( @path );
111              
112             }
113              
114 3   50     91 $self->log()->debug('Valid return: ' . ($row->[0] // '<undef>'));
115 3         82 return $row->[0];
116              
117             }
118              
119             sub get_hash {
120              
121 6     6 1 41 my $self = shift;
122 6         20 my @path = $self->_build_path( shift );
123              
124 6         179 my $column = $self->column();
125 6 50 66     28 if ($column && ref $column ne 'HASH') {
126 0         0 die "column must be a hashref or empty when using get_hash";
127             }
128              
129 6         15 my $columns = '*';
130 6 100       16 if (ref $column eq 'HASH') {
131 1         2 my @cols;
132             map {
133 3         12 push @cols, sprintf( "%s as %s", $column->{$_}, $_ );
134 1         3 } keys %{$column};
  1         5  
135 1         4 $columns = join(",", @cols);
136             }
137              
138 6         158 my $query = sprintf "SELECT %s FROM %s WHERE %s",
139             $columns, $self->table(), $self->condition();
140              
141 6         143 $self->log()->debug('Query is ' . $query);
142              
143 6         193 my $sth = $self->_dbi()->prepare($query);
144 6         885 $sth->execute( @path );
145              
146 6         168 my $row = $sth->fetchrow_hashref();
147              
148 6         199 $self->log()->trace('result is ' . Dumper $row );
149              
150 6 100 100     561 if (!$row) {
    100          
151 1         6 return $self->_node_not_exists( @path );
152              
153             } elsif (($self->ambiguous() ne 'return') && $sth->fetchrow_hashref()) {
154              
155 1         32 $self->log()->error('Ambiguous (multi-valued) result');
156 1 50       359 if ($self->ambiguous() eq 'die') {
157 1         13 die "Ambiguous (multi-valued) result";
158             }
159 0         0 return $self->_node_not_exists( @path );
160             }
161              
162 4         95 $self->log()->debug('Valid return: ' . Dumper $row);
163 4         293 return $row;
164              
165             }
166              
167              
168             sub get_list {
169              
170 1     1 1 3 my $self = shift;
171 1         6 my @path = $self->_build_path( shift );
172              
173              
174 1         38 my $column = $self->column();
175 1 50 33     10 if (!$column || ref $column ne '') {
176 0         0 die "column must be a singe column name when using get_list";
177             }
178              
179 1         28 my $query = sprintf "SELECT %s FROM %s WHERE %s",
180             $self->column(), $self->table(), $self->condition();
181              
182 1         34 $self->log()->debug('Query is ' . $query);
183              
184 1         34 my $sth = $self->_dbi()->prepare($query);
185 1         165 $sth->execute( @path );
186              
187 1         31 my $rows = $sth->fetchall_arrayref();
188              
189             # hmpf
190 1 50       9 unless (ref $rows eq 'ARRAY') {
191 0         0 $self->log()->error('DBI did not return an arrayref');
192 0         0 die "DBI did not return an arrayref.";
193             }
194              
195 1 50       3 if (scalar @{$rows} == 0) {
  1         5  
196 0         0 return $self->_node_not_exists( @path );
197             }
198 1         3 my @result;
199 1         2 foreach my $row (@{$rows}) {
  1         3  
200 1         4 push @result, $row->[0];
201             }
202              
203 1         33 $self->log()->trace('result ' . Dumper \@result);
204              
205 1         92 $self->log()->debug('Valid return, '. scalar @result .' lines');
206 1         23 return @result;
207              
208             }
209              
210             sub get_size {
211              
212 2     2 1 6 my $self = shift;
213 2         8 my @path = $self->_build_path( shift );
214              
215 2         84 my $query = sprintf "SELECT COUNT(*) as count FROM %s WHERE %s",
216             $self->table(), $self->condition();
217              
218 2         44 $self->log()->debug('Query is ' . $query);
219              
220 2         61 my $sth = $self->_dbi()->prepare($query);
221 2         327 $sth->execute( @path );
222              
223 2         41 my $row = $sth->fetchrow_arrayref();
224              
225 2         70 $self->log()->trace('Result is ' . Dumper $row);
226              
227 2         181 return $row->[0];
228              
229             }
230              
231             sub get_meta {
232              
233 0     0 1   my $self = shift;
234              
235             # If we have no path, we tell the caller that we are a connector
236 0           my @path = $self->_build_path( shift );
237 0 0         if (scalar @path == 0) {
238 0           return { TYPE => "connector" };
239             }
240              
241             # can be used as scalar also but list will be fine in any case
242 0           return { TYPE => 'list' };
243             }
244              
245              
246             # Will not catch get with an ambigous result :(
247             sub exists {
248              
249 0     0 1   my $self = shift;
250              
251             # No path = connector root which always exists
252 0           my @path = $self->_build_path( shift );
253 0 0         if (scalar @path == 0) {
254 0           return 1;
255             }
256              
257 0           return $self->get_size( \@path ) > 0;
258              
259             }
260              
261 1     1   9184 no Moose;
  1         3  
  1         6  
262             __PACKAGE__->meta->make_immutable;
263              
264             1;
265             __END__
266              
267              
268             =head1 Name
269              
270             Connector::Proxy::DBI
271              
272             =head1 Description
273              
274             Use DBI to make a query to a database.
275              
276             =head1 Usage
277              
278             =head2 Configuration
279              
280             my $con = Connector::Proxy::DBI->new({
281             LOCATION => 'DBI:mysql:database=openxpki;host=localhost',
282             dbuser => 'queryuser',
283             password => 'verysecret',
284             table => 'mytable',
285             column => 1,
286             condition => 'id = ?',
287             ambiguous => 'die',
288             });
289              
290             =head2 Parameters
291              
292             =over
293              
294             =item dbuser
295              
296             =item password
297              
298             =item table
299              
300             The name of the table, can also be a JOIN clause (if supported by the driver).
301              
302             =item column
303              
304             For get/get_list the name of a single column to be returned.
305              
306             For get_hash a hash where the keys are the target keys of the resulting
307             hash and the values are the column names.
308              
309             =item condition
310              
311             The condition using a question mark as placeholder. The placeholder(s) are
312             fed from the path components.
313              
314             =item ambigous
315              
316             Controls the behaviour of the connector if more than one result is found
317             when a single one is expected (get/get_hash).
318              
319             =over
320              
321             =item empty (default)
322              
323             Return an empty result, will also die if I<die_on_undef> is set.
324              
325             =item return
326              
327             The potential ambiguity is ignored and the first row fetched is returned.
328             Note that depending on the database backend the actual result returned from
329             the is very likely undetermined.
330              
331             =item die
332              
333             Die with an error message.
334              
335             =back
336              
337             =back
338              
339             =head1 Methods
340              
341             =head2 get
342              
343             Will return the value of the requested column of the matching row. If no row
344             is found, undef is returned (dies if die_on_undef is set). B<Note:> You will
345             also get undef if the row exists but the requested column has a NULL value.
346              
347             If multiple rows are found, behaviour depends on the value of I<ambiguous>.
348              
349             =head2 get_list
350              
351             Will return the selected column of all matching lines as a list. If no match is
352             found undef is returned (dies if die_on_undef is set).
353              
354             =head2 get_meta
355              
356             Will return scalar if the query has one result or list if the query has
357             multiple rows. Returns undef if no rows are found.
358              
359             =head2 get_hash
360              
361             Return a single row as hashref, by default all columns are returned as
362             retrieved from the database. Pass a hashref to I<column>, where the key
363             is the target key and the value is the name of the column you need.
364              
365             E.g. when your table has the columns id and name but you need the keys
366             index and title in your result.
367              
368             $con->column({ 'id' => 'id', '`index`' => 'id', 'title' => 'name' });
369              
370             Note: The mapping is set directly on the sql layer and as escaping
371             reserved words is not standardized, we dont do it. You can add escape
372             characters yourself to the column map where required, as shown for the
373             word "index" in the given example.
374              
375             =head2 get_keys
376              
377             not supported
378              
379