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 use DBI qw(:sql_types);
66 # Mapping from string to sql contstant
68 integer => SQL_INTEGER,
71 smallint => SQL_SMALLINT,
72 bigint => 9999, # DBI doesn't export a constatn for this. Le suck
76 decimal => SQL_DECIMAL,
77 numeric => SQL_NUMERIC,
83 datetime => SQL_DATETIME,
84 timestamp => SQL_TIMESTAMP,
88 varchar => SQL_VARCHAR,
90 varbinary => SQL_VARBINARY,
93 text => SQL_LONGVARCHAR
96 # ----------------------------------------------------------------------
98 __PACKAGE__->_attributes( qw/
99 table name data_type size is_primary_key is_nullable
100 is_auto_increment default_value comments is_foreign_key
101 is_unique order sql_data_type
110 my $field = SQL::Translator::Schema::Field->new(
117 # ----------------------------------------------------------------------
124 Get or set the comments on a field. May be called several times to
125 set and it will accumulate the comments. Called in an array context,
126 returns each comment individually; called in a scalar context, returns
127 all the comments joined on newlines.
129 $field->comments('foo');
130 $field->comments('bar');
131 print join( ', ', $field->comments ); # prints "foo, bar"
138 $arg = $arg->[0] if ref $arg;
139 push @{ $self->{'comments'} }, $arg if $arg;
142 if ( @{ $self->{'comments'} || [] } ) {
144 ? @{ $self->{'comments'} || [] }
145 : join( "\n", @{ $self->{'comments'} || [] } );
148 return wantarray ? () : '';
153 # ----------------------------------------------------------------------
160 Get or set the field's data type.
162 my $data_type = $field->data_type('integer');
168 $self->{'data_type'} = $_[0];
169 $self->{'sql_data_type'} = $type_mapping{lc $_[0]} || SQL_UNKNOWN_TYPE unless exists $self->{sql_data_type};
171 return $self->{'data_type'} || '';
178 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
184 $self->{sql_data_type} = shift if @_;
185 return $self->{sql_data_type} || 0;
189 # ----------------------------------------------------------------------
196 Get or set the field's default value. Will return undef if not defined
197 and could return the empty string (it's a valid default value), so don't
198 assume an error like other methods.
200 my $default = $field->default_value('foo');
204 my ( $self, $arg ) = @_;
205 $self->{'default_value'} = $arg if defined $arg;
206 return $self->{'default_value'};
209 # ----------------------------------------------------------------------
214 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
215 Accepts a hash(ref) of name/value pairs to store; returns a hash.
217 $field->extra( qualifier => 'ZEROFILL' );
218 my %extra = $field->extra;
223 # ----------------------------------------------------------------------
224 sub foreign_key_reference {
228 =head2 foreign_key_reference
230 Get or set the field's foreign key reference;
232 my $constraint = $field->foreign_key_reference( $constraint );
238 if ( my $arg = shift ) {
239 my $class = 'SQL::Translator::Schema::Constraint';
240 if ( UNIVERSAL::isa( $arg, $class ) ) {
242 'Foreign key reference for ', $self->name, 'already defined'
243 ) if $self->{'foreign_key_reference'};
245 $self->{'foreign_key_reference'} = $arg;
249 "Argument to foreign_key_reference is not an $class object"
254 return $self->{'foreign_key_reference'};
257 # ----------------------------------------------------------------------
258 sub is_auto_increment {
262 =head2 is_auto_increment
264 Get or set the field's C<is_auto_increment> attribute.
266 my $is_auto = $field->is_auto_increment(1);
270 my ( $self, $arg ) = @_;
272 if ( defined $arg ) {
273 $self->{'is_auto_increment'} = $arg ? 1 : 0;
276 unless ( defined $self->{'is_auto_increment'} ) {
277 if ( my $table = $self->table ) {
278 if ( my $schema = $table->schema ) {
280 $schema->database eq 'PostgreSQL' &&
281 $self->data_type eq 'serial'
283 $self->{'is_auto_increment'} = 1;
289 return $self->{'is_auto_increment'} || 0;
292 # ----------------------------------------------------------------------
297 =head2 is_foreign_key
299 Returns whether or not the field is a foreign key.
301 my $is_fk = $field->is_foreign_key;
305 my ( $self, $arg ) = @_;
307 unless ( defined $self->{'is_foreign_key'} ) {
308 if ( my $table = $self->table ) {
309 for my $c ( $table->get_constraints ) {
310 if ( $c->type eq FOREIGN_KEY ) {
311 my %fields = map { $_, 1 } $c->fields;
312 if ( $fields{ $self->name } ) {
313 $self->{'is_foreign_key'} = 1;
314 $self->foreign_key_reference( $c );
322 return $self->{'is_foreign_key'} || 0;
325 # ----------------------------------------------------------------------
332 Get or set whether the field can be null. If not defined, then
333 returns "1" (assumes the field can be null). The argument is evaluated
334 by Perl for True or False, so the following are eqivalent:
336 $is_nullable = $field->is_nullable(0);
337 $is_nullable = $field->is_nullable('');
338 $is_nullable = $field->is_nullable('0');
340 While this is technically a field constraint, it's probably easier to
341 represent this as an attribute of the field. In order keep things
342 consistent, any other constraint on the field (unique, primary, and
343 foreign keys; checks) are represented as table constraints.
347 my ( $self, $arg ) = @_;
349 if ( defined $arg ) {
350 $self->{'is_nullable'} = $arg ? 1 : 0;
354 defined $self->{'is_nullable'} &&
355 $self->{'is_nullable'} == 1 &&
356 $self->is_primary_key
358 $self->{'is_nullable'} = 0;
361 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
364 # ----------------------------------------------------------------------
369 =head2 is_primary_key
371 Get or set the field's C<is_primary_key> attribute. Does not create
372 a table constraint (should it?).
374 my $is_pk = $field->is_primary_key(1);
378 my ( $self, $arg ) = @_;
380 if ( defined $arg ) {
381 $self->{'is_primary_key'} = $arg ? 1 : 0;
384 unless ( defined $self->{'is_primary_key'} ) {
385 if ( my $table = $self->table ) {
386 if ( my $pk = $table->primary_key ) {
387 my %fields = map { $_, 1 } $pk->fields;
388 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
391 $self->{'is_primary_key'} = 0;
396 return $self->{'is_primary_key'} || 0;
399 # ----------------------------------------------------------------------
406 Determine whether the field has a UNIQUE constraint or not.
408 my $is_unique = $field->is_unique;
414 unless ( defined $self->{'is_unique'} ) {
415 if ( my $table = $self->table ) {
416 for my $c ( $table->get_constraints ) {
417 if ( $c->type eq UNIQUE ) {
418 my %fields = map { $_, 1 } $c->fields;
419 if ( $fields{ $self->name } ) {
420 $self->{'is_unique'} = 1;
428 return $self->{'is_unique'} || 0;
431 # ----------------------------------------------------------------------
438 Determine whether the field is valid or not.
440 my $ok = $field->is_valid;
445 return $self->error('No name') unless $self->name;
446 return $self->error('No data type') unless $self->data_type;
447 return $self->error('No table object') unless $self->table;
451 # ----------------------------------------------------------------------
458 Get or set the field's name.
460 my $name = $field->name('foo');
462 The field object will also stringify to its name.
464 my $setter_name = "set_$field";
466 Errors ("No field name") if you try to set a blank name.
473 my $arg = shift || return $self->error( "No field name" );
474 if ( my $table = $self->table ) {
475 return $self->error( qq[Can't use field name "$arg": field exists] )
476 if $table->get_field( $arg );
479 $self->{'name'} = $arg;
482 return $self->{'name'} || '';
489 Read only method to return the fields name with its table name pre-pended.
495 return $self->table.".".$self->name;
498 # ----------------------------------------------------------------------
505 Get or set the field's order.
507 my $order = $field->order(3);
511 my ( $self, $arg ) = @_;
513 if ( defined $arg && $arg =~ /^\d+$/ ) {
514 $self->{'order'} = $arg;
517 return $self->{'order'} || 0;
520 # ----------------------------------------------------------------------
525 Shortcut to get the fields schema ($field->table->schema) or undef if it
528 my $schema = $field->schema;
533 if ( my $table = $self->table ) { return $table->schema || undef; }
537 # ----------------------------------------------------------------------
544 Get or set the field's size. Accepts a string, array or arrayref of
545 numbers and returns a string.
548 $field->size( [ 255 ] );
549 $size = $field->size( 10, 2 );
550 print $size; # prints "10,2"
552 $size = $field->size( '10, 2' );
553 print $size; # prints "10,2"
558 my $numbers = parse_list_arg( @_ );
562 for my $num ( @$numbers ) {
563 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
567 $self->{'size'} = \@new if @new; # only set if all OK
571 ? @{ $self->{'size'} || [0] }
572 : join( ',', @{ $self->{'size'} || [0] } )
576 # ----------------------------------------------------------------------
583 Get or set the field's table object. As the table object stringifies this can
584 also be used to get the table name.
586 my $table = $field->table;
587 print "Table name: $table";
592 if ( my $arg = shift ) {
593 return $self->error('Not a table object') unless
594 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
595 $self->{'table'} = $arg;
598 return $self->{'table'};
605 Returns the field exactly as the parser found it
613 $self->{parsed_field} = $value;
614 return $value || $self;
616 return $self->{parsed_field} || $self;
619 # ----------------------------------------------------------------------
626 Determines if this field is the same as another
628 my $isIdentical = $field1->equals( $field2 );
634 my $case_insensitive = shift;
636 return 0 unless $self->SUPER::equals($other);
637 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
639 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
640 if ($self->sql_data_type && $other->sql_data_type) {
641 return 0 unless $self->sql_data_type == $other->sql_data_type
643 return 0 unless lc($self->data_type) eq lc($other->data_type)
646 return 0 unless $self->size eq $other->size;
647 return 0 unless (!defined $self->default_value || $self->default_value eq 'NULL') eq (!defined $other->default_value || $other->default_value eq 'NULL');
648 return 0 if defined $self->default_value && $self->default_value ne $other->default_value;
649 return 0 unless $self->is_nullable eq $other->is_nullable;
650 # return 0 unless $self->is_unique eq $other->is_unique;
651 return 0 unless $self->is_primary_key eq $other->is_primary_key;
652 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
653 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
654 # return 0 unless $self->comments eq $other->comments;
655 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
659 # ----------------------------------------------------------------------
662 # Destroy cyclical references.
665 undef $self->{'table'};
666 undef $self->{'foreign_key_reference'};
671 # ----------------------------------------------------------------------
677 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.