File Coverage

blib/lib/PGObject/Simple/Role.pm
Criterion Covered Total %
statement 28 39 71.7
branch 2 8 25.0
condition n/a
subroutine 13 17 76.4
pod 3 3 100.0
total 46 67 68.6


line stmt bran cond sub pod time code
1             package PGObject::Simple::Role;
2              
3 3     3   27361 use 5.010;
  3         10  
4 3     3   15 use strict;
  3         6  
  3         51  
5 3     3   13 use warnings;
  3         9  
  3         78  
6 3     3   398 use Moo::Role;
  3         12483  
  3         19  
7 3     3   1841 use PGObject::Simple ':full', '!dbh';
  3         10927  
  3         422  
8 3     3   35 use Carp;
  3         5  
  3         1443  
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.1
17              
18             =cut
19              
20             our $VERSION = 2.000001;
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             sub _build__dbh {
83 2     2   701 my ($self) = @_;
84 2         7 return $self->_get_dbh;
85             }
86              
87             sub _get_dbh {
88 1     1   12 croak 'Invoked _get_dbh from role improperly. Subclasses MUST set this method';
89             }
90              
91             has _registry => (is => 'lazy');
92              
93             sub _build__registry {
94 1     1   10 my ($self) = @_;
95 1 50       9 return $self->_get_registry() if $self->can('_get_registry');
96 0         0 _get_registry();
97             }
98              
99             =head2 _get_registry
100              
101             This is a method the consuming classes can override in order to set the
102             registry of the calls for type mapping purposes.
103              
104             =cut
105              
106             sub _get_registry{
107 1     1   6 return undef;
108             }
109              
110             has _funcschema => (is => 'lazy');
111              
112             =head2 _get_schema
113              
114             Returns the default schema associated with the object.
115              
116             =cut
117              
118             sub _build__funcschema {
119 0     0   0 return $_[0]->_get_schema;
120             }
121              
122             sub _get_schema {
123 0     0   0 return undef;
124             }
125              
126             has _funcprefix => (is => 'lazy');
127              
128             =head2 _get_prefix
129              
130             Returns string, default is an empty string, used to set a prefix for mapping
131             stored prcedures to an object class.
132              
133             =cut
134              
135             sub _build__funcprefix {
136 2     2   19 my ($self) = @_;
137 2         7 return $self->_get_prefix;
138             }
139              
140             sub _get_prefix {
141 1     1   6 return '';
142             }
143              
144             =head1 READ ONLY ACCESSORS (PUBLIC)
145              
146             =head2 dbh
147              
148             Wraps the PGObject::Simple method
149              
150             =cut
151              
152             sub dbh {
153 0     0 1 0 my ($self) = @_;
154 0 0       0 if (ref $self){
155 0         0 return $self->_dbh;
156             }
157 0         0 return "$self"->_get_dbh;
158             }
159              
160             =head2 funcschema
161              
162             Returns the schema bound to the object
163              
164             =cut
165              
166             sub funcschema {
167 0     0 1 0 my ($self) = @_;
168 0 0       0 return $self->_funcschema if ref $self;
169 0         0 return "$self"->_get_schema();
170             }
171              
172             =head2 funcprefix
173              
174             Prefix for functions
175              
176             =cut
177              
178             sub funcprefix {
179 2     2 1 11537 my ($self) = @_;
180            
181 2 50       47 return $self->_funcprefix if ref $self;
182 0           return "$self"->_get_prefix();
183             }
184              
185             =head1 REMOVED METHODS
186              
187             These methods were once part of this package but have been removed due to
188             the philosophy of not adding framework dependencies when an application
189             dependency can work just as well.
190              
191             =head2 dbmethod
192              
193             Included in versions 0.50 - 0.71.
194              
195             Instead of using this directly, use:
196              
197             use PGObject::Util::DBMethod;
198              
199             instead. Ideally this should be done in your actual class since that will
200             allow you to dispense with the extra parentheses. However, if you need a
201             backwards-compatible and central solution, since PGObject::Simple::Role
202             generally assumes sub-roles will be created for managing db connections etc.
203             you can put the use statement there and it will have the same impact as it did
204             here when it was removed with the benefit of better testing.
205              
206             =head1 AUTHOR
207              
208             Chris Travers,, C<< >>
209              
210             =head1 BUGS
211              
212             Please report any bugs or feature requests to C, or through
213             the web interface at L. I will be notified, and then you'll
214             Chris Travers,, C<< >>
215              
216             =head1 BUGS
217              
218             Please report any bugs or feature requests to C, or through
219             the web interface at L. I will be notified, and then you'll
220             automatically be notified of progress on your bug as I make changes.
221              
222              
223              
224              
225             =head1 SUPPORT
226              
227             You can find documentation for this module with the perldoc command.
228              
229             perldoc PGObject::Simple::Role
230              
231              
232             You can also look for information at:
233              
234             =over 4
235              
236             =item * RT: CPAN's request tracker (report bugs here)
237              
238             L
239              
240             =item * AnnoCPAN: Annotated CPAN documentation
241              
242             L
243              
244             =item * CPAN Ratings
245              
246             L
247              
248             =item * Search CPAN
249              
250             L
251              
252             =back
253              
254              
255             =head1 ACKNOWLEDGEMENTS
256              
257              
258             =head1 LICENSE AND COPYRIGHT
259              
260             Copyright 2013-2017 Chris Travers,.
261              
262             Redistribution and use in source and compiled forms with or without
263             modification, are permitted provided that the following conditions are met:
264              
265             =over
266              
267             =item
268              
269             Redistributions of source code must retain the above
270             copyright notice, this list of conditions and the following disclaimer as the
271             first lines of this file unmodified.
272              
273             =item
274              
275             Redistributions in compiled form must reproduce the above copyright
276             notice, this list of conditions and the following disclaimer in the
277             source code, documentation, and/or other materials provided with the
278             distribution.
279              
280             =back
281              
282             THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) "AS IS" AND
283             ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
284             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
285             DISCLAIMED. IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR
286             ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
287             (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
288             LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
289             ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
290             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
291             SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
292              
293             =cut
294              
295             1; # End of PGObject::Simple::Role