1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.27 2007-10-24 10:55:44 schiffbruechige 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.27 $ =~ /(\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 is_foreign_key
69 is_unique order sql_data_type
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'} || '';
143 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
149 $self->{sql_data_type} = shift if @_;
150 return $self->{sql_data_type} || 0;
154 # ----------------------------------------------------------------------
161 Get or set the field's default value. Will return undef if not defined
162 and could return the empty string (it's a valid default value), so don't
163 assume an error like other methods.
165 my $default = $field->default_value('foo');
169 my ( $self, $arg ) = @_;
170 $self->{'default_value'} = $arg if defined $arg;
171 return $self->{'default_value'};
174 # ----------------------------------------------------------------------
179 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
180 Accepts a hash(ref) of name/value pairs to store; returns a hash.
182 $field->extra( qualifier => 'ZEROFILL' );
183 my %extra = $field->extra;
188 # ----------------------------------------------------------------------
189 sub foreign_key_reference {
193 =head2 foreign_key_reference
195 Get or set the field's foreign key reference;
197 my $constraint = $field->foreign_key_reference( $constraint );
203 if ( my $arg = shift ) {
204 my $class = 'SQL::Translator::Schema::Constraint';
205 if ( UNIVERSAL::isa( $arg, $class ) ) {
207 'Foreign key reference for ', $self->name, 'already defined'
208 ) if $self->{'foreign_key_reference'};
210 $self->{'foreign_key_reference'} = $arg;
214 "Argument to foreign_key_reference is not an $class object"
219 return $self->{'foreign_key_reference'};
222 # ----------------------------------------------------------------------
223 sub is_auto_increment {
227 =head2 is_auto_increment
229 Get or set the field's C<is_auto_increment> attribute.
231 my $is_auto = $field->is_auto_increment(1);
235 my ( $self, $arg ) = @_;
237 if ( defined $arg ) {
238 $self->{'is_auto_increment'} = $arg ? 1 : 0;
241 unless ( defined $self->{'is_auto_increment'} ) {
242 if ( my $table = $self->table ) {
243 if ( my $schema = $table->schema ) {
245 $schema->database eq 'PostgreSQL' &&
246 $self->data_type eq 'serial'
248 $self->{'is_auto_increment'} = 1;
254 return $self->{'is_auto_increment'} || 0;
257 # ----------------------------------------------------------------------
262 =head2 is_foreign_key
264 Returns whether or not the field is a foreign key.
266 my $is_fk = $field->is_foreign_key;
270 my ( $self, $arg ) = @_;
272 unless ( defined $self->{'is_foreign_key'} ) {
273 if ( my $table = $self->table ) {
274 for my $c ( $table->get_constraints ) {
275 if ( $c->type eq FOREIGN_KEY ) {
276 my %fields = map { $_, 1 } $c->fields;
277 if ( $fields{ $self->name } ) {
278 $self->{'is_foreign_key'} = 1;
279 $self->foreign_key_reference( $c );
287 return $self->{'is_foreign_key'} || 0;
290 # ----------------------------------------------------------------------
297 Get or set whether the field can be null. If not defined, then
298 returns "1" (assumes the field can be null). The argument is evaluated
299 by Perl for True or False, so the following are eqivalent:
301 $is_nullable = $field->is_nullable(0);
302 $is_nullable = $field->is_nullable('');
303 $is_nullable = $field->is_nullable('0');
305 While this is technically a field constraint, it's probably easier to
306 represent this as an attribute of the field. In order keep things
307 consistent, any other constraint on the field (unique, primary, and
308 foreign keys; checks) are represented as table constraints.
312 my ( $self, $arg ) = @_;
314 if ( defined $arg ) {
315 $self->{'is_nullable'} = $arg ? 1 : 0;
319 defined $self->{'is_nullable'} &&
320 $self->{'is_nullable'} == 1 &&
321 $self->is_primary_key
323 $self->{'is_nullable'} = 0;
326 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
329 # ----------------------------------------------------------------------
334 =head2 is_primary_key
336 Get or set the field's C<is_primary_key> attribute. Does not create
337 a table constraint (should it?).
339 my $is_pk = $field->is_primary_key(1);
343 my ( $self, $arg ) = @_;
345 if ( defined $arg ) {
346 $self->{'is_primary_key'} = $arg ? 1 : 0;
349 unless ( defined $self->{'is_primary_key'} ) {
350 if ( my $table = $self->table ) {
351 if ( my $pk = $table->primary_key ) {
352 my %fields = map { $_, 1 } $pk->fields;
353 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
356 $self->{'is_primary_key'} = 0;
361 return $self->{'is_primary_key'} || 0;
364 # ----------------------------------------------------------------------
371 Determine whether the field has a UNIQUE constraint or not.
373 my $is_unique = $field->is_unique;
379 unless ( defined $self->{'is_unique'} ) {
380 if ( my $table = $self->table ) {
381 for my $c ( $table->get_constraints ) {
382 if ( $c->type eq UNIQUE ) {
383 my %fields = map { $_, 1 } $c->fields;
384 if ( $fields{ $self->name } ) {
385 $self->{'is_unique'} = 1;
393 return $self->{'is_unique'} || 0;
396 # ----------------------------------------------------------------------
403 Determine whether the field is valid or not.
405 my $ok = $field->is_valid;
410 return $self->error('No name') unless $self->name;
411 return $self->error('No data type') unless $self->data_type;
412 return $self->error('No table object') unless $self->table;
416 # ----------------------------------------------------------------------
423 Get or set the field's name.
425 my $name = $field->name('foo');
427 The field object will also stringify to its name.
429 my $setter_name = "set_$field";
431 Errors ("No field name") if you try to set a blank name.
438 my $arg = shift || return $self->error( "No field name" );
439 if ( my $table = $self->table ) {
440 return $self->error( qq[Can't use field name "$arg": field exists] )
441 if $table->get_field( $arg );
444 $self->{'name'} = $arg;
447 return $self->{'name'} || '';
454 Read only method to return the fields name with its table name pre-pended.
460 return $self->table.".".$self->name;
463 # ----------------------------------------------------------------------
470 Get or set the field's order.
472 my $order = $field->order(3);
476 my ( $self, $arg ) = @_;
478 if ( defined $arg && $arg =~ /^\d+$/ ) {
479 $self->{'order'} = $arg;
482 return $self->{'order'} || 0;
485 # ----------------------------------------------------------------------
490 Shortcut to get the fields schema ($field->table->schema) or undef if it
493 my $schema = $field->schema;
498 if ( my $table = $self->table ) { return $table->schema || undef; }
502 # ----------------------------------------------------------------------
509 Get or set the field's size. Accepts a string, array or arrayref of
510 numbers and returns a string.
513 $field->size( [ 255 ] );
514 $size = $field->size( 10, 2 );
515 print $size; # prints "10,2"
517 $size = $field->size( '10, 2' );
518 print $size; # prints "10,2"
523 my $numbers = parse_list_arg( @_ );
527 for my $num ( @$numbers ) {
528 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
532 $self->{'size'} = \@new if @new; # only set if all OK
536 ? @{ $self->{'size'} || [0] }
537 : join( ',', @{ $self->{'size'} || [0] } )
541 # ----------------------------------------------------------------------
548 Get or set the field's table object. As the table object stringifies this can
549 also be used to get the table name.
551 my $table = $field->table;
552 print "Table name: $table";
557 if ( my $arg = shift ) {
558 return $self->error('Not a table object') unless
559 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
560 $self->{'table'} = $arg;
563 return $self->{'table'};
570 Returns the field exactly as the parser found it
578 $self->{parsed_field} = $value;
579 return $value || $self;
581 return $self->{parsed_field} || $self;
584 # ----------------------------------------------------------------------
591 Determines if this field is the same as another
593 my $isIdentical = $field1->equals( $field2 );
599 my $case_insensitive = shift;
601 return 0 unless $self->SUPER::equals($other);
602 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
604 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
605 if ($self->sql_data_type && $other->sql_data_type) {
606 return 0 unless $self->sql_data_type == $other->sql_data_type
608 return 0 unless lc($self->data_type) eq lc($other->data_type)
611 return 0 unless $self->size eq $other->size;
612 return 0 unless (!defined $self->default_value || $self->default_value eq 'NULL') eq (!defined $other->default_value || $other->default_value eq 'NULL');
613 return 0 if defined $self->default_value && $self->default_value ne $other->default_value;
614 return 0 unless $self->is_nullable eq $other->is_nullable;
615 # return 0 unless $self->is_unique eq $other->is_unique;
616 return 0 unless $self->is_primary_key eq $other->is_primary_key;
617 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
618 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
619 # return 0 unless $self->comments eq $other->comments;
620 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
624 # ----------------------------------------------------------------------
627 # Destroy cyclical references.
630 undef $self->{'table'};
631 undef $self->{'foreign_key_reference'};
636 # ----------------------------------------------------------------------
642 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.