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' );
157 Get or set the field's "extra" attributes (e.g., "ZEROFILL" for MySQL).
158 Accepts a hash(ref) of name/value pairs to store; returns a hash.
160 $field->extra( qualifier => 'ZEROFILL' );
161 my %extra = $field->extra;
165 =head2 foreign_key_reference
167 Get or set the field's foreign key reference;
169 my $constraint = $field->foreign_key_reference( $constraint );
173 has foreign_key_reference => (
175 predicate => '_has_foreign_key_reference',
176 isa => schema_obj('Constraint'),
180 around foreign_key_reference => sub {
184 if ( my $arg = shift ) {
186 'Foreign key reference for ', $self->name, 'already defined'
187 ) if $self->_has_foreign_key_reference;
189 return ex2err($orig, $self, $arg);
194 =head2 is_auto_increment
196 Get or set the field's C<is_auto_increment> attribute.
198 my $is_auto = $field->is_auto_increment(1);
202 has is_auto_increment => (
204 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
209 sub _build_is_auto_increment {
212 if ( my $table = $self->table ) {
213 if ( my $schema = $table->schema ) {
215 $schema->database eq 'PostgreSQL' &&
216 $self->data_type eq 'serial'
225 =head2 is_foreign_key
227 Returns whether or not the field is a foreign key.
229 my $is_fk = $field->is_foreign_key;
233 has is_foreign_key => (
235 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
240 sub _build_is_foreign_key {
243 if ( my $table = $self->table ) {
244 for my $c ( $table->get_constraints ) {
245 if ( $c->type eq FOREIGN_KEY ) {
246 my %fields = map { $_, 1 } $c->fields;
247 if ( $fields{ $self->name } ) {
248 $self->foreign_key_reference( $c );
259 Get or set whether the field can be null. If not defined, then
260 returns "1" (assumes the field can be null). The argument is evaluated
261 by Perl for True or False, so the following are equivalent:
263 $is_nullable = $field->is_nullable(0);
264 $is_nullable = $field->is_nullable('');
265 $is_nullable = $field->is_nullable('0');
267 While this is technically a field constraint, it's probably easier to
268 represent this as an attribute of the field. In order keep things
269 consistent, any other constraint on the field (unique, primary, and
270 foreign keys; checks) are represented as table constraints.
276 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
277 default => quote_sub(q{ 1 }),
280 around is_nullable => sub {
281 my ($orig, $self, $arg) = @_;
283 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
286 =head2 is_primary_key
288 Get or set the field's C<is_primary_key> attribute. Does not create
289 a table constraint (should it?).
291 my $is_pk = $field->is_primary_key(1);
295 has is_primary_key => (
297 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
302 sub _build_is_primary_key {
305 if ( my $table = $self->table ) {
306 if ( my $pk = $table->primary_key ) {
307 my %fields = map { $_, 1 } $pk->fields;
308 return $fields{ $self->name } || 0;
316 Determine whether the field has a UNIQUE constraint or not.
318 my $is_unique = $field->is_unique;
322 has is_unique => ( is => 'lazy', init_arg => undef );
324 around is_unique => carp_ro('is_unique');
326 sub _build_is_unique {
329 if ( my $table = $self->table ) {
330 for my $c ( $table->get_constraints ) {
331 if ( $c->type eq UNIQUE ) {
332 my %fields = map { $_, 1 } $c->fields;
333 if ( $fields{ $self->name } ) {
348 Determine whether the field is valid or not.
350 my $ok = $field->is_valid;
355 return $self->error('No name') unless $self->name;
356 return $self->error('No data type') unless $self->data_type;
357 return $self->error('No table object') unless $self->table;
363 Get or set the field's name.
365 my $name = $field->name('foo');
367 The field object will also stringify to its name.
369 my $setter_name = "set_$field";
371 Errors ("No field name") if you try to set a blank name.
375 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
381 if ( my ($arg) = @_ ) {
382 if ( my $schema = $self->table ) {
383 return $self->error( qq[Can't use field name "$arg": field exists] )
384 if $schema->get_field( $arg );
388 return ex2err($orig, $self, @_);
395 Read only method to return the fields name with its table name pre-pended.
401 return $self->table.".".$self->name;
406 Get or set the field's order.
408 my $order = $field->order(3);
412 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
414 around order => sub {
415 my ( $orig, $self, $arg ) = @_;
417 if ( defined $arg && $arg =~ /^\d+$/ ) {
418 return $self->$orig($arg);
428 Shortcut to get the fields schema ($field->table->schema) or undef if it
431 my $schema = $field->schema;
436 if ( my $table = $self->table ) { return $table->schema || undef; }
442 Get or set the field's size. Accepts a string, array or arrayref of
443 numbers and returns a string.
446 $field->size( [ 255 ] );
447 $size = $field->size( 10, 2 );
448 print $size; # prints "10,2"
450 $size = $field->size( '10, 2' );
451 print $size; # prints "10,2"
457 default => quote_sub(q{ [0] }),
459 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
460 @sizes ? \@sizes : [0];
467 my $numbers = parse_list_arg( @_ );
471 for my $num ( @$numbers ) {
472 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
476 $self->$orig(\@new) if @new; # only set if all OK
480 ? @{ $self->$orig || [0] }
481 : join( ',', @{ $self->$orig || [0] } )
487 Get or set the field's table object. As the table object stringifies this can
488 also be used to get the table name.
490 my $table = $field->table;
491 print "Table name: $table";
495 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
497 around table => \&ex2err;
501 Returns the field exactly as the parser found it
505 has parsed_field => ( is => 'rw' );
507 around parsed_field => sub {
511 return $self->$orig(@_) || $self;
516 Determines if this field is the same as another
518 my $isIdentical = $field1->equals( $field2 );
522 around equals => sub {
526 my $case_insensitive = shift;
528 return 0 unless $self->$orig($other);
529 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
531 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
532 if ($self->sql_data_type && $other->sql_data_type) {
533 return 0 unless $self->sql_data_type == $other->sql_data_type
535 return 0 unless lc($self->data_type) eq lc($other->data_type)
538 return 0 unless $self->size eq $other->size;
541 my $lhs = $self->default_value;
542 $lhs = \'NULL' unless defined $lhs;
543 my $lhs_is_ref = ! ! ref $lhs;
545 my $rhs = $other->default_value;
546 $rhs = \'NULL' unless defined $rhs;
547 my $rhs_is_ref = ! ! ref $rhs;
549 # If only one is a ref, fail. -- rjbs, 2008-12-02
550 return 0 if $lhs_is_ref xor $rhs_is_ref;
552 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
553 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
555 return 0 if $effective_lhs ne $effective_rhs;
558 return 0 unless $self->is_nullable eq $other->is_nullable;
559 # return 0 unless $self->is_unique eq $other->is_unique;
560 return 0 unless $self->is_primary_key eq $other->is_primary_key;
561 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
562 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
563 # return 0 unless $self->comments eq $other->comments;
564 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
568 # Must come after all 'has' declarations
569 around new => \&ex2err;
577 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.