1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.21 2004-11-05 13:19:31 grommit Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
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(
39 C<SQL::Translator::Schema::Field> is the field object.
46 use SQL::Translator::Schema::Constants;
47 use SQL::Translator::Utils 'parse_list_arg';
49 use base 'SQL::Translator::Schema::Object';
51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
53 $VERSION = sprintf "%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/;
55 # Stringify to our name, being careful not to pass any args through so we don't
56 # accidentally set it to undef. We also have to tweak bool so the object is
57 # still true when it doesn't have a name (which shouldn't happen!).
59 '""' => sub { shift->name },
60 'bool' => sub { $_[0]->name || $_[0] },
64 # ----------------------------------------------------------------------
66 __PACKAGE__->_attributes( qw/
67 table name data_type size is_primary_key is_nullable
68 is_auto_increment default_value comments extra is_foreign_key
78 my $field = SQL::Translator::Schema::Field->new(
85 # ----------------------------------------------------------------------
92 Get or set the comments on a field. May be called several times to
93 set and it will accumulate the comments. Called in an array context,
94 returns each comment individually; called in a scalar context, returns
95 all the comments joined on newlines.
97 $field->comments('foo');
98 $field->comments('bar');
99 print join( ', ', $field->comments ); # prints "foo, bar"
106 $arg = $arg->[0] if ref $arg;
107 push @{ $self->{'comments'} }, $arg if $arg;
110 if ( @{ $self->{'comments'} || [] } ) {
112 ? @{ $self->{'comments'} || [] }
113 : join( "\n", @{ $self->{'comments'} || [] } );
116 return wantarray ? () : '';
121 # ----------------------------------------------------------------------
128 Get or set the field's data type.
130 my $data_type = $field->data_type('integer');
135 $self->{'data_type'} = shift if @_;
136 return $self->{'data_type'} || '';
139 # ----------------------------------------------------------------------
146 Get or set the field's default value. Will return undef if not defined
147 and could return the empty string (it's a valid default value), so don't
148 assume an error like other methods.
150 my $default = $field->default_value('foo');
154 my ( $self, $arg ) = @_;
155 $self->{'default_value'} = $arg if defined $arg;
156 return $self->{'default_value'};
159 # ----------------------------------------------------------------------
166 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
167 Accepts a hash(ref) of name/value pairs to store; returns a hash.
169 $field->extra( qualifier => 'ZEROFILL' );
170 my %extra = $field->extra;
175 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
177 while ( my ( $key, $value ) = each %$args ) {
178 $self->{'extra'}{ $key } = $value;
181 return %{ $self->{'extra'} || {} };
184 # ----------------------------------------------------------------------
185 sub foreign_key_reference {
189 =head2 foreign_key_reference
191 Get or set the field's foreign key reference;
193 my $constraint = $field->foreign_key_reference( $constraint );
199 if ( my $arg = shift ) {
200 my $class = 'SQL::Translator::Schema::Constraint';
201 if ( UNIVERSAL::isa( $arg, $class ) ) {
203 'Foreign key reference for ', $self->name, 'already defined'
204 ) if $self->{'foreign_key_reference'};
206 $self->{'foreign_key_reference'} = $arg;
210 "Argument to foreign_key_reference is not an $class object"
215 return $self->{'foreign_key_reference'};
218 # ----------------------------------------------------------------------
219 sub is_auto_increment {
223 =head2 is_auto_increment
225 Get or set the field's C<is_auto_increment> attribute.
227 my $is_auto = $field->is_auto_increment(1);
231 my ( $self, $arg ) = @_;
233 if ( defined $arg ) {
234 $self->{'is_auto_increment'} = $arg ? 1 : 0;
237 unless ( defined $self->{'is_auto_increment'} ) {
238 if ( my $table = $self->table ) {
239 if ( my $schema = $table->schema ) {
241 $schema->database eq 'PostgreSQL' &&
242 $self->data_type eq 'serial'
244 $self->{'is_auto_increment'} = 1;
250 return $self->{'is_auto_increment'} || 0;
253 # ----------------------------------------------------------------------
258 =head2 is_foreign_key
260 Returns whether or not the field is a foreign key.
262 my $is_fk = $field->is_foreign_key;
266 my ( $self, $arg ) = @_;
268 unless ( defined $self->{'is_foreign_key'} ) {
269 if ( my $table = $self->table ) {
270 for my $c ( $table->get_constraints ) {
271 if ( $c->type eq FOREIGN_KEY ) {
272 my %fields = map { $_, 1 } $c->fields;
273 if ( $fields{ $self->name } ) {
274 $self->{'is_foreign_key'} = 1;
275 $self->foreign_key_reference( $c );
283 return $self->{'is_foreign_key'} || 0;
286 # ----------------------------------------------------------------------
293 Get or set whether the field can be null. If not defined, then
294 returns "1" (assumes the field can be null). The argument is evaluated
295 by Perl for True or False, so the following are eqivalent:
297 $is_nullable = $field->is_nullable(0);
298 $is_nullable = $field->is_nullable('');
299 $is_nullable = $field->is_nullable('0');
301 While this is technically a field constraint, it's probably easier to
302 represent this as an attribute of the field. In order keep things
303 consistent, any other constraint on the field (unique, primary, and
304 foreign keys; checks) are represented as table constraints.
308 my ( $self, $arg ) = @_;
310 if ( defined $arg ) {
311 $self->{'is_nullable'} = $arg ? 1 : 0;
315 defined $self->{'is_nullable'} &&
316 $self->{'is_nullable'} == 1 &&
317 $self->is_primary_key
319 $self->{'is_nullable'} = 0;
322 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
325 # ----------------------------------------------------------------------
330 =head2 is_primary_key
332 Get or set the field's C<is_primary_key> attribute. Does not create
333 a table constraint (should it?).
335 my $is_pk = $field->is_primary_key(1);
339 my ( $self, $arg ) = @_;
341 if ( defined $arg ) {
342 $self->{'is_primary_key'} = $arg ? 1 : 0;
345 unless ( defined $self->{'is_primary_key'} ) {
346 if ( my $table = $self->table ) {
347 if ( my $pk = $table->primary_key ) {
348 my %fields = map { $_, 1 } $pk->fields;
349 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
352 $self->{'is_primary_key'} = 0;
357 return $self->{'is_primary_key'} || 0;
360 # ----------------------------------------------------------------------
367 Determine whether the field has a UNIQUE constraint or not.
369 my $is_unique = $field->is_unique;
375 unless ( defined $self->{'is_unique'} ) {
376 if ( my $table = $self->table ) {
377 for my $c ( $table->get_constraints ) {
378 if ( $c->type eq UNIQUE ) {
379 my %fields = map { $_, 1 } $c->fields;
380 if ( $fields{ $self->name } ) {
381 $self->{'is_unique'} = 1;
389 return $self->{'is_unique'} || 0;
392 # ----------------------------------------------------------------------
399 Determine whether the field is valid or not.
401 my $ok = $field->is_valid;
406 return $self->error('No name') unless $self->name;
407 return $self->error('No data type') unless $self->data_type;
408 return $self->error('No table object') unless $self->table;
412 # ----------------------------------------------------------------------
419 Get or set the field's name.
421 my $name = $field->name('foo');
423 The field object will also stringify to its name.
425 my $setter_name = "set_$field";
427 Errors ("No field name") if you try to set a blank name.
434 my $arg = shift || return $self->error( "No field name" );
435 if ( my $table = $self->table ) {
436 return $self->error( qq[Can't use field name "$arg": field exists] )
437 if $table->get_field( $arg );
440 $self->{'name'} = $arg;
443 return $self->{'name'} || '';
450 Read only method to return the fields name with its table name pre-pended.
456 return $self->table.".".$self->name;
459 # ----------------------------------------------------------------------
466 Get or set the field's order.
468 my $order = $field->order(3);
472 my ( $self, $arg ) = @_;
474 if ( defined $arg && $arg =~ /^\d+$/ ) {
475 $self->{'order'} = $arg;
478 return $self->{'order'} || 0;
481 # ----------------------------------------------------------------------
486 Shortcut to get the fields schema ($field->table->schema) or undef if it
489 my $schema = $field->schema;
494 if ( my $table = $self->table ) { return $table->schema || undef; }
498 # ----------------------------------------------------------------------
505 Get or set the field's size. Accepts a string, array or arrayref of
506 numbers and returns a string.
509 $field->size( [ 255 ] );
510 $size = $field->size( 10, 2 );
511 print $size; # prints "10,2"
513 $size = $field->size( '10, 2' );
514 print $size; # prints "10,2"
519 my $numbers = parse_list_arg( @_ );
523 for my $num ( @$numbers ) {
524 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
528 $self->{'size'} = \@new if @new; # only set if all OK
532 ? @{ $self->{'size'} || [0] }
533 : join( ',', @{ $self->{'size'} || [0] } )
537 # ----------------------------------------------------------------------
544 Get or set the field's table object. As the table object stringifies this can
545 also be used to get the table name.
547 my $table = $field->table;
548 print "Table name: $table";
553 if ( my $arg = shift ) {
554 return $self->error('Not a table object') unless
555 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
556 $self->{'table'} = $arg;
559 return $self->{'table'};
562 # ----------------------------------------------------------------------
565 # Destroy cyclical references.
568 undef $self->{'table'};
569 undef $self->{'foreign_key_reference'};
574 # ----------------------------------------------------------------------
580 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.