File Coverage

blib/lib/Fey/FK.pm
Criterion Covered Total %
statement 99 115 86.0
branch 16 16 100.0
condition 3 3 100.0
subroutine 22 24 91.6
pod 3 4 75.0
total 143 162 88.2


line stmt bran cond sub pod time code
1             package Fey::FK;
2              
3 23     23   14672 use strict;
  23         53  
  23         1039  
4 23     23   129 use warnings;
  23         38  
  23         818  
5 23     23   121 use namespace::autoclean;
  23         45  
  23         217  
6              
7             our $VERSION = '0.43';
8              
9 23     23   2287 use Fey::Column;
  23         55  
  23         529  
10 23     23   112 use Fey::Exceptions qw(param_error);
  23         39  
  23         1531  
11 23     23   129 use Fey::Types qw( ArrayRef ArrayRefOfColumns Bool Column TableOrName );
  23         40  
  23         211  
12 23     23   290616 use List::AllUtils qw( max uniq all pairwise );
  23         63  
  23         1983  
13 23     23   139 use Scalar::Util qw( blessed );
  23         44  
  23         1350  
14              
15 23     23   141 use Moose 2.1200;
  23         755  
  23         213  
16 23     23   143232 use MooseX::Params::Validate 0.21 qw( pos_validated_list );
  23         772  
  23         179  
17 23     23   4867 use MooseX::SemiAffordanceAccessor 0.03;
  23         436  
  23         183  
18 23     23   81480 use MooseX::StrictConstructor 0.13;
  23         659  
  23         165  
19 23     23   71639 use Moose::Util::TypeConstraints;
  23         112  
  23         298  
