File Coverage

blib/lib/PGObject/Simple/Role.pm
Criterion Covered Total %
statement 29 43 67.4
branch 3 12 25.0
condition n/a
subroutine 13 18 72.2
pod 3 3 100.0
total 48 76 63.1


line stmt bran cond sub pod time code
1             package PGObject::Simple::Role;
2              
3 3     3   28422 use 5.010;
  3         12  
4 3     3   17 use strict;
  3         8  
  3         53  
5 3     3   13 use warnings;
  3         8  
  3         77  
6 3     3   401 use Moo::Role;
  3         12621  
  3         17  
7 3     3   1901 use PGObject::Simple ':full', '!dbh';
  3         11092  
  3         499  
8 3     3   44 use Carp;
  3         15  
  3         1866  
9              
10             =head1 NAME
11              
12             PGObject::Simple::Role - Moo/Moose mappers for minimalist PGObject framework
13              
14             =head1 VERSION
15              
16             Version 2.0.2
17              
18             =cut
19              
20             our $VERSION = 2.000002;
21              
22             =head1 SYNOPSIS
23              
24             Take the following (Moose) class:
25              
26             package MyAPP::Foo;
27             use PGObject::Util::DBMethod;
28             use Moose;
29             with 'PGObject::Simple::Role';
30              
31             has id => (is => 'ro', isa => 'Int', required => 0);
32             has foo => (is => 'ro', isa => 'Str', required => 0);
33             has bar => (is => 'ro', isa => 'Str', required => 0);
34             has baz => (is => 'ro', isa => 'Int', required => 0);
35              
36             sub get_dbh {
37             return DBI->connect('dbi:Pg:dbname=foobar');
38             }
39             # PGObject::Util::DBMethod exports this
40             dbmethod int => (funcname => 'foo_to_int');
41              
42             And a stored procedure:
43              
44             CREATE OR REPLACE FUNCTION foo_to_int
45             (in_id int, in_foo text, in_bar text, in_baz int)
46             RETURNS INT LANGUAGE SQL AS
47             $$
48             select char_length($2) + char_length($3) + $1 * $4;
49             $$;
50              
51             Then the following Perl code would work to invoke it:
52              
53             my $foobar = MyApp->foo(id => 3, foo => 'foo', bar => 'baz', baz => 33);
54             $foobar->call_dbmethod(funcname => 'foo_to_int');
55              
56             The following will also work since you have the dbmethod call above:
57              
58             my $int = $foobar->int;
59              
60             The full interface of call_dbmethod and call_procedure from PGObject::Simple are
61             supported, and call_dbmethod is effectively wrapped by dbmethod(), allowing a
62             declarative mapping.
63              
64             =head1 DESCRIPTION
65              
66              
67              
68             =head1 ATTRIBUTES AND LAZY GETTERS
69              
70              
71             =cut
72              
73              
74             has _dbh => ( # use dbh() to get and set_dbh() to set
75             is => 'lazy',
76             isa => sub {
77             croak "Expected a database handle. Got $_[0] instead"
78             unless eval {$_[0]->isa('DBI::db')};
79             },
80             );
81              
82             has _DBH => ( # backwards compatible for 1.x.
83             is => 'lazy',
84             isa => sub {
85             warn 'deprecated _DBH used. rename to _dbh when you can';
86             croak "Expected a database handle. Got $_[0] instead"
87             unless eval {$_[0]->isa('DBI::db')};
88             },
89             );
90              
91             sub _build__dbh {
92 2     2   490 my ($self) = @_;
93 2 50       10 return $self->{_DBH} if $self->{_DBH};
94 2         7 return $self->_get_dbh;
95             }
96              
97             sub _build__DBH {
98 0     0   0 my ($self) = @_;
99 0 0       0 return $self->{_dbh} if $self->{_dbh};
100 0         0 return $self->_dbh;
101             }
102              
103             sub _get_dbh {
104 1     1   14 croak 'Invoked _get_dbh from role improperly. Subclasses MUST set this method';
105             }
106              
107             has _registry => (is => 'lazy');
108              
109             sub _build__registry {
110 1     1   11 my ($self) = @_;
111 1 50       9 return $self->_get_registry() if $self->can('_get_registry');
112 0         0 _get_registry();
113             }
114              
115             =head2 _get_registry
116              
117             This is a method the consuming classes can override in order to set the
118             registry of the calls for type mapping purposes.
119              
120             =cut
121              
122             sub _get_registry{
123 1     1   6 return undef;
124             }
125              
126             has _funcschema => (is => 'lazy');
127              
128             =head2 _get_schema
129              
130             Returns the default schema associated with the object.
131              
132             =cut
133              
134             sub _build__funcschema {
135 0     0   0 return $_[0]->_get_schema;
136             }
137              
138             sub _get_schema {
139 0     0   0 return undef;
140             }
141              
142             has _funcprefix => (is => 'lazy');
143              
144             =head2 _get_prefix
145              
146             Returns string, default is an empty string, used to set a prefix for mapping
147             stored prcedures to an object class.
148              
149             =cut
150              
151             sub _build__funcprefix {
152 2     2   19 my ($self) = @_;
153 2         7 return $self->_get_prefix;
154             }
155              
156             sub _get_prefix {
157 1     1   6 return '';
158             }
159              
160             =head1 READ ONLY ACCESSORS (PUBLIC)
161              
162             =head2 dbh
163              
164             Wraps the PGObject::Simple method
165              
166             =cut
167              
168             sub dbh {
169 0     0 1 0 my ($self) = @_;
170 0 0       0 if (ref $self){
171 0         0 return $self->_dbh;
172             }
173 0         0 return "$self"->_get_dbh;
174             }
175              
176             =head2 funcschema
177              
178             Returns the schema bound to the object
179              
180             =cut
181              
182             sub funcschema {
183 0     0 1 0 my ($self) = @_;
184 0 0       0 return $self->_funcschema if ref $self;
185 0         0 return "$self"->_get_schema();
186             }
187              
188             =head2 funcprefix
189              
190             Prefix for functions
191              
192             =cut
193              
194             sub funcprefix {
195 2     2 1 11582 my ($self) = @_;
196            
197 2 50       48 return $self->_funcprefix if ref $self;
198 0           return "$self"->_get_prefix();
199             }
200              
201             =head1 REMOVED METHODS
202              
203             These methods were once part of this package but have been removed due to
204             the philosophy of not adding framework dependencies when an application
205             dependency can work just as well.
206              
207             =head2 dbmethod
208              
209             Included in versions 0.50 - 0.71.
210              
211             Instead of using this directly, use:
212              
213             use PGObject::Util::DBMethod;
214              
215             instead. Ideally this should be done in your actual class since that will
216             allow you to dispense with the extra parentheses. However, if you need a
217             backwards-compatible and central solution, since PGObject::Simple::Role
218             generally assumes sub-roles will be created for managing db connections etc.
219             you can put the use statement there and it will have the same impact as it did
220             here when it was removed with the benefit of better testing.
221              
222             =head1 AUTHOR
223              
224             Chris Travers,, C<< >>
225              
226             =head1 BUGS
227              
228             Please report any bugs or feature requests to C, or through
229             the web interface at L. I will be notified, and then you'll
230             Chris Travers,, C<< >>
231              
232             =head1 BUGS
233              
234             Please report any bugs or feature requests to C, or through
235             the web interface at L. I will be notified, and then you'll
236             automatically be notified of progress on your bug as I make changes.
237              
238              
239              
240              
241             =head1 SUPPORT
242              
243             You can find documentation for this module with the perldoc command.
244              
245             perldoc PGObject::Simple::Role
246              
247              
248             You can also look for information at:
249              
250             =over 4
251              
252             =item * RT: CPAN's request tracker (report bugs here)
253              
254             L
255              
256             =item * AnnoCPAN: Annotated CPAN documentation
257              
258             L
259              
260             =item * CPAN Ratings
261              
262             L
263              
264             =item * Search CPAN
265              
266             L
267              
268             =back
269              
270              
271             =head1 ACKNOWLEDGEMENTS
272              
273              
274             =head1 LICENSE AND COPYRIGHT
275              
276             Copyright 2013-2017 Chris Travers,.
277              
278             Redistribution and use in source and compiled forms with or without
279             modification, are permitted provided that the following conditions are met:
280              
281             =over
282              
283             =item
284              
285             Redistributions of source code must retain the above
286             copyright notice, this list of conditions and the following disclaimer as the
287             first lines of this file unmodified.
288              
289             =item
290              
291             Redistributions in compiled form must reproduce the above copyright
292             notice, this list of conditions and the following disclaimer in the
293             source code, documentation, and/or other materials provided with the
294             distribution.
295              
296             =back
297              
298             THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) "AS IS" AND
299             ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
300             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
301             DISCLAIMED. IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR
302             ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
303             (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
304             LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
305             ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
306             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
307             SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
308              
309             =cut
310              
311             1; # End of PGObject::Simple::Role