1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
25 SQL::Translator::Schema::Field - SQL::Translator field object
29 use SQL::Translator::Schema::Field;
30 my $field = SQL::Translator::Schema::Field->new(
37 C<SQL::Translator::Schema::Field> is the field object.
44 use SQL::Translator::Schema::Constants;
45 use SQL::Translator::Utils 'parse_list_arg';
47 use base 'SQL::Translator::Schema::Object';
49 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
53 # Stringify to our name, being careful not to pass any args through so we don't
54 # accidentally set it to undef. We also have to tweak bool so the object is
55 # still true when it doesn't have a name (which shouldn't happen!).
57 '""' => sub { shift->name },
58 'bool' => sub { $_[0]->name || $_[0] },
62 use DBI qw(:sql_types);
64 # Mapping from string to sql contstant
66 integer => SQL_INTEGER,
69 smallint => SQL_SMALLINT,
70 bigint => 9999, # DBI doesn't export a constatn for this. Le suck
74 decimal => SQL_DECIMAL,
75 numeric => SQL_NUMERIC,
81 datetime => SQL_DATETIME,
82 timestamp => SQL_TIMESTAMP,
86 varchar => SQL_VARCHAR,
88 varbinary => SQL_VARBINARY,
91 text => SQL_LONGVARCHAR
94 # ----------------------------------------------------------------------
96 __PACKAGE__->_attributes( qw/
97 table name data_type size is_primary_key is_nullable
98 is_auto_increment default_value comments is_foreign_key
99 is_unique order sql_data_type
108 my $field = SQL::Translator::Schema::Field->new(
115 # ----------------------------------------------------------------------
122 Get or set the comments on a field. May be called several times to
123 set and it will accumulate the comments. Called in an array context,
124 returns each comment individually; called in a scalar context, returns
125 all the comments joined on newlines.
127 $field->comments('foo');
128 $field->comments('bar');
129 print join( ', ', $field->comments ); # prints "foo, bar"
136 $arg = $arg->[0] if ref $arg;
137 push @{ $self->{'comments'} }, $arg if $arg;
140 if ( @{ $self->{'comments'} || [] } ) {
142 ? @{ $self->{'comments'} || [] }
143 : join( "\n", @{ $self->{'comments'} || [] } );
146 return wantarray ? () : '';
151 # ----------------------------------------------------------------------
158 Get or set the field's data type.
160 my $data_type = $field->data_type('integer');
166 $self->{'data_type'} = $_[0];
167 $self->{'sql_data_type'} = $type_mapping{lc $_[0]} || SQL_UNKNOWN_TYPE unless exists $self->{sql_data_type};
169 return $self->{'data_type'} || '';
176 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
182 $self->{sql_data_type} = shift if @_;
183 return $self->{sql_data_type} || 0;
187 # ----------------------------------------------------------------------
194 Get or set the field's default value. Will return undef if not defined
195 and could return the empty string (it's a valid default value), so don't
196 assume an error like other methods.
198 my $default = $field->default_value('foo');
202 my ( $self, $arg ) = @_;
203 $self->{'default_value'} = $arg if defined $arg;
204 return $self->{'default_value'};
207 # ----------------------------------------------------------------------
212 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
213 Accepts a hash(ref) of name/value pairs to store; returns a hash.
215 $field->extra( qualifier => 'ZEROFILL' );
216 my %extra = $field->extra;
221 # ----------------------------------------------------------------------
222 sub foreign_key_reference {
226 =head2 foreign_key_reference
228 Get or set the field's foreign key reference;
230 my $constraint = $field->foreign_key_reference( $constraint );
236 if ( my $arg = shift ) {
237 my $class = 'SQL::Translator::Schema::Constraint';
238 if ( UNIVERSAL::isa( $arg, $class ) ) {
240 'Foreign key reference for ', $self->name, 'already defined'
241 ) if $self->{'foreign_key_reference'};
243 $self->{'foreign_key_reference'} = $arg;
247 "Argument to foreign_key_reference is not an $class object"
252 return $self->{'foreign_key_reference'};
255 # ----------------------------------------------------------------------
256 sub is_auto_increment {
260 =head2 is_auto_increment
262 Get or set the field's C<is_auto_increment> attribute.
264 my $is_auto = $field->is_auto_increment(1);
268 my ( $self, $arg ) = @_;
270 if ( defined $arg ) {
271 $self->{'is_auto_increment'} = $arg ? 1 : 0;
274 unless ( defined $self->{'is_auto_increment'} ) {
275 if ( my $table = $self->table ) {
276 if ( my $schema = $table->schema ) {
278 $schema->database eq 'PostgreSQL' &&
279 $self->data_type eq 'serial'
281 $self->{'is_auto_increment'} = 1;
287 return $self->{'is_auto_increment'} || 0;
290 # ----------------------------------------------------------------------
295 =head2 is_foreign_key
297 Returns whether or not the field is a foreign key.
299 my $is_fk = $field->is_foreign_key;
303 my ( $self, $arg ) = @_;
305 unless ( defined $self->{'is_foreign_key'} ) {
306 if ( my $table = $self->table ) {
307 for my $c ( $table->get_constraints ) {
308 if ( $c->type eq FOREIGN_KEY ) {
309 my %fields = map { $_, 1 } $c->fields;
310 if ( $fields{ $self->name } ) {
311 $self->{'is_foreign_key'} = 1;
312 $self->foreign_key_reference( $c );
320 return $self->{'is_foreign_key'} || 0;
323 # ----------------------------------------------------------------------
330 Get or set whether the field can be null. If not defined, then
331 returns "1" (assumes the field can be null). The argument is evaluated
332 by Perl for True or False, so the following are eqivalent:
334 $is_nullable = $field->is_nullable(0);
335 $is_nullable = $field->is_nullable('');
336 $is_nullable = $field->is_nullable('0');
338 While this is technically a field constraint, it's probably easier to
339 represent this as an attribute of the field. In order keep things
340 consistent, any other constraint on the field (unique, primary, and
341 foreign keys; checks) are represented as table constraints.
345 my ( $self, $arg ) = @_;
347 if ( defined $arg ) {
348 $self->{'is_nullable'} = $arg ? 1 : 0;
352 defined $self->{'is_nullable'} &&
353 $self->{'is_nullable'} == 1 &&
354 $self->is_primary_key
356 $self->{'is_nullable'} = 0;
359 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
362 # ----------------------------------------------------------------------
367 =head2 is_primary_key
369 Get or set the field's C<is_primary_key> attribute. Does not create
370 a table constraint (should it?).
372 my $is_pk = $field->is_primary_key(1);
376 my ( $self, $arg ) = @_;
378 if ( defined $arg ) {
379 $self->{'is_primary_key'} = $arg ? 1 : 0;
382 unless ( defined $self->{'is_primary_key'} ) {
383 if ( my $table = $self->table ) {
384 if ( my $pk = $table->primary_key ) {
385 my %fields = map { $_, 1 } $pk->fields;
386 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
389 $self->{'is_primary_key'} = 0;
394 return $self->{'is_primary_key'} || 0;
397 # ----------------------------------------------------------------------
404 Determine whether the field has a UNIQUE constraint or not.
406 my $is_unique = $field->is_unique;
412 unless ( defined $self->{'is_unique'} ) {
413 if ( my $table = $self->table ) {
414 for my $c ( $table->get_constraints ) {
415 if ( $c->type eq UNIQUE ) {
416 my %fields = map { $_, 1 } $c->fields;
417 if ( $fields{ $self->name } ) {
418 $self->{'is_unique'} = 1;
426 return $self->{'is_unique'} || 0;
429 # ----------------------------------------------------------------------
436 Determine whether the field is valid or not.
438 my $ok = $field->is_valid;
443 return $self->error('No name') unless $self->name;
444 return $self->error('No data type') unless $self->data_type;
445 return $self->error('No table object') unless $self->table;
449 # ----------------------------------------------------------------------
456 Get or set the field's name.
458 my $name = $field->name('foo');
460 The field object will also stringify to its name.
462 my $setter_name = "set_$field";
464 Errors ("No field name") if you try to set a blank name.
471 my $arg = shift || return $self->error( "No field name" );
472 if ( my $table = $self->table ) {
473 return $self->error( qq[Can't use field name "$arg": field exists] )
474 if $table->get_field( $arg );
477 $self->{'name'} = $arg;
480 return $self->{'name'} || '';
487 Read only method to return the fields name with its table name pre-pended.
493 return $self->table.".".$self->name;
496 # ----------------------------------------------------------------------
503 Get or set the field's order.
505 my $order = $field->order(3);
509 my ( $self, $arg ) = @_;
511 if ( defined $arg && $arg =~ /^\d+$/ ) {
512 $self->{'order'} = $arg;
515 return $self->{'order'} || 0;
518 # ----------------------------------------------------------------------
523 Shortcut to get the fields schema ($field->table->schema) or undef if it
526 my $schema = $field->schema;
531 if ( my $table = $self->table ) { return $table->schema || undef; }
535 # ----------------------------------------------------------------------
542 Get or set the field's size. Accepts a string, array or arrayref of
543 numbers and returns a string.
546 $field->size( [ 255 ] );
547 $size = $field->size( 10, 2 );
548 print $size; # prints "10,2"
550 $size = $field->size( '10, 2' );
551 print $size; # prints "10,2"
556 my $numbers = parse_list_arg( @_ );
560 for my $num ( @$numbers ) {
561 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
565 $self->{'size'} = \@new if @new; # only set if all OK
569 ? @{ $self->{'size'} || [0] }
570 : join( ',', @{ $self->{'size'} || [0] } )
574 # ----------------------------------------------------------------------
581 Get or set the field's table object. As the table object stringifies this can
582 also be used to get the table name.
584 my $table = $field->table;
585 print "Table name: $table";
590 if ( my $arg = shift ) {
591 return $self->error('Not a table object') unless
592 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
593 $self->{'table'} = $arg;
596 return $self->{'table'};
603 Returns the field exactly as the parser found it
611 $self->{parsed_field} = $value;
612 return $value || $self;
614 return $self->{parsed_field} || $self;
617 # ----------------------------------------------------------------------
624 Determines if this field is the same as another
626 my $isIdentical = $field1->equals( $field2 );
632 my $case_insensitive = shift;
634 return 0 unless $self->SUPER::equals($other);
635 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
637 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
638 if ($self->sql_data_type && $other->sql_data_type) {
639 return 0 unless $self->sql_data_type == $other->sql_data_type
641 return 0 unless lc($self->data_type) eq lc($other->data_type)
644 return 0 unless $self->size eq $other->size;
647 my $lhs = $self->default_value;
648 $lhs = \'NULL' unless defined $lhs;
649 my $lhs_is_ref = ! ! ref $lhs;
651 my $rhs = $other->default_value;
652 $rhs = \'NULL' unless defined $rhs;
653 my $rhs_is_ref = ! ! ref $rhs;
655 # If only one is a ref, fail. -- rjbs, 2008-12-02
656 return 0 if $lhs_is_ref xor $rhs_is_ref;
658 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
659 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
661 return 0 if $effective_lhs ne $effective_rhs;
664 return 0 unless $self->is_nullable eq $other->is_nullable;
665 # return 0 unless $self->is_unique eq $other->is_unique;
666 return 0 unless $self->is_primary_key eq $other->is_primary_key;
667 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
668 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
669 # return 0 unless $self->comments eq $other->comments;
670 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
674 # ----------------------------------------------------------------------
677 # Destroy cyclical references.
680 undef $self->{'table'};
681 undef $self->{'foreign_key_reference'};
686 # ----------------------------------------------------------------------
692 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.