1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.9 2003-06-09 04:11:57 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::Field - SQL::Translator field object
31 use SQL::Translator::Schema::Field;
32 my $field = SQL::Translator::Schema::Field->new(
34 sql => 'select * from foo',
39 C<SQL::Translator::Schema::Field> is the field object.
47 use SQL::Translator::Schema::Constants;
48 use SQL::Translator::Utils 'parse_list_arg';
50 use base 'Class::Base';
51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
55 # ----------------------------------------------------------------------
64 my $schema = SQL::Translator::Schema::Field->new;
68 my ( $self, $config ) = @_;
72 table name data_type size is_primary_key is_nullable
73 is_auto_increment default_value comments
76 next unless defined $config->{ $arg };
77 defined $self->$arg( $config->{ $arg } ) or return;
83 # ----------------------------------------------------------------------
90 Get or set the comments on a field. May be called several times to
91 set and it will accumulate the comments. Called in an array context,
92 returns each comment individually; called in a scalar context, returns
93 all the comments joined on newlines.
95 $field->comments('foo');
96 $field->comments('bar');
97 print join( ', ', $field->comments ); # prints "foo, bar"
104 $arg = $arg->[0] if ref $arg;
105 push @{ $self->{'comments'} }, $arg;
109 ? @{ $self->{'comments'} || [] }
110 : join( "\n", @{ $self->{'comments'} || [] } );
114 # ----------------------------------------------------------------------
121 Get or set the field's data type.
123 my $data_type = $field->data_type('integer');
128 $self->{'data_type'} = shift if @_;
129 return $self->{'data_type'} || '';
132 # ----------------------------------------------------------------------
139 Get or set the field's default value. Will return undef if not defined
140 and could return the empty string (it's a valid default value), so don't
141 assume an error like other methods.
143 my $default = $field->default_value('foo');
147 my ( $self, $arg ) = @_;
148 $self->{'default_value'} = $arg if defined $arg;
149 return $self->{'default_value'};
152 # ----------------------------------------------------------------------
159 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
160 Accepts a hash(ref) of name/value pairs to store; returns a hash.
162 $field->extra( qualifier => 'ZEROFILL' );
163 my %extra = $field->extra;
168 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
170 while ( my ( $key, $value ) = each %$args ) {
171 $self->{'extra'}{ $key } = $value;
174 return %{ $self->{'extra'} || {} };
177 # ----------------------------------------------------------------------
178 sub foreign_key_reference {
182 =head2 foreign_key_reference
184 Get or set the field's foreign key reference;
186 my $constraint = $field->foreign_key_reference( $constraint );
192 if ( my $arg = shift ) {
193 my $class = 'SQL::Translator::Schema::Constraint';
194 if ( UNIVERSAL::isa( $arg, $class ) ) {
196 'Foreign key reference for ', $self->name, 'already defined'
197 ) if $self->{'foreign_key_reference'};
199 $self->{'foreign_key_reference'} = $arg;
203 "Argument to foreign_key_reference is not an $class object"
208 return $self->{'foreign_key_reference'};
211 # ----------------------------------------------------------------------
212 sub is_auto_increment {
216 =head2 is_auto_increment
218 Get or set the field's C<is_auto_increment> attribute.
220 my $is_pk = $field->is_auto_increment(1);
224 my ( $self, $arg ) = @_;
226 if ( defined $arg ) {
227 $self->{'is_auto_increment'} = $arg ? 1 : 0;
230 unless ( defined $self->{'is_auto_increment'} ) {
231 if ( my $table = $self->table ) {
232 if ( my $schema = $table->schema ) {
234 $schema->database eq 'PostgreSQL' &&
235 $self->data_type eq 'serial'
237 $self->{'is_auto_increment'} = 1;
243 return $self->{'is_auto_increment'} || 0;
246 # ----------------------------------------------------------------------
251 =head2 is_foreign_key
253 Returns whether or not the field is a foreign key.
255 my $is_fk = $field->is_foreign_key;
259 my ( $self, $arg ) = @_;
261 unless ( defined $self->{'is_foreign_key'} ) {
262 if ( my $table = $self->table ) {
263 for my $c ( $table->get_constraints ) {
264 if ( $c->type eq FOREIGN_KEY ) {
265 my %fields = map { $_, 1 } $c->fields;
266 if ( $fields{ $self->name } ) {
267 $self->{'is_foreign_key'} = 1;
268 $self->foreign_key_reference( $c );
276 return $self->{'is_foreign_key'} || 0;
279 # ----------------------------------------------------------------------
286 Get or set the whether the field can be null. If not defined, then
287 returns "1" (assumes the field can be null). The argument is evaluated
288 by Perl for True or False, so the following are eqivalent:
290 $is_nullable = $field->is_nullable(0);
291 $is_nullable = $field->is_nullable('');
292 $is_nullable = $field->is_nullable('0');
294 While this is technically a field constraint, it's probably easier to
295 represent this as an attribute of the field. In order keep things
296 consistent, any other constraint on the field (unique, primary, and
297 foreign keys; checks) are represented as table constraints.
301 my ( $self, $arg ) = @_;
303 if ( defined $arg ) {
304 $self->{'is_nullable'} = $arg ? 1 : 0;
307 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
310 # ----------------------------------------------------------------------
315 =head2 is_primary_key
317 Get or set the field's C<is_primary_key> attribute. Does not create
318 a table constraint (should it?).
320 my $is_pk = $field->is_primary_key(1);
324 my ( $self, $arg ) = @_;
326 if ( defined $arg ) {
327 $self->{'is_primary_key'} = $arg ? 1 : 0;
330 unless ( defined $self->{'is_primary_key'} ) {
331 if ( my $table = $self->table ) {
332 if ( my $pk = $table->primary_key ) {
333 my %fields = map { $_, 1 } $pk->fields;
334 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
337 $self->{'is_primary_key'} = 0;
342 return $self->{'is_primary_key'} || 0;
345 # ----------------------------------------------------------------------
352 Determine whether the field has a UNIQUE constraint or not.
354 my $is_unique = $field->is_unique;
360 unless ( defined $self->{'is_unique'} ) {
361 if ( my $table = $self->table ) {
362 for my $c ( $table->get_constraints ) {
363 if ( $c->type eq UNIQUE ) {
364 my %fields = map { $_, 1 } $c->fields;
365 if ( $fields{ $self->name } ) {
366 $self->{'is_unique'} = 1;
374 return $self->{'is_unique'} || 0;
377 # ----------------------------------------------------------------------
384 Determine whether the field is valid or not.
386 my $ok = $field->is_valid;
391 return $self->error('No name') unless $self->name;
392 return $self->error('No data type') unless $self->data_type;
393 return $self->error('No table object') unless $self->table;
397 # ----------------------------------------------------------------------
404 Get or set the field's name.
406 my $name = $field->name('foo');
412 if ( my $arg = shift ) {
413 if ( my $table = $self->table ) {
414 return $self->error( qq[Can't use field name "$arg": table exists] )
415 if $table->get_field( $arg );
418 $self->{'name'} = $arg;
421 return $self->{'name'} || '';
424 # ----------------------------------------------------------------------
431 Get or set the field's order.
433 my $order = $field->order(3);
437 my ( $self, $arg ) = @_;
439 if ( defined $arg && $arg =~ /^\d+$/ ) {
440 $self->{'order'} = $arg;
443 return $self->{'order'} || 0;
446 # ----------------------------------------------------------------------
453 Get or set the field's size. Accepts a string, array or arrayref of
454 numbers and returns a string.
457 $field->size( [ 255 ] );
458 $size = $field->size( 10, 2 );
459 print $size; # prints "10,2"
461 $size = $field->size( '10, 2' );
462 print $size; # prints "10,2"
467 my $numbers = parse_list_arg( @_ );
471 for my $num ( @$numbers ) {
472 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
476 $self->{'size'} = \@new if @new; # only set if all OK
480 ? @{ $self->{'size'} || [0] }
481 : join( ',', @{ $self->{'size'} || [0] } )
485 # ----------------------------------------------------------------------
492 Get or set the field's table object.
494 my $table = $field->table;
499 if ( my $arg = shift ) {
500 return $self->error('Not a table object') unless
501 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
502 $self->{'table'} = $arg;
505 return $self->{'table'};
508 # ----------------------------------------------------------------------
511 # Destroy cyclical references.
514 undef $self->{'table'};
515 undef $self->{'foreign_key_reference'};
520 # ----------------------------------------------------------------------
526 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>