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);
31 SQL::Translator::Schema::Role::BuildArgs
32 SQL::Translator::Schema::Role::Extra
33 SQL::Translator::Schema::Role::Error
34 SQL::Translator::Schema::Role::Compare
37 our $VERSION = '1.59';
39 # Stringify to our name, being careful not to pass any args through so we don't
40 # accidentally set it to undef. We also have to tweak bool so the object is
41 # still true when it doesn't have a name (which shouldn't happen!).
43 '""' => sub { shift->name },
44 'bool' => sub { $_[0]->name || $_[0] },
48 use DBI qw(:sql_types);
50 # Mapping from string to sql contstant
52 integer => SQL_INTEGER,
55 smallint => SQL_SMALLINT,
56 bigint => 9999, # DBI doesn't export a constatn for this. Le suck
60 decimal => SQL_DECIMAL,
61 numeric => SQL_NUMERIC,
67 datetime => SQL_DATETIME,
68 timestamp => SQL_TIMESTAMP,
72 varchar => SQL_VARCHAR,
74 varbinary => SQL_VARBINARY,
77 text => SQL_LONGVARCHAR
85 my $field = SQL::Translator::Schema::Field->new(
92 Get or set the comments on a field. May be called several times to
93 set and it will accumulate the comments. Called in an array context,
94 returns each comment individually; called in a scalar context, returns
95 all the comments joined on newlines.
97 $field->comments('foo');
98 $field->comments('bar');
99 print join( ', ', $field->comments ); # prints "foo, bar"
105 coerce => sub { ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] },
106 default => sub { [] },
109 around comments => sub {
114 $arg = $arg->[0] if ref $arg;
115 push @{ $self->$orig }, $arg if $arg;
120 : join( "\n", @{ $self->$orig } );
126 Get or set the field's data type.
128 my $data_type = $field->data_type('integer');
132 has data_type => ( is => 'rw', default => sub { '' } );
136 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
141 has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
143 sub _build_sql_data_type {
144 $type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
149 Get or set the field's default value. Will return undef if not defined
150 and could return the empty string (it's a valid default value), so don't
151 assume an error like other methods.
153 my $default = $field->default_value('foo');
157 has default_value => ( is => 'rw' );
161 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
162 Accepts a hash(ref) of name/value pairs to store; returns a hash.
164 $field->extra( qualifier => 'ZEROFILL' );
165 my %extra = $field->extra;
169 =head2 foreign_key_reference
171 Get or set the field's foreign key reference;
173 my $constraint = $field->foreign_key_reference( $constraint );
177 has foreign_key_reference => (
179 predicate => '_has_foreign_key_reference',
180 isa => schema_obj('Constraint'),
183 around foreign_key_reference => sub {
187 if ( my $arg = shift ) {
189 'Foreign key reference for ', $self->name, 'already defined'
190 ) if $self->_has_foreign_key_reference;
192 return ex2err($orig, $self, $arg);
197 =head2 is_auto_increment
199 Get or set the field's C<is_auto_increment> attribute.
201 my $is_auto = $field->is_auto_increment(1);
205 has is_auto_increment => (
207 coerce => sub { $_[0] ? 1 : 0 },
212 sub _build_is_auto_increment {
215 if ( my $table = $self->table ) {
216 if ( my $schema = $table->schema ) {
218 $schema->database eq 'PostgreSQL' &&
219 $self->data_type eq 'serial'
228 =head2 is_foreign_key
230 Returns whether or not the field is a foreign key.
232 my $is_fk = $field->is_foreign_key;
236 has is_foreign_key => (
238 coerce => sub { $_[0] ? 1 : 0 },
243 sub _build_is_foreign_key {
246 if ( my $table = $self->table ) {
247 for my $c ( $table->get_constraints ) {
248 if ( $c->type eq FOREIGN_KEY ) {
249 my %fields = map { $_, 1 } $c->fields;
250 if ( $fields{ $self->name } ) {
251 $self->foreign_key_reference( $c );
262 Get or set whether the field can be null. If not defined, then
263 returns "1" (assumes the field can be null). The argument is evaluated
264 by Perl for True or False, so the following are eqivalent:
266 $is_nullable = $field->is_nullable(0);
267 $is_nullable = $field->is_nullable('');
268 $is_nullable = $field->is_nullable('0');
270 While this is technically a field constraint, it's probably easier to
271 represent this as an attribute of the field. In order keep things
272 consistent, any other constraint on the field (unique, primary, and
273 foreign keys; checks) are represented as table constraints.
279 coerce => sub { $_[0] ? 1 : 0 },
280 default => sub { 1 },
283 around is_nullable => sub {
284 my ($orig, $self, $arg) = @_;
286 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
289 =head2 is_primary_key
291 Get or set the field's C<is_primary_key> attribute. Does not create
292 a table constraint (should it?).
294 my $is_pk = $field->is_primary_key(1);
298 has is_primary_key => (
300 coerce => sub { $_[0] ? 1 : 0 },
305 sub _build_is_primary_key {
308 if ( my $table = $self->table ) {
309 if ( my $pk = $table->primary_key ) {
310 my %fields = map { $_, 1 } $pk->fields;
311 return $fields{ $self->name } || 0;
319 Determine whether the field has a UNIQUE constraint or not.
321 my $is_unique = $field->is_unique;
325 has is_unique => ( is => 'lazy', init_arg => undef );
327 sub _build_is_unique {
330 if ( my $table = $self->table ) {
331 for my $c ( $table->get_constraints ) {
332 if ( $c->type eq UNIQUE ) {
333 my %fields = map { $_, 1 } $c->fields;
334 if ( $fields{ $self->name } ) {
349 Determine whether the field is valid or not.
351 my $ok = $field->is_valid;
356 return $self->error('No name') unless $self->name;
357 return $self->error('No data type') unless $self->data_type;
358 return $self->error('No table object') unless $self->table;
364 Get or set the field's name.
366 my $name = $field->name('foo');
368 The field object will also stringify to its name.
370 my $setter_name = "set_$field";
372 Errors ("No field name") if you try to set a blank name.
376 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
382 if ( my ($arg) = @_ ) {
383 if ( my $schema = $self->table ) {
384 return $self->error( qq[Can't use field name "$arg": field exists] )
385 if $schema->get_field( $arg );
389 return ex2err($orig, $self, @_);
396 Read only method to return the fields name with its table name pre-pended.
402 return $self->table.".".$self->name;
407 Get or set the field's order.
409 my $order = $field->order(3);
413 has order => ( is => 'rw', default => sub { 0 } );
415 around order => sub {
416 my ( $orig, $self, $arg ) = @_;
418 if ( defined $arg && $arg =~ /^\d+$/ ) {
419 return $self->$orig($arg);
429 Shortcut to get the fields schema ($field->table->schema) or undef if it
432 my $schema = $field->schema;
437 if ( my $table = $self->table ) { return $table->schema || undef; }
443 Get or set the field's size. Accepts a string, array or arrayref of
444 numbers and returns a string.
447 $field->size( [ 255 ] );
448 $size = $field->size( 10, 2 );
449 print $size; # prints "10,2"
451 $size = $field->size( '10, 2' );
452 print $size; # prints "10,2"
458 default => sub { [0] },
460 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
461 @sizes ? \@sizes : [0];
468 my $numbers = parse_list_arg( @_ );
472 for my $num ( @$numbers ) {
473 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
477 $self->$orig(\@new) if @new; # only set if all OK
481 ? @{ $self->$orig || [0] }
482 : join( ',', @{ $self->$orig || [0] } )
488 Get or set the field's table object. As the table object stringifies this can
489 also be used to get the table name.
491 my $table = $field->table;
492 print "Table name: $table";
496 has table => ( is => 'rw', isa => schema_obj('Table') );
498 around table => \&ex2err;
502 Returns the field exactly as the parser found it
506 has parsed_field => ( is => 'rw' );
508 around parsed_field => sub {
512 return $self->$orig(@_) || $self;
517 Determines if this field is the same as another
519 my $isIdentical = $field1->equals( $field2 );
523 around equals => sub {
527 my $case_insensitive = shift;
529 return 0 unless $self->$orig($other);
530 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
532 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
533 if ($self->sql_data_type && $other->sql_data_type) {
534 return 0 unless $self->sql_data_type == $other->sql_data_type
536 return 0 unless lc($self->data_type) eq lc($other->data_type)
539 return 0 unless $self->size eq $other->size;
542 my $lhs = $self->default_value;
543 $lhs = \'NULL' unless defined $lhs;
544 my $lhs_is_ref = ! ! ref $lhs;
546 my $rhs = $other->default_value;
547 $rhs = \'NULL' unless defined $rhs;
548 my $rhs_is_ref = ! ! ref $rhs;
550 # If only one is a ref, fail. -- rjbs, 2008-12-02
551 return 0 if $lhs_is_ref xor $rhs_is_ref;
553 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
554 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
556 return 0 if $effective_lhs ne $effective_rhs;
559 return 0 unless $self->is_nullable eq $other->is_nullable;
560 # return 0 unless $self->is_unique eq $other->is_unique;
561 return 0 unless $self->is_primary_key eq $other->is_primary_key;
562 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
563 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
564 # return 0 unless $self->comments eq $other->comments;
565 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
571 # Destroy cyclical references.
574 undef $self->{'table'};
575 undef $self->{'foreign_key_reference'};
578 # Must come after all 'has' declarations
579 around new => \&ex2err;
587 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.