1 package SQL::Translator::Schema::Table;
3 # ----------------------------------------------------------------------
4 # $Id: Table.pm,v 1.4 2003-05-07 20:42:34 kycl4rk Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
27 SQL::Translator::Schema::Table - SQL::Translator table object
31 use SQL::Translator::Schema::Table;
32 my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
36 C<SQL::Translator::Schema::Table> is the table object.
44 use SQL::Translator::Schema::Constants;
45 use SQL::Translator::Schema::Constraint;
46 use SQL::Translator::Schema::Field;
47 use SQL::Translator::Schema::Index;
49 use base 'Class::Base';
50 use vars qw( $VERSION $FIELD_ORDER );
54 # ----------------------------------------------------------------------
63 my $table = SQL::Translator::Schema::Table->new(
70 my ( $self, $config ) = @_;
72 for my $arg ( qw[ schema name ] ) {
73 next unless defined $config->{ $arg };
74 $self->$arg( $config->{ $arg } ) or return;
80 # ----------------------------------------------------------------------
87 Get or set the table's name.
89 If provided an argument, checks the schema object for a table of
90 that name and disallows the change if one exists.
92 my $table_name = $table->name('foo');
98 if ( my $arg = shift ) {
99 if ( my $schema = $self->schema ) {
100 return $self->error( qq[Can't use table name "$arg": table exists] )
101 if $schema->get_table( $arg );
103 $self->{'name'} = $arg;
106 return $self->{'name'} || '';
109 # ----------------------------------------------------------------------
114 =head2 add_constraint
116 Add a constraint to the table. Returns the newly created
117 C<SQL::Translator::Schema::Constraint> object.
119 my $constraint1 = $table->add_constraint(
122 fields => [ 'foo_id' ],
125 my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
126 $constraint2 = $table->add_constraint( $constraint );
131 my $constraint_class = 'SQL::Translator::Schema::Constraint';
134 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
136 $constraint->table( $self );
140 $args{'table'} = $self;
141 $constraint = $constraint_class->new( \%args ) or
142 return $self->error( $constraint_class->error );
145 push @{ $self->{'constraints'} }, $constraint;
149 # ----------------------------------------------------------------------
156 Add an index to the table. Returns the newly created
157 C<SQL::Translator::Schema::Index> object.
159 my $index1 = $table->add_index(
161 fields => [ 'name' ],
165 my $index2 = SQL::Translator::Schema::Index->new( name => 'id' );
166 $index2 = $table->add_index( $index );
171 my $index_class = 'SQL::Translator::Schema::Index';
174 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
176 $index->table( $self );
180 $args{'table'} = $self;
181 $index = $index_class->new( \%args ) or return
182 $self->error( $index_class->error );
185 push @{ $self->{'indices'} }, $index;
189 # ----------------------------------------------------------------------
196 Add an field to the table. Returns the newly created
197 C<SQL::Translator::Schema::Field> object. The "name" parameter is
198 required. If you try to create a field with the same name as an
199 existing field, you will get an error and the field will not be created.
201 my $field1 = $table->add_field(
203 data_type => 'integer',
207 my $field2 = SQL::Translator::Schema::Field->new(
211 $field2 = $table->add_field( $field2 ) or die $table->error;
216 my $field_class = 'SQL::Translator::Schema::Field';
219 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
221 $field->table( $self );
225 $args{'table'} = $self;
226 $field = $field_class->new( \%args ) or return
227 $self->error( $field_class->error );
230 my $field_name = $field->name or return $self->error('No name');
232 if ( exists $self->{'fields'}{ $field_name } ) {
233 return $self->error(qq[Can't create field: "$field_name" exists]);
236 $self->{'fields'}{ $field_name } = $field;
237 $self->{'fields'}{ $field_name }{'order'} = ++$FIELD_ORDER;
243 # ----------------------------------------------------------------------
244 sub get_constraints {
248 =head2 get_constraints
250 Returns all the constraint objects as an array or array reference.
252 my @constraints = $table->get_constraints;
258 if ( ref $self->{'constraints'} ) {
260 ? @{ $self->{'constraints'} } : $self->{'constraints'};
263 $self->error('No constraints');
264 return wantarray ? () : undef;
268 # ----------------------------------------------------------------------
275 Returns all the index objects as an array or array reference.
277 my @indices = $table->get_indices;
283 if ( ref $self->{'indices'} ) {
285 ? @{ $self->{'indices'} }
286 : $self->{'indices'};
289 $self->error('No indices');
290 return wantarray ? () : undef;
294 # ----------------------------------------------------------------------
301 Returns a field by the name provided.
303 my $field = $table->get_field('foo');
308 my $field_name = shift or return $self->error('No field name');
309 return $self->error( qq[Field "$field_name" does not exist] ) unless
310 exists $self->{'fields'}{ $field_name };
311 return $self->{'fields'}{ $field_name };
314 # ----------------------------------------------------------------------
321 Returns all the field objects as an array or array reference.
323 my @fields = $table->get_fields;
329 sort { $a->{'order'} <=> $b->{'order'} }
330 values %{ $self->{'fields'} || {} };
333 return wantarray ? @fields : \@fields;
336 $self->error('No fields');
337 return wantarray ? () : undef;
341 # ----------------------------------------------------------------------
348 Determine whether the view is valid or not.
350 my $ok = $view->is_valid;
355 return $self->error('No name') unless $self->name;
356 return $self->error('No fields') unless $self->get_fields;
359 $self->get_fields, $self->get_indices, $self->get_constraints
361 return $object->error unless $object->is_valid;
367 # ----------------------------------------------------------------------
374 Get or set the table's schema object.
376 my $schema = $table->schema;
381 if ( my $arg = shift ) {
382 return $self->error('Not a schema object') unless
383 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
384 $self->{'schema'} = $arg;
387 return $self->{'schema'};
390 # ----------------------------------------------------------------------
397 Gets or sets the table's primary key(s). Takes one or more field
398 names (as a string, list or array[ref]) as an argument. If the field
399 names are present, it will create a new PK if none exists, or it will
400 add to the fields of an existing PK (and will unique the field names).
401 Returns the C<SQL::Translator::Schema::Constraint> object representing
406 $table->primary_key('id');
407 $table->primary_key(['name']);
408 $table->primary_key('id','name']);
409 $table->primary_key(['id','name']);
410 $table->primary_key('id,name');
411 $table->primary_key(qw[ id name ]);
413 my $pk = $table->primary_key;
418 my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
419 ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
423 for my $f ( @$fields ) {
424 return $self->error(qq[Invalid field "$f"]) unless
425 $self->get_field($f);
429 for my $c ( $self->get_constraints ) {
430 if ( $c->type eq PRIMARY_KEY ) {
432 $c->fields( @{ $c->fields }, @$fields );
438 $constraint = $self->add_constraint(
449 for my $c ( $self->get_constraints ) {
450 return $c if $c->type eq PRIMARY_KEY;
454 return $self->error('No primary key');
457 # ----------------------------------------------------------------------
464 Get or set the table's options (e.g., table types for MySQL). Returns
465 an array or array reference.
467 my @options = $table->options;
472 my $options = UNIVERSAL::isa( $_[0], 'ARRAY' )
473 ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
475 push @{ $self->{'options'} }, @$options;
477 if ( ref $self->{'options'} ) {
478 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
481 return wantarray ? () : [];
487 # ----------------------------------------------------------------------
493 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>