1 package SQL::Translator::Schema::Field;
7 SQL::Translator::Schema::Field - SQL::Translator field object
11 use SQL::Translator::Schema::Field;
12 my $field = SQL::Translator::Schema::Field->new(
19 C<SQL::Translator::Schema::Field> is the field object.
27 use SQL::Translator::Schema::Constants;
28 use SQL::Translator::Utils 'parse_list_arg';
30 use base 'SQL::Translator::Schema::Object';
32 our ( $TABLE_COUNT, $VIEW_COUNT );
34 our $VERSION = '1.59';
36 # Stringify to our name, being careful not to pass any args through so we don't
37 # accidentally set it to undef. We also have to tweak bool so the object is
38 # still true when it doesn't have a name (which shouldn't happen!).
40 '""' => sub { shift->name },
41 'bool' => sub { $_[0]->name || $_[0] },
45 use DBI qw(:sql_types);
47 # Mapping from string to sql contstant
49 integer => SQL_INTEGER,
52 smallint => SQL_SMALLINT,
53 bigint => 9999, # DBI doesn't export a constatn for this. Le suck
57 decimal => SQL_DECIMAL,
58 numeric => SQL_NUMERIC,
64 datetime => SQL_DATETIME,
65 timestamp => SQL_TIMESTAMP,
69 varchar => SQL_VARCHAR,
71 varbinary => SQL_VARBINARY,
74 text => SQL_LONGVARCHAR
78 __PACKAGE__->_attributes( qw/
79 table name data_type size is_primary_key is_nullable
80 is_auto_increment default_value comments is_foreign_key
81 is_unique order sql_data_type
90 my $field = SQL::Translator::Schema::Field->new(
103 Get or set the comments on a field. May be called several times to
104 set and it will accumulate the comments. Called in an array context,
105 returns each comment individually; called in a scalar context, returns
106 all the comments joined on newlines.
108 $field->comments('foo');
109 $field->comments('bar');
110 print join( ', ', $field->comments ); # prints "foo, bar"
117 $arg = $arg->[0] if ref $arg;
118 push @{ $self->{'comments'} }, $arg if $arg;
121 if ( @{ $self->{'comments'} || [] } ) {
123 ? @{ $self->{'comments'} || [] }
124 : join( "\n", @{ $self->{'comments'} || [] } );
127 return wantarray ? () : '';
138 Get or set the field's data type.
140 my $data_type = $field->data_type('integer');
146 $self->{'data_type'} = $_[0];
147 $self->{'sql_data_type'} = $type_mapping{lc $_[0]} || SQL_UNKNOWN_TYPE unless exists $self->{sql_data_type};
149 return $self->{'data_type'} || '';
156 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
162 $self->{sql_data_type} = shift if @_;
163 return $self->{sql_data_type} || 0;
173 Get or set the field's default value. Will return undef if not defined
174 and could return the empty string (it's a valid default value), so don't
175 assume an error like other methods.
177 my $default = $field->default_value('foo');
182 $self->{'default_value'} = shift if @_;
183 return $self->{'default_value'};
190 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
191 Accepts a hash(ref) of name/value pairs to store; returns a hash.
193 $field->extra( qualifier => 'ZEROFILL' );
194 my %extra = $field->extra;
198 sub foreign_key_reference {
202 =head2 foreign_key_reference
204 Get or set the field's foreign key reference;
206 my $constraint = $field->foreign_key_reference( $constraint );
212 if ( my $arg = shift ) {
213 my $class = 'SQL::Translator::Schema::Constraint';
214 if ( UNIVERSAL::isa( $arg, $class ) ) {
216 'Foreign key reference for ', $self->name, 'already defined'
217 ) if $self->{'foreign_key_reference'};
219 $self->{'foreign_key_reference'} = $arg;
223 "Argument to foreign_key_reference is not an $class object"
228 return $self->{'foreign_key_reference'};
231 sub is_auto_increment {
235 =head2 is_auto_increment
237 Get or set the field's C<is_auto_increment> attribute.
239 my $is_auto = $field->is_auto_increment(1);
243 my ( $self, $arg ) = @_;
245 if ( defined $arg ) {
246 $self->{'is_auto_increment'} = $arg ? 1 : 0;
249 unless ( defined $self->{'is_auto_increment'} ) {
250 if ( my $table = $self->table ) {
251 if ( my $schema = $table->schema ) {
253 $schema->database eq 'PostgreSQL' &&
254 $self->data_type eq 'serial'
256 $self->{'is_auto_increment'} = 1;
262 return $self->{'is_auto_increment'} || 0;
269 =head2 is_foreign_key
271 Returns whether or not the field is a foreign key.
273 my $is_fk = $field->is_foreign_key;
277 my ( $self, $arg ) = @_;
279 unless ( defined $self->{'is_foreign_key'} ) {
280 if ( my $table = $self->table ) {
281 for my $c ( $table->get_constraints ) {
282 if ( $c->type eq FOREIGN_KEY ) {
283 my %fields = map { $_, 1 } $c->fields;
284 if ( $fields{ $self->name } ) {
285 $self->{'is_foreign_key'} = 1;
286 $self->foreign_key_reference( $c );
294 return $self->{'is_foreign_key'} || 0;
303 Get or set whether the field can be null. If not defined, then
304 returns "1" (assumes the field can be null). The argument is evaluated
305 by Perl for True or False, so the following are eqivalent:
307 $is_nullable = $field->is_nullable(0);
308 $is_nullable = $field->is_nullable('');
309 $is_nullable = $field->is_nullable('0');
311 While this is technically a field constraint, it's probably easier to
312 represent this as an attribute of the field. In order keep things
313 consistent, any other constraint on the field (unique, primary, and
314 foreign keys; checks) are represented as table constraints.
318 my ( $self, $arg ) = @_;
320 if ( defined $arg ) {
321 $self->{'is_nullable'} = $arg ? 1 : 0;
325 defined $self->{'is_nullable'} &&
326 $self->{'is_nullable'} == 1 &&
327 $self->is_primary_key
329 $self->{'is_nullable'} = 0;
332 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
339 =head2 is_primary_key
341 Get or set the field's C<is_primary_key> attribute. Does not create
342 a table constraint (should it?).
344 my $is_pk = $field->is_primary_key(1);
348 my ( $self, $arg ) = @_;
350 if ( defined $arg ) {
351 $self->{'is_primary_key'} = $arg ? 1 : 0;
354 unless ( defined $self->{'is_primary_key'} ) {
355 if ( my $table = $self->table ) {
356 if ( my $pk = $table->primary_key ) {
357 my %fields = map { $_, 1 } $pk->fields;
358 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
361 $self->{'is_primary_key'} = 0;
366 return $self->{'is_primary_key'} || 0;
375 Determine whether the field has a UNIQUE constraint or not.
377 my $is_unique = $field->is_unique;
383 unless ( defined $self->{'is_unique'} ) {
384 if ( my $table = $self->table ) {
385 for my $c ( $table->get_constraints ) {
386 if ( $c->type eq UNIQUE ) {
387 my %fields = map { $_, 1 } $c->fields;
388 if ( $fields{ $self->name } ) {
389 $self->{'is_unique'} = 1;
397 return $self->{'is_unique'} || 0;
406 Determine whether the field is valid or not.
408 my $ok = $field->is_valid;
413 return $self->error('No name') unless $self->name;
414 return $self->error('No data type') unless $self->data_type;
415 return $self->error('No table object') unless $self->table;
425 Get or set the field's name.
427 my $name = $field->name('foo');
429 The field object will also stringify to its name.
431 my $setter_name = "set_$field";
433 Errors ("No field name") if you try to set a blank name.
440 my $arg = shift || return $self->error( "No field name" );
441 if ( my $table = $self->table ) {
442 return $self->error( qq[Can't use field name "$arg": field exists] )
443 if $table->get_field( $arg );
446 $self->{'name'} = $arg;
449 return $self->{'name'} || '';
456 Read only method to return the fields name with its table name pre-pended.
462 return $self->table.".".$self->name;
471 Get or set the field's order.
473 my $order = $field->order(3);
477 my ( $self, $arg ) = @_;
479 if ( defined $arg && $arg =~ /^\d+$/ ) {
480 $self->{'order'} = $arg;
483 return $self->{'order'} || 0;
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; }
508 Get or set the field's size. Accepts a string, array or arrayref of
509 numbers and returns a string.
512 $field->size( [ 255 ] );
513 $size = $field->size( 10, 2 );
514 print $size; # prints "10,2"
516 $size = $field->size( '10, 2' );
517 print $size; # prints "10,2"
522 my $numbers = parse_list_arg( @_ );
526 for my $num ( @$numbers ) {
527 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
531 $self->{'size'} = \@new if @new; # only set if all OK
535 ? @{ $self->{'size'} || [0] }
536 : join( ',', @{ $self->{'size'} || [0] } )
546 Get or set the field's table object. As the table object stringifies this can
547 also be used to get the table name.
549 my $table = $field->table;
550 print "Table name: $table";
555 if ( my $arg = shift ) {
556 return $self->error('Not a table object') unless
557 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
558 $self->{'table'} = $arg;
561 return $self->{'table'};
568 Returns the field exactly as the parser found it
576 $self->{parsed_field} = $value;
577 return $value || $self;
579 return $self->{parsed_field} || $self;
588 Determines if this field is the same as another
590 my $isIdentical = $field1->equals( $field2 );
596 my $case_insensitive = shift;
598 return 0 unless $self->SUPER::equals($other);
599 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
601 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
602 if ($self->sql_data_type && $other->sql_data_type) {
603 return 0 unless $self->sql_data_type == $other->sql_data_type
605 return 0 unless lc($self->data_type) eq lc($other->data_type)
608 return 0 unless $self->size eq $other->size;
611 my $lhs = $self->default_value;
612 $lhs = \'NULL' unless defined $lhs;
613 my $lhs_is_ref = ! ! ref $lhs;
615 my $rhs = $other->default_value;
616 $rhs = \'NULL' unless defined $rhs;
617 my $rhs_is_ref = ! ! ref $rhs;
619 # If only one is a ref, fail. -- rjbs, 2008-12-02
620 return 0 if $lhs_is_ref xor $rhs_is_ref;
622 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
623 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
625 return 0 if $effective_lhs ne $effective_rhs;
628 return 0 unless $self->is_nullable eq $other->is_nullable;
629 # return 0 unless $self->is_unique eq $other->is_unique;
630 return 0 unless $self->is_primary_key eq $other->is_primary_key;
631 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
632 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
633 # return 0 unless $self->comments eq $other->comments;
634 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
640 # Destroy cyclical references.
643 undef $self->{'table'};
644 undef $self->{'foreign_key_reference'};
653 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.