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.
26 use SQL::Translator::Schema::Constants;
27 use SQL::Translator::Types qw(schema_obj);
28 use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
29 use Sub::Quote qw(quote_sub);
31 extends 'SQL::Translator::Schema::Object';
33 our $VERSION = '1.59';
35 # Stringify to our name, being careful not to pass any args through so we don't
36 # accidentally set it to undef. We also have to tweak bool so the object is
37 # still true when it doesn't have a name (which shouldn't happen!).
39 '""' => sub { shift->name },
40 'bool' => sub { $_[0]->name || $_[0] },
44 use DBI qw(:sql_types);
46 # Mapping from string to sql constant
48 integer => SQL_INTEGER,
51 tinyint => SQL_TINYINT,
52 smallint => SQL_SMALLINT,
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
82 my $field = SQL::Translator::Schema::Field->new(
89 Get or set the comments on a field. May be called several times to
90 set and it will accumulate the comments. Called in an array context,
91 returns each comment individually; called in a scalar context, returns
92 all the comments joined on newlines.
94 $field->comments('foo');
95 $field->comments('bar');
96 print join( ', ', $field->comments ); # prints "foo, bar"
102 coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
103 default => quote_sub(q{ [] }),
106 around comments => sub {
111 $arg = $arg->[0] if ref $arg;
112 push @{ $self->$orig }, $arg if $arg;
117 : join( "\n", @{ $self->$orig } );
123 Get or set the field's data type.
125 my $data_type = $field->data_type('integer');
129 has data_type => ( is => 'rw', default => quote_sub(q{ '' }) );
133 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
138 has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
140 sub _build_sql_data_type {
141 $type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
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 has default_value => ( is => 'rw' );
156 =head2 foreign_key_reference
158 Get or set the field's foreign key reference;
160 my $constraint = $field->foreign_key_reference( $constraint );
164 has foreign_key_reference => (
166 predicate => '_has_foreign_key_reference',
167 isa => schema_obj('Constraint'),
171 around foreign_key_reference => sub {
175 if ( my $arg = shift ) {
177 'Foreign key reference for ', $self->name, 'already defined'
178 ) if $self->_has_foreign_key_reference;
180 return ex2err($orig, $self, $arg);
185 =head2 is_auto_increment
187 Get or set the field's C<is_auto_increment> attribute.
189 my $is_auto = $field->is_auto_increment(1);
193 has is_auto_increment => (
195 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
200 sub _build_is_auto_increment {
203 if ( my $table = $self->table ) {
204 if ( my $schema = $table->schema ) {
206 $schema->database eq 'PostgreSQL' &&
207 $self->data_type eq 'serial'
216 =head2 is_foreign_key
218 Returns whether or not the field is a foreign key.
220 my $is_fk = $field->is_foreign_key;
224 has is_foreign_key => (
226 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
231 sub _build_is_foreign_key {
234 if ( my $table = $self->table ) {
235 for my $c ( $table->get_constraints ) {
236 if ( $c->type eq FOREIGN_KEY ) {
237 my %fields = map { $_, 1 } $c->fields;
238 if ( $fields{ $self->name } ) {
239 $self->foreign_key_reference( $c );
250 Get or set whether the field can be null. If not defined, then
251 returns "1" (assumes the field can be null). The argument is evaluated
252 by Perl for True or False, so the following are equivalent:
254 $is_nullable = $field->is_nullable(0);
255 $is_nullable = $field->is_nullable('');
256 $is_nullable = $field->is_nullable('0');
258 While this is technically a field constraint, it's probably easier to
259 represent this as an attribute of the field. In order keep things
260 consistent, any other constraint on the field (unique, primary, and
261 foreign keys; checks) are represented as table constraints.
267 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
268 default => quote_sub(q{ 1 }),
271 around is_nullable => sub {
272 my ($orig, $self, $arg) = @_;
274 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
277 =head2 is_primary_key
279 Get or set the field's C<is_primary_key> attribute. Does not create
280 a table constraint (should it?).
282 my $is_pk = $field->is_primary_key(1);
286 has is_primary_key => (
288 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
293 sub _build_is_primary_key {
296 if ( my $table = $self->table ) {
297 if ( my $pk = $table->primary_key ) {
298 my %fields = map { $_, 1 } $pk->fields;
299 return $fields{ $self->name } || 0;
307 Determine whether the field has a UNIQUE constraint or not.
309 my $is_unique = $field->is_unique;
313 has is_unique => ( is => 'lazy', init_arg => undef );
315 around is_unique => carp_ro('is_unique');
317 sub _build_is_unique {
320 if ( my $table = $self->table ) {
321 for my $c ( $table->get_constraints ) {
322 if ( $c->type eq UNIQUE ) {
323 my %fields = map { $_, 1 } $c->fields;
324 if ( $fields{ $self->name } ) {
339 Determine whether the field is valid or not.
341 my $ok = $field->is_valid;
346 return $self->error('No name') unless $self->name;
347 return $self->error('No data type') unless $self->data_type;
348 return $self->error('No table object') unless $self->table;
354 Get or set the field's name.
356 my $name = $field->name('foo');
358 The field object will also stringify to its name.
360 my $setter_name = "set_$field";
362 Errors ("No field name") if you try to set a blank name.
366 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
372 if ( my ($arg) = @_ ) {
373 if ( my $schema = $self->table ) {
374 return $self->error( qq[Can't use field name "$arg": field exists] )
375 if $schema->get_field( $arg );
379 return ex2err($orig, $self, @_);
386 Read only method to return the fields name with its table name pre-pended.
392 return $self->table.".".$self->name;
397 Get or set the field's order.
399 my $order = $field->order(3);
403 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
405 around order => sub {
406 my ( $orig, $self, $arg ) = @_;
408 if ( defined $arg && $arg =~ /^\d+$/ ) {
409 return $self->$orig($arg);
419 Shortcut to get the fields schema ($field->table->schema) or undef if it
422 my $schema = $field->schema;
427 if ( my $table = $self->table ) { return $table->schema || undef; }
433 Get or set the field's size. Accepts a string, array or arrayref of
434 numbers and returns a string.
437 $field->size( [ 255 ] );
438 $size = $field->size( 10, 2 );
439 print $size; # prints "10,2"
441 $size = $field->size( '10, 2' );
442 print $size; # prints "10,2"
448 default => quote_sub(q{ [0] }),
450 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
451 @sizes ? \@sizes : [0];
458 my $numbers = parse_list_arg( @_ );
462 for my $num ( @$numbers ) {
463 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
467 $self->$orig(\@new) if @new; # only set if all OK
471 ? @{ $self->$orig || [0] }
472 : join( ',', @{ $self->$orig || [0] } )
478 Get or set the field's table object. As the table object stringifies this can
479 also be used to get the table name.
481 my $table = $field->table;
482 print "Table name: $table";
486 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
488 around table => \&ex2err;
492 Returns the field exactly as the parser found it
496 has parsed_field => ( is => 'rw' );
498 around parsed_field => sub {
502 return $self->$orig(@_) || $self;
507 Determines if this field is the same as another
509 my $isIdentical = $field1->equals( $field2 );
513 around equals => sub {
517 my $case_insensitive = shift;
519 return 0 unless $self->$orig($other);
520 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
522 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
523 if ($self->sql_data_type && $other->sql_data_type) {
524 return 0 unless $self->sql_data_type == $other->sql_data_type
526 return 0 unless lc($self->data_type) eq lc($other->data_type)
529 return 0 unless $self->size eq $other->size;
532 my $lhs = $self->default_value;
533 $lhs = \'NULL' unless defined $lhs;
534 my $lhs_is_ref = ! ! ref $lhs;
536 my $rhs = $other->default_value;
537 $rhs = \'NULL' unless defined $rhs;
538 my $rhs_is_ref = ! ! ref $rhs;
540 # If only one is a ref, fail. -- rjbs, 2008-12-02
541 return 0 if $lhs_is_ref xor $rhs_is_ref;
543 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
544 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
546 return 0 if $effective_lhs ne $effective_rhs;
549 return 0 unless $self->is_nullable eq $other->is_nullable;
550 # return 0 unless $self->is_unique eq $other->is_unique;
551 return 0 unless $self->is_primary_key eq $other->is_primary_key;
552 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
553 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
554 # return 0 unless $self->comments eq $other->comments;
555 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
559 # Must come after all 'has' declarations
560 around new => \&ex2err;
568 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.