20              
21             has 'id' => (
22             is => 'ro',
23             lazy_build => 1,
24             init_arg => undef,
25             );
26              
27             has [qw( source_columns target_columns )] => (
28             is => 'ro',
29             isa => ArrayRefOfColumns,
30             required => 1,
31             coerce => 1,
32             );
33              
34             has [qw( source_table target_table )] => (
35             is => 'ro',
36             does => 'Fey::Role::TableLike',
37             lazy_build => 1,
38             init_arg => undef,
39             );
40              
41             has column_pairs => (
42             is => 'ro',
43              
44             # really, the inner array refs must always contain 2 columns,
45             # but we don't have structured constraints quite yet.
46             isa => ArrayRef [ ArrayRef [Column] ],
47             lazy_build => 1,
48             init_arg => undef,
49             );
50              
51             has is_self_referential => (
52             is => 'ro',
53             isa => Bool,
54             lazy_build => 1,
55             init_arg => 1,
56             );
57              
58             sub BUILD {
59 150     150 0 245 my $self = shift;
60 150         180 my $p = shift;
61              
62 150         207 my @source = @{ $self->source_columns() };
  150         3401  
63 150         197 my @target = @{ $self->target_columns() };
  150         3295  
64              
65 150 100       395 unless ( @source == @target ) {
66 1         12 param_error(
67             "The source and target arrays passed to add_foreign_key()"
68             . " must contain the same number of columns." );
69             }
70              
71 149 100       247 if ( grep { !$_->table() } @source, @target ) {
  300         6325  
72 1         5 param_error
73             "All columns passed to add_foreign_key() must have a table.";
74             }
75              
76 148         548 for my $p ( [ source => \@source ], [ target => \@target ] ) {
77 296         290 my ( $name, $array ) = @{$p};
  296         472  
78 296 100       280 if ( uniq( map { $_->table() } @{$array} ) > 1 ) {
  298         6182  
  296         398  
79 1         7 param_error(
80             "Each column in the $name argument to add_foreign_key()"
81             . " must come from the same table." );
82             }
83             }
84              
85 147         3067 return;
86             }
87              
88             sub _build_id {
89 145     145   199 my $self = shift;
90              
91 290         6021 return join "\0",
92             (
93             sort
94 145         3169 map { $_->table()->name() . q{.} . $_->name() }
95 145         196 @{ $self->source_columns() }, @{ $self->target_columns() }
  145         3145  
96             );
97             }
98              
99             sub _build_column_pairs {
100 1     1   2 my $self = shift;
101              
102 1         1 my @s = @{ $self->source_columns() };
  1         20  
103 1         3 my @t = @{ $self->target_columns() };
  1         19  
104              
105 1     1   10 return [ pairwise { [ $a, $b ] } @s, @t ];
  1         20  
106             }
107              
108             sub _build_source_table {
109 140     140   208 my $self = shift;
110              
111 140         3134 return $self->source_columns()->[0]->table();
112             }
113              
114             sub _build_target_table {
115 140     140   194 my $self = shift;
116              
117 140         3034 return $self->target_columns()->[0]->table();
118             }
119              
120             sub has_tables {
121 79     79 1 271 my $self = shift;
122              
123 79         288 my ( $table1, $table2 ) = pos_validated_list(
124             \@_,
125             { isa => TableOrName },
126             { isa => TableOrName },
127             );
128              
129 79 100       1544 my $name1 = blessed $table1 ? $table1->name() : $table1;
130 79 100       243 my $name2 = blessed $table2 ? $table2->name() : $table2;
131              
132 79         285 my @looking_for = sort $name1, $name2;
133             my @have
134 79         1960 = sort map { $_->name() } $self->source_table(),
  158         3295  
135             $self->target_table();
136              
137 79   100     577 return ( $looking_for[0] eq $have[0] && $looking_for[1] eq $have[1] );
138             }
139              
140             sub has_column {
141 3     3 1 187 my $self = shift;
142 3         14 my ($col) = pos_validated_list( \@_, { isa => Column } );
143              
144 3         1645 my $table_name = $col->table()->name();
145              
146 3         6 my @cols;
147 3         7 for my $part (qw( source target )) {
148 6         12 my $table_meth = $part . '_table';
149 6 100       148 if ( $self->$table_meth()->name() eq $table_name ) {
150 2         7 my $col_meth = $part . '_columns';
151 2         5 @cols = @{ $self->$col_meth() };
  2         69  
152             }
153             }
154              
155 3 100       14 return 0 unless @cols;
156              
157 2         57 my $col_name = $col->name();
158              
159 2 100       6 return 1 if grep { $_->name() eq $col_name } @cols;
  2         57  
160              
161 1         5 return 0;
162             }
163              
164             sub _build_is_self_referential {
165 2     2   3 my $self = shift;
166              
167 2         45 return $self->source_table()->name() eq $self->target_table()->name();
168             }
169              
170             sub pretty_print {
171 0     0 1   my $self = shift;
172              
173 0           my @source_columns = @{ $self->source_columns() };
  0            
174 0           my @target_columns = @{ $self->target_columns() };
  0            
175              
176 0           my $longest = max
177 0           map { length $_->name() } $self->source_table(),
178             $self->target_table(),
179             @source_columns, @target_columns;
180              
181 0           $longest += 2;
182              
183 0           my $string = sprintf(
184             "\%-${longest}s \%-${longest}s\n",
185             $self->source_table()->name(),
186             $self->target_table()->name(),
187             );
188 0           $string .= ('-') x $longest;
189 0           $string .= q{ };
190 0           $string .= ('-') x $longest;
191 0           $string .= "\n";
192              
193             $string .= (
194             join '',
195             pairwise {
196 0     0     sprintf(
197             "\%-${longest}s \%-${longest}s\n",
198             $a->name(), $b->name()
199             );
200             }
201 0           @source_columns,
202             @target_columns
203             );
204              
205 0           return $string;
206             }
207              
208             __PACKAGE__->meta()->make_immutable();
209              
210             1;
211              
212             # ABSTRACT: Represents a foreign key
213              
214             __END__
215              
216             =pod
217              
218             =head1 NAME
219              
220             Fey::FK - Represents a foreign key
221              
222             =head1 VERSION
223              
224             version 0.43
225              
226             =head1 SYNOPSIS
227              
228             my $fk = Fey::FK->new( source => $user_id_from_user_table,
229             target => $user_id_from_department_table,
230             );
231              
232             =head1 DESCRIPTION
233              
234             This class represents a foreign key, connecting one or more columns in
235             one table to columns in another table.
236              
237             =head1 METHODS
238              
239             This class provides the following methods:
240              
241             =head2 Fey::FK->new()
242              
243             This method constructs a new C<Fey::FK> object. It takes the following
244             parameters:
245              
246             =over 4
247              
248             =item * source_columns - required
249              
250             =item * target_columns - required
251              
252             These parameters must be either a single C<Fey::Column> object or an
253             array reference containing one or more column objects.
254              
255             The number of columns for the source and target must be the same.
256              
257             =back
258              
259             =head2 $fk->source_table()
260              
261             =head2 $fk->target_table()
262              
263             Returns the appropriate C<Fey::Table> object.
264              
265             =head2 $fk->source_columns()
266              
267             =head2 $fk->target_columns()
268              
269             Returns the appropriate list of C<Fey::Column> objects as an array
270             reference.
271              
272             =head2 $fk->column_pairs()
273              
274             Returns an array reference. Each element of this reference is in turn
275             a two-element array reference of C<Fey::Column> objects, one from the
276             source table and one from the target.
277              
278             =head2 $fk->has_tables( $table1, $table2 )
279              
280             This method returns true if the foreign key includes both of the
281             specified tables. The tables can be specified by name or as
282             C<Fey::Table> objects.
283              
284             =head2 $fk->has_column($column)
285              
286             Given a C<Fey::Column> object, this method returns true if the foreign
287             key includes the specified column.
288              
289             =head2 $fk->is_self_referential()
290              
291             This returns true if the the source and target tables for the foreign
292             key are the same table.
293              
294             =head2 $fk->pretty_print()
295              
296             Returns a stringified representation of the foreign key in a pretty
297             layout something like this:
298              
299             User Message
300             ------- -------
301             user_id user_id
302              
303             =head1 BUGS
304              
305             See L<Fey> for details on how to report bugs.
306              
307             =head1 AUTHOR
308              
309             Dave Rolsky <autarch@urth.org>
310              
311             =head1 COPYRIGHT AND LICENSE
312              
313             This software is Copyright (c) 2011 - 2015 by Dave Rolsky.
314              
315             This is free software, licensed under:
316              
317             The Artistic License 2.0 (GPL Compatible)
318              
319             =cut