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   16760 use strict;
  26         37  
  26         891  
4 26     26   110 use warnings;
  26         37  
  26         741  
5 26     26   546 use namespace::autoclean;
  26         14141  
  26         194  
6              
7             our $VERSION = '0.42';
8              
9 26     26   2417 use Fey::Column;
  26         37  
  26         681  
10 26     26   113 use Fey::Exceptions qw( param_error );
  26         34  
  26         1119  
11 26     26   8823 use Fey::NamedObjectSet;
  26         103  
  26         1375  
12 26     26   13964 use Fey::Schema;
  26         97  
  26         1124  
13 26     26   12641 use Fey::Table::Alias;
  26         97  
  26         1248  
14 26         233 use Fey::Types qw(
15             ArrayRef Bool HashRef Str Undef Column ColumnOrName NamedObjectSet Schema
16 26     26   248 );
  26         39  
17 26     26   301887 use List::AllUtils qw( any all first_index );
  26         51  
  26         1887  
18 26     26   134 use Scalar::Util qw( blessed weaken );
  26         46  
  26         1307  
19              
20 26     26   135 use Moose 0.90;
  26         691  
  26         201  
21 26     26   140070 use MooseX::Params::Validate 0.08 qw( pos_validated_list );
  26         685  
  26         183  
22 26     26   4928 use MooseX::SemiAffordanceAccessor 0.03;
  26         426  
  26         163  
23 26     26   81721 use MooseX::StrictConstructor 0.07;
  26         562  
  26         165  
24 26     26   72601 use Moose::Util::TypeConstraints;
  26         57  
  26         246  
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 4575 my $self = shift;
120 704         2626 my ($col) = pos_validated_list( \@_, { isa => Column } );
121              
122 704         254202 my $name = $col->name();
123 704 100       2632 param_error "The table already has a column named $name."
124             if $self->column($name);
125              
126 703         99198 $self->_columns()->add($col);
127              
128 703         2429 $col->_set_table($self);
129              
130 703         4487 return $self;
131             }
132              
133             sub remove_column {
134 5     5 1 1333 my $self = shift;
135 5         19 my ($col)
136             = pos_validated_list( \@_, { isa => ColumnOrName } );
137              
138 5 100       150 $col = $self->column($col)
139             unless blessed $col;
140              
141 5 100       427 if ( my $schema = $self->schema() ) {
142 1         5 for my $fk ( grep { $_->has_column($col) }
  1         5  
143             $schema->foreign_keys_for_table($self) ) {
144 1         6 $schema->remove_foreign_key($fk);
145             }
146             }
147              
148 5         110 my $name = $col->name();
149              
150 5         146 for my $k ( $self->_keys() ) {
151 4 100       12 $self->remove_candidate_key( $k->objects() )
152             if $k->object($name);
153             }
154              
155 5         320 $self->_columns()->delete($col);
156              
157 5         18 $col->_clear_table();
158              
159 5         26 return $self;
160             }
161              
162             sub _build_candidate_keys {
163 7     7   14 my $self = shift;
164              
165 7         190 return [ map { [ $_->objects() ] } $self->_keys() ];
  9         329  
166             }
167              
168             sub _build_primary_key {
169 5     5   10 my $self = shift;
170              
171 5         109 my $keys = $self->candidate_keys();
172              
173 5   100     121 return $keys->[0] || [];
174             }
175              
176             sub add_candidate_key {
177 327     327 1 4774 my $self = shift;
178              
179 327 100       977 my $count = @_ ? @_ : 1;
180 327         1395 my (@cols) = pos_validated_list(
181             \@_,
182             ( ( { isa => ColumnOrName } ) x $count ),
183             MX_PARAMS_VALIDATE_NO_CACHE => 1,
184             );
185              
186 326 100       7604 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  379         10724  
187 379 100       8390 param_error "The column $name is not part of the "
188             . $self->name()
189             . ' table.'
190             unless $self->column($name);
191             }
192              
193 325         39262 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  378         1560  
194              
195 325 100       2393 return if $self->has_candidate_key(@cols);
196              
197 324         8560 $self->_add_key( Fey::NamedObjectSet->new(@cols) );
198              
199 324         2719 return;
200             }
201              
202             sub remove_candidate_key {
203 8     8 1 3349 my $self = shift;
204              
205 8 100       24 my $count = @_ ? @_ : 1;
206 8         30 my (@cols) = pos_validated_list(
207             \@_,
208             ( ( { isa => ColumnOrName } ) x $count ),
209             MX_PARAMS_VALIDATE_NO_CACHE => 1,
210             );
211              
212 7 100       134 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  7         112  
213 7 100       23 param_error "The column $name is not part of the "
214             . $self->name()
215             . ' table.'
216             unless $self->column($name);
217             }
218              
219 6         623 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  6         29  
220              
221 6         339 my $set = Fey::NamedObjectSet->new(@cols);
222              
223 6     6   195 my $idx = first_index { $_->is_same_as($set) } $self->_keys();
  6         20  
224              
225 6 100       62 $self->_delete_key( $idx, 1 )
226             if $idx >= 0;
227              
228 6         163 return;
229             }
230              
231             sub has_candidate_key {
232 330     330 1 1769 my $self = shift;
233              
234 330 100       876 my $count = @_ ? @_ : 1;
235 330         1368 my (@cols) = pos_validated_list(
236             \@_,
237             ( ( { isa => ColumnOrName } ) x $count ),
238             MX_PARAMS_VALIDATE_NO_CACHE => 1,
239             );
240              
241 329 100       7318 for my $name ( map { blessed $_ ? $_->name() : $_ } @cols ) {
  383         10640  
242 383 100       7765 param_error "The column $name is not part of the "
243             . $self->name()
244             . ' table.'
245             unless $self->column($name);
246             }
247              
248 328         37505 $_ = $self->column($_) for grep { !blessed $_ } @cols;
  382         1637  
249              
250 328         10298 my $set = Fey::NamedObjectSet->new(@cols);
251              
252             return 1
253 328 100   111   11785 if any { $_->is_same_as($set) } $self->_keys();
  111         471  
254              
255 325         10554 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 4959 sub is_alias {0}
281              
282             sub aliased_column {
283 6     6 1 90 my $self = shift;
284 6         7 my $prefix = shift;
285 6         6 my $name = shift;
286              
287 6 50       14 my $col = $self->column($name)
288             or return;
289              
290 6         715 return $col->alias( alias_name => $prefix . $col->name() );
291             }
292              
293             sub aliased_columns {
294 2     2 1 91 my $self = shift;
295 2         3 my $prefix = shift;
296              
297 2 100       17 my @names = @_ ? @_ : map { $_->name() } $self->columns();
  3         164  
298              
299 2         5 return map { $self->aliased_column( $prefix, $_ ) } @names;
  5         10  
300             }
301              
302             sub sql {
303 129     129 1 2576 return $_[1]->quote_identifier( $_[0]->name() );
304             }
305              
306 5     5 1 20 sub sql_for_select_clause { $_[0]->sql( $_[1] ) . '.*' }
307              
308 124     124 1 353 sub sql_with_alias { goto &sql }
309              
310 23     23   509 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.42
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