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 smallint => SQL_SMALLINT,
52 bigint => 9999, # DBI doesn't export a constant for this. Le suck
56 decimal => SQL_DECIMAL,
57 numeric => SQL_NUMERIC,
63 datetime => SQL_DATETIME,
64 timestamp => SQL_TIMESTAMP,
68 varchar => SQL_VARCHAR,
70 varbinary => SQL_VARBINARY,
73 text => SQL_LONGVARCHAR
81 my $field = SQL::Translator::Schema::Field->new(
88 Get or set the comments on a field. May be called several times to
89 set and it will accumulate the comments. Called in an array context,
90 returns each comment individually; called in a scalar context, returns
91 all the comments joined on newlines.
93 $field->comments('foo');
94 $field->comments('bar');
95 print join( ', ', $field->comments ); # prints "foo, bar"
101 coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
102 default => quote_sub(q{ [] }),
105 around comments => sub {
110 $arg = $arg->[0] if ref $arg;
111 push @{ $self->$orig }, $arg if $arg;
116 : join( "\n", @{ $self->$orig } );
122 Get or set the field's data type.
124 my $data_type = $field->data_type('integer');
128 has data_type => ( is => 'rw', default => quote_sub(q{ '' }) );
132 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
137 has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
139 sub _build_sql_data_type {
140 $type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
145 Get or set the field's default value. Will return undef if not defined
146 and could return the empty string (it's a valid default value), so don't
147 assume an error like other methods.
149 my $default = $field->default_value('foo');
153 has default_value => ( is => 'rw' );
155 =head2 foreign_key_reference
157 Get or set the field's foreign key reference;
159 my $constraint = $field->foreign_key_reference( $constraint );
163 has foreign_key_reference => (
165 predicate => '_has_foreign_key_reference',
166 isa => schema_obj('Constraint'),
170 around foreign_key_reference => sub {
174 if ( my $arg = shift ) {
176 'Foreign key reference for ', $self->name, 'already defined'
177 ) if $self->_has_foreign_key_reference;
179 return ex2err($orig, $self, $arg);
184 =head2 is_auto_increment
186 Get or set the field's C<is_auto_increment> attribute.
188 my $is_auto = $field->is_auto_increment(1);
192 has is_auto_increment => (
194 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
199 sub _build_is_auto_increment {
202 if ( my $table = $self->table ) {
203 if ( my $schema = $table->schema ) {
205 $schema->database eq 'PostgreSQL' &&
206 $self->data_type eq 'serial'
215 =head2 is_foreign_key
217 Returns whether or not the field is a foreign key.
219 my $is_fk = $field->is_foreign_key;
223 has is_foreign_key => (
225 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
230 sub _build_is_foreign_key {
233 if ( my $table = $self->table ) {
234 for my $c ( $table->get_constraints ) {
235 if ( $c->type eq FOREIGN_KEY ) {
236 my %fields = map { $_, 1 } $c->fields;
237 if ( $fields{ $self->name } ) {
238 $self->foreign_key_reference( $c );
249 Get or set whether the field can be null. If not defined, then
250 returns "1" (assumes the field can be null). The argument is evaluated
251 by Perl for True or False, so the following are equivalent:
253 $is_nullable = $field->is_nullable(0);
254 $is_nullable = $field->is_nullable('');
255 $is_nullable = $field->is_nullable('0');
257 While this is technically a field constraint, it's probably easier to
258 represent this as an attribute of the field. In order keep things
259 consistent, any other constraint on the field (unique, primary, and
260 foreign keys; checks) are represented as table constraints.
266 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
267 default => quote_sub(q{ 1 }),
270 around is_nullable => sub {
271 my ($orig, $self, $arg) = @_;
273 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
276 =head2 is_primary_key
278 Get or set the field's C<is_primary_key> attribute. Does not create
279 a table constraint (should it?).
281 my $is_pk = $field->is_primary_key(1);
285 has is_primary_key => (
287 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
292 sub _build_is_primary_key {
295 if ( my $table = $self->table ) {
296 if ( my $pk = $table->primary_key ) {
297 my %fields = map { $_, 1 } $pk->fields;
298 return $fields{ $self->name } || 0;
306 Determine whether the field has a UNIQUE constraint or not.
308 my $is_unique = $field->is_unique;
312 has is_unique => ( is => 'lazy', init_arg => undef );
314 around is_unique => carp_ro('is_unique');
316 sub _build_is_unique {
319 if ( my $table = $self->table ) {
320 for my $c ( $table->get_constraints ) {
321 if ( $c->type eq UNIQUE ) {
322 my %fields = map { $_, 1 } $c->fields;
323 if ( $fields{ $self->name } ) {
338 Determine whether the field is valid or not.
340 my $ok = $field->is_valid;
345 return $self->error('No name') unless $self->name;
346 return $self->error('No data type') unless $self->data_type;
347 return $self->error('No table object') unless $self->table;
353 Get or set the field's name.
355 my $name = $field->name('foo');
357 The field object will also stringify to its name.
359 my $setter_name = "set_$field";
361 Errors ("No field name") if you try to set a blank name.
365 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
371 if ( my ($arg) = @_ ) {
372 if ( my $schema = $self->table ) {
373 return $self->error( qq[Can't use field name "$arg": field exists] )
374 if $schema->get_field( $arg );
378 return ex2err($orig, $self, @_);
385 Read only method to return the fields name with its table name pre-pended.
391 return $self->table.".".$self->name;
396 Get or set the field's order.
398 my $order = $field->order(3);
402 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
404 around order => sub {
405 my ( $orig, $self, $arg ) = @_;
407 if ( defined $arg && $arg =~ /^\d+$/ ) {
408 return $self->$orig($arg);
418 Shortcut to get the fields schema ($field->table->schema) or undef if it
421 my $schema = $field->schema;
426 if ( my $table = $self->table ) { return $table->schema || undef; }
432 Get or set the field's size. Accepts a string, array or arrayref of
433 numbers and returns a string.
436 $field->size( [ 255 ] );
437 $size = $field->size( 10, 2 );
438 print $size; # prints "10,2"
440 $size = $field->size( '10, 2' );
441 print $size; # prints "10,2"
447 default => quote_sub(q{ [0] }),
449 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
450 @sizes ? \@sizes : [0];
457 my $numbers = parse_list_arg( @_ );
461 for my $num ( @$numbers ) {
462 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
466 $self->$orig(\@new) if @new; # only set if all OK
470 ? @{ $self->$orig || [0] }
471 : join( ',', @{ $self->$orig || [0] } )
477 Get or set the field's table object. As the table object stringifies this can
478 also be used to get the table name.
480 my $table = $field->table;
481 print "Table name: $table";
485 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
487 around table => \&ex2err;
491 Returns the field exactly as the parser found it
495 has parsed_field => ( is => 'rw' );
497 around parsed_field => sub {
501 return $self->$orig(@_) || $self;
506 Determines if this field is the same as another
508 my $isIdentical = $field1->equals( $field2 );
512 around equals => sub {
516 my $case_insensitive = shift;
518 return 0 unless $self->$orig($other);
519 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
521 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
522 if ($self->sql_data_type && $other->sql_data_type) {
523 return 0 unless $self->sql_data_type == $other->sql_data_type
525 return 0 unless lc($self->data_type) eq lc($other->data_type)
528 return 0 unless $self->size eq $other->size;
531 my $lhs = $self->default_value;
532 $lhs = \'NULL' unless defined $lhs;
533 my $lhs_is_ref = ! ! ref $lhs;
535 my $rhs = $other->default_value;
536 $rhs = \'NULL' unless defined $rhs;
537 my $rhs_is_ref = ! ! ref $rhs;
539 # If only one is a ref, fail. -- rjbs, 2008-12-02
540 return 0 if $lhs_is_ref xor $rhs_is_ref;
542 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
543 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
545 return 0 if $effective_lhs ne $effective_rhs;
548 return 0 unless $self->is_nullable eq $other->is_nullable;
549 # return 0 unless $self->is_unique eq $other->is_unique;
550 return 0 unless $self->is_primary_key eq $other->is_primary_key;
551 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
552 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
553 # return 0 unless $self->comments eq $other->comments;
554 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
558 # Must come after all 'has' declarations
559 around new => \&ex2err;
567 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.