File Coverage

blib/lib/Fey/Meta/HasOne/ViaSelect.pm
Criterion Covered Total %
statement 24 35 68.5
branch 0 4 0.0
condition n/a
subroutine 8 10 80.0
pod n/a
total 32 49 65.3


line stmt bran cond sub pod time code
1             package Fey::Meta::HasOne::ViaSelect;
2              
3 10     10   53 use strict;
  10         18  
  10         367  
4 10     10   55 use warnings;
  10         22  
  10         378  
5 10     10   54 use namespace::autoclean;
  10         20  
  10         101  
6              
7             our $VERSION = '0.47';
8              
9 10     10   985 use Fey::ORM::Types qw( CodeRef );
  10         47  
  10         106  
10              
11 10     10   52614 use Moose;
  10         22  
  10         95  
12 10     10   77247 use MooseX::StrictConstructor;
  10         26  
  10         100  
13              
14             with 'Fey::Meta::Role::Relationship::HasOne';
15              
16             has 'select' => (
17             is => 'ro',
18             does => 'Fey::Role::SQL::ReturnsData',
19             required => 1,
20             );
21              
22             has 'bind_params' => (
23             is => 'ro',
24             isa => CodeRef,
25             );
26              
27             # Since we don't know the content of the SQL, we just assume it can
28             # undef
29             sub _build_allows_undef {
30 1     1   28 return 1;
31             }
32              
33             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
34             sub _make_subref {
35 2     2   5 my $self = shift;
36              
37 2         77 my $foreign_table = $self->foreign_table();
38 2         78 my $select = $self->select();
39 2         78 my $bind = $self->bind_params();
40              
41             # XXX - this is really similar to
42             # Fey::Object::Table->_get_column_values() and needs some serious
43             # cleanup.
44             return sub {
45 0     0     my $self = shift;
        0      
46              
47 0           my $dbh = $self->_dbh($select);
48              
49 0           my $sth = $dbh->prepare( $select->sql($dbh) );
50              
51 0 0         $sth->execute( $bind ? $self->$bind() : () );
52              
53 0           my %col_values;
54 0           $sth->bind_columns( \( @col_values{ @{ $sth->{NAME} } } ) );
  0            
55              
56 0           my $fetched = $sth->fetch();
57              
58 0           $sth->finish();
59              
60 0 0         return unless $fetched;
61              
62 0           $self->meta()->ClassForTable($foreign_table)
63             ->new( %col_values, _from_query => 1 );
64 2         59 };
65              
66             }
67             ## use critic
68              
69             __PACKAGE__->meta()->make_immutable();
70              
71             1;
72              
73             # ABSTRACT: A parent for has-one metaclasses based on a query object
74              
75             __END__
76              
77             =pod
78              
79             =head1 NAME
80              
81             Fey::Meta::HasOne::ViaSelect - A parent for has-one metaclasses based on a query object
82              
83             =head1 VERSION
84              
85             version 0.47
86              
87             =head1 DESCRIPTION
88              
89             This class implements a has-one relationship for a class, based on a
90             provided (or deduced) query object.
91              
92             =head1 CONSTRUCTOR OPTIONS
93              
94             This class accepts the following constructor options:
95              
96             =over 4
97              
98             =item * select
99              
100             An object which does the L<Fey::Role::SQL::ReturnsData> role. This query
101             defines the relationship between the tables.
102              
103             =item * bind_params
104              
105             An optional subroutine reference which will be called when the SQL is
106             executed. It is called as a method on the object of this object's
107             associated class.
108              
109             =item * allows_undef
110              
111             This defaults to true.
112              
113             =back
114              
115             =head1 METHODS
116              
117             Besides the methods provided by L<Fey::Meta::Role::Relationship::HasOne>, this
118             class also provides the following methods:
119              
120             =head2 $ho->select()
121              
122             Corresponds to the value passed to the constructor.
123              
124             =head2 $ho->bind_params()
125              
126             Corresponds to the value passed to the constructor.
127              
128             =head1 AUTHOR
129              
130             Dave Rolsky <autarch@urth.org>
131              
132             =head1 COPYRIGHT AND LICENSE
133              
134             This software is copyright (c) 2011 - 2015 by Dave Rolsky.
135              
136             This is free software; you can redistribute it and/or modify it under
137             the same terms as the Perl 5 programming language system itself.
138              
139             =cut