File Coverage

blib/lib/Fey/Table.pm
Criterion Covered Total %
statement 126 126 100.0
branch 35 36 97.2
condition 2 2 100.0
subroutine 32 32 100.0
pod 11 11 100.0
total 206 207 99.5


line stmt bran cond sub pod time code
1             package Fey::Table;
2              
3 26     26   16426 use strict;
  26         39  
  26         1008  
4 26     26   118 use warnings;
  26         40  
  26         839  
5 26     26   570 use namespace::autoclean;
  26         15191  
  26         224  
6              
7             our $VERSION = '0.43';
8              
9 26     26   3104 use Fey::Column;
  26         40  
  26         821  
10 26     26   121 use Fey::Exceptions qw( param_error );
  26         35  
  26         1253  
11 26     26   10988 use Fey::NamedObjectSet;
  26         92  
  26         1669  
12 26     26   14165 use Fey::Schema;
  26         108  
  26         1242  
13 26     26   15185 use Fey::Table::Alias;
  26         101  
  26         1376  
14 26         254 use Fey::Types qw(
15             ArrayRef Bool HashRef Str Undef Column ColumnOrName NamedObjectSet Schema
16 26     26   226 );
  26         42  
17 26     26   335500 use List::AllUtils qw( any all first_index );
  26         67  
  26         2092  
18 26     26   156 use Scalar::Util qw( blessed weaken );
  26         42  
  26         1518  
19              
20 26     26   145 use Moose 2.1200;
  26         896  
  26         240  
21 26     26   159163 use MooseX::Params::Validate 0.21 qw( pos_validated_list );
  26         865  
  26         203  
22 26     26   5515 use MooseX::SemiAffordanceAccessor 0.03;
  26         456  
  26         192  
23 26     26   105849 use MooseX::StrictConstructor 0.13;
  26         648  
  26         193  
24 26     26   83960 use Moose::Util::TypeConstraints;
  26         89  
  26         333  
25              
26             with 'Fey::Role::TableLike';
27              
28             with 'Fey::Role::MakesAliasObjects' => {
29             self_param => 'table',
30             alias_class => 'Fey::Table::Alias',
31             };
32              
33             has 'id' => (
34             is => 'ro',
35             lazy_build => 1,
36             init_arg => undef,
37             );
38              
39             has 'name' => (
40             is => 'ro',
41             isa => Str,
42             required => 1,
43             );
44              
45             has 'is_view' => (
46             is => 'ro',
47             isa => Bool,
48             default => 0,
49             );
50              
51             has '_keys' => (
52             traits => ['Array'],
53             is => 'bare',
54             isa => ArrayRef [NamedObjectSet],
55             default => sub { [] },
56             handles => {
57             _keys => 'elements',
58             _add_key => 'push',
59             _delete_key => 'splice',
60             },
61              
62             );
63              
64             has '_columns' => (
65             is => 'ro',
66             isa => NamedObjectSet,
67             default => sub { return Fey::NamedObjectSet->new() },
68             handles => {
69             columns => 'objects',
70             column => 'object',
71             },
72             );
73              
74             has 'schema' => (
75             is => 'rw',
76             isa => Undef | Schema,
77             weak_ref => 1,
78             writer => '_set_schema',
79             clearer => '_clear_schema',
80             predicate => 'has_schema',
81             );
82              
83             has 'candidate_keys' => (
84             is => 'ro',
85             isa => ArrayRef [ ArrayRef [Column] ],
86             clearer => '_clear_candidate_keys',
87             lazy_build => 1,
88             init_arg => undef,
89             );
90              
91             after '_add_key', '_delete_key' => sub { $_[0]->_clear_candidate_keys() };
92              
93             has 'primary_key' => (
94             is => 'ro',
95             isa => ArrayRef [Column],
96             clearer => '_clear_primary_key',
97             lazy_build => 1,
98             init_arg => undef,
99             );
100              
101             after '_clear_candidate_keys' => sub { $_[0]->_clear_primary_key() };
102              
103             has '_aliased_tables' => (
104             traits => ['Hash'],
105             is => 'bare',
106             isa => HashRef,
107             lazy => 1,
108             default => sub { {} },
109             handles => {
110             _aliased_table => 'get',
111             _store_aliased_table => 'set',
112             _has_aliased_table => 'exists',
113             },
114             );
115              
116             with 'Fey::Role::Named';
117              
118             sub add_column {
119 704     704 1 5347 my $self = shift;
120 704         2700 my ($col) = pos_validated_list( \@_, { isa => Column } );
121              
122 704         254794 my $name = $col->name();
123 704 100       2761 param_error "The table already has a column named $name."
124             if $self->column($name);
125              
126 703         101011 $self->_columns()->add($col);
127              
128 703         2575 $col->_set_table($self);
129              
130 703         4668 return $self;
131             }
132              
133             sub remove_column {
134 5     5 1 1743 my $self = shift;
135 5         28 my ($col)
136             = pos_validated_list( \@_, { isa => ColumnOrName } );
137              
138 5 100       167 $col = $self->column($col)
139             unless blessed $col;
140              
141 5 100       581 if ( my $schema = $self->schema() ) {
142 1         5 for my $fk ( grep { $_->has_column($col) }
  1         7  
143             $schema->foreign_keys_for_table($self) ) {
144 1         10 $schema->remove_foreign_key($fk);
145             }
146             }
147              
148 5         158 my $name = $col->name();
149              
150 5         198 for my $k ( $self->_keys() ) {
151 4 100       17 $self->remove_candidate_key( $k->objects() )
152             if $k->object($name);
153             }
154              
155 5         453 $self->_columns()->delete($col);
156              
157 5         25 $col->_clear_table();
158              
159 5         31 return $self;
160             }
161              
162             sub _build_candidate_keys {
163 7     7   16 my $self = shift;
164              
165 7         191 return [ map { [ $_->objects() ] } $self->_keys() ];
  9         434  
166             }
167              
168             sub _build_primary_key {
169 5     5   503 my $self = shift;
170              
171 5         125 my $keys = $self->candidate_keys();
172              
173 5   100     122 return $keys->[0] || [];
174             }
175              
176             sub add_candidate_key {
177 327     327 1 5416 my $self = shift;
178              
179 327 100       1019 my $count = @_ ? @_ : 1;
180 327         1447 my (@cols) = pos_validated_list(
181             \@_,
182             ( ( { isa => ColumnOrName } ) x $count ),
183             MX_PARAMS_VALIDATE_NO_CACHE => 1,
184             );
185              
186 326 100       7560 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  379         10612  
187 379 100       8038 param_error "The column $name is not part of the "
188             . $self->name()
189             . ' table.'
190             unless $self->column($name);
191             }
192              
193 325         38218 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  378         1677  
194              
195 325 100       2550 return if $self->has_candidate_key(@cols);
196              
197 324         8730 $self->_add_key( Fey::NamedObjectSet->new(@cols) );
198              
199 324         2735 return;
200             }
201              
202             sub remove_candidate_key {
203 8     8 1 3828 my $self = shift;
204              
205 8 100       33 my $count = @_ ? @_ : 1;
206 8         33 my (@cols) = pos_validated_list(
207             \@_,
208             ( ( { isa => ColumnOrName } ) x $count ),
209             MX_PARAMS_VALIDATE_NO_CACHE => 1,
210             );
211              
212 7 100       177 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  7         174  
213 7 100       30 param_error "The column $name is not part of the "
214             . $self->name()
215             . ' table.'
216             unless $self->column($name);
217             }
218              
219 6         782 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  6         37  
220              
221 6         404 my $set = Fey::NamedObjectSet->new(@cols);
222              
223 6     6   215 my $idx = first_index { $_->is_same_as($set) } $self->_keys();
  6         25  
224              
225 6 100       62 $self->_delete_key( $idx, 1 )
226             if $idx >= 0;
227              
228 6         184 return;
229             }
230              
231             sub has_candidate_key {
232 330     330 1 2146 my $self = shift;
233              
234 330 100       922 my $count = @_ ? @_ : 1;
235 330         1389 my (@cols) = pos_validated_list(
236             \@_,
237             ( ( { isa => ColumnOrName } ) x $count ),
238             MX_PARAMS_VALIDATE_NO_CACHE => 1,
239             );
240              
241 329 100       7459 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  383         10948  
242 383 100       8127 param_error "The column $name is not part of the "
243             . $self->name()
244             . ' table.'
245             unless $self->column($name);
246             }
247              
248 328         38169 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  382         1749  
249              
250 328         10842 my $set = Fey::NamedObjectSet->new(@cols);
251              
252             return 1
253 328 100   111   12004 if any { $_->is_same_as($set) } $self->_keys();
  111         534  
254              
255 325         10676 return 0;
256             }
257              
258             # Caching the objects by name prevents a weird bug where we have two
259             # aliases of the same name, and one disappears because of weak
260             # references, causing weird errors.
261             around 'alias' => sub {
262             my $orig = shift;
263             my $self = shift;
264              
265             # bleh, duplicating code from Aliasable
266             my %p = @_ == 1 ? ( alias_name => $_[0] ) : @_;
267              
268             if ( defined $p{alias_name} ) {
269             return $self->_aliased_table( $p{alias_name} )
270             if $self->_has_aliased_table( $p{alias_name} );
271             }
272              
273             my $alias = $orig->( $self, %p );
274              
275             $self->_store_aliased_table( $alias->alias_name() => $alias );
276              
277             return $alias;
278             };
279              
280 319     319 1 5500 sub is_alias {0}
281              
282             sub aliased_column {
283 6     6 1 106 my $self = shift;
284 6         7 my $prefix = shift;
285 6         5 my $name = shift;
286              
287 6 50       17 my $col = $self->column($name)
288             or return;
289              
290 6         725 return $col->alias( alias_name => $prefix . $col->name() );
291             }
292              
293             sub aliased_columns {
294 2     2 1 132 my $self = shift;
295 2         4 my $prefix = shift;
296              
297 2 100       14 my @names = @_ ? @_ : map { $_->name() } $self->columns();
  3         150  
298              
299 2         4 return map { $self->aliased_column( $prefix, $_ ) } @names;
  5         12  
300             }
301              
302             sub sql {
303 129     129 1 2606 return $_[1]->quote_identifier( $_[0]->name() );
304             }
305              
306 5     5 1 24 sub sql_for_select_clause { $_[0]->sql( $_[1] ) . '.*' }
307              
308 124     124 1 349 sub sql_with_alias { goto &sql }
309              
310 23     23   564 sub _build_id { $_[0]->name() }
311              
312             __PACKAGE__->meta()->make_immutable();
313              
314             1;
315              
316             # ABSTRACT: Represents a table (or view)
317              
318             __END__
319              
320             =pod
321              
322             =head1 NAME
323              
324             Fey::Table - Represents a table (or view)
325              
326             =head1 VERSION
327              
328             version 0.43
329              
330             =head1 SYNOPSIS
331              
332             my $table = Fey::Table->new( name => 'User' );
333              
334             =head1 DESCRIPTION
335              
336             This class represents a table or view in a schema. From the standpoint
337             of SQL construction in Fey, a table and a view are basically the same
338             thing.
339              
340             =head1 METHODS
341              
342             This class provides the following methods:
343              
344             =head2 Fey::Table->new()
345              
346             my $table = Fey::Table->new( name => 'User' );
347              
348             my $table = Fey::Table->new( name => 'ActiveUser',
349             is_view => 1,
350             );
351              
352             This method constructs a new C<Fey::Table> object. It takes the
353             following parameters:
354              
355             =over 4
356              
357             =item * name - required
358              
359             The name of the table.
360              
361             =item * is_view - defaults to 0
362              
363             A boolean indicating whether this table is a view.
364              
365             =back
366              
367             =head2 $table->name()
368              
369             Returns the name of the table.
370              
371             =head2 $table->is_view()
372              
373             Returns a boolean indicating whether the object is a view.
374              
375             =head2 $table->schema()
376              
377             Returns the C<Fey::Schema> object that this table belongs to. This is
378             set when the table is added to a schema via the C<<
379             Fey::Schema->add_table() >> method.
380              
381             =head2 $table->add_column($column)
382              
383             This adds a new column to the schema. The column must be a
384             C<Fey::Column> object. Adding the column to the table sets the table
385             for the column, so that C<< $column->table() >> returns the correct
386             object.
387              
388             If the table already has a column with the same name, an exception is
389             thrown.
390              
391             =head2 $table->remove_column($column)
392              
393             Remove the specified column from the table. If the column was part of
394             any foreign keys, these are removed from the schema. If this column is
395             part of any keys for the table, those keys will be removed. Removing
396             the column unsets the table for the column.
397              
398             The table can be specified either by name or by passing in a
399             C<Fey::Column> object.
400              
401             =head2 $table->column($name)
402              
403             Given a column name, this method returns the matching column object,
404             if one exists.
405              
406             =head2 $table->columns
407              
408             =head2 $table->columns(@names)
409              
410             When this method is called with no arguments, it returns all of the columns in
411             the table. Columns are returned in the order with which they were added to the
412             table.
413              
414             If given a list of names, it returns only the specified columns. If a name is
415             given which doesn't match a column in the table, then it is ignored.
416              
417             =head2 $table->candidate_keys()
418              
419             Returns all of the candidate keys for the table as an array
420             reference. Each element of the reference is in turn an array reference
421             containing one or more columns.
422              
423             =head2 $table->has_candidate_key(@columns)
424              
425             This method returns true if the table has the given key. A key is
426             identified as a list of names or C<Fey::Column> objects.
427              
428             =head2 $table->add_candidate_key(@columns)
429              
430             This method adds a new candidate key to the table. The list of columns
431             can contain either names or C<Fey::Column> objects.
432              
433             A candidate key is one or more columns which uniquely identify a row
434             in that table.
435              
436             If a name or column is specified which doesn't belong to the table, an
437             exception will be thrown.
438              
439             =head2 $table->remove_candidate_key(@columns)
440              
441             This method removes a candidate key for the table. The list of columns
442             can contain either names or C<Fey::Column> objects.
443              
444             If a name or column is specified which doesn't belong to the table, an
445             exception will be thrown.
446              
447             =head2 $table->primary_key()
448              
449             This is a convenience method that simply returns the first candidate
450             key added to the table. The key is returned as an array reference of
451             column objects.
452              
453             =head2 $table->alias(%p)
454              
455             =head2 $table->alias($alias_name)
456              
457             This method returns a new C<Fey::Table::Alias> object based on the
458             table. Any parameters passed to this method will be passed through to
459             C<< Fey::Table::Alias->new() >>.
460              
461             As a shortcut, if you pass a single argument to this method, it will
462             be passed as the "alias_name" parameter to C<<
463             Fey::Table::Alias->new() >>.
464              
465             =head2 $table->is_alias()
466              
467             Always returns false.
468              
469             =head2 $table->aliased_column( $prefix, $column_name )
470              
471             This method returns a new L<Fey::Column::Alias> object. The alias's
472             name is generated by concatenating the specified prefix and the
473             column's real name.
474              
475             =head2 $table->aliased_columns( $prefix, @column_names )
476              
477             This method returns a list of new L<Fey::Column::Alias> objects. The
478             alias names are generated by concatenating the specified prefix and
479             the column's real name.
480              
481             If you omit the list of column names, it returns aliases for I<all> of the
482             columns in table, in same order as returned by C<< $table->columns() >>.
483              
484             =head2 $table->sql()
485              
486             =head2 $table->sql_with_alias()
487              
488             =head2 $table->sql_for_select_clause()
489              
490             Returns the appropriate SQL snippet for the table.
491              
492             =head2 $table->id()
493              
494             Returns a unique identifier for the table.
495              
496             =head1 ROLES
497              
498             This class does the L<Fey::Role::TableLike>, L<Fey::Role::MakesAliasObjects>,
499             and L<Fey::Role::Named> roles.
500              
501             =head1 BUGS
502              
503             See L<Fey> for details on how to report bugs.
504              
505             =head1 AUTHOR
506              
507             Dave Rolsky <autarch@urth.org>
508              
509             =head1 COPYRIGHT AND LICENSE
510              
511             This software is Copyright (c) 2011 - 2015 by Dave Rolsky.
512              
513             This is free software, licensed under:
514              
515             The Artistic License 2.0 (GPL Compatible)
516              
517             =cut