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);
32 extends 'SQL::Translator::Schema::Object';
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 constant
49 integer => SQL_INTEGER,
52 tinyint => SQL_TINYINT,
53 smallint => SQL_SMALLINT,
58 decimal => SQL_DECIMAL,
59 numeric => SQL_NUMERIC,
65 datetime => SQL_DATETIME,
66 timestamp => SQL_TIMESTAMP,
70 varchar => SQL_VARCHAR,
72 varbinary => SQL_VARBINARY,
75 text => SQL_LONGVARCHAR
79 has _numeric_sql_data_types => ( is => 'lazy' );
81 sub _build__numeric_sql_data_types {
84 (SQL_INTEGER, SQL_TINYINT, SQL_SMALLINT, SQL_BIGINT, SQL_DOUBLE,
85 SQL_NUMERIC, SQL_DECIMAL, SQL_FLOAT, SQL_REAL)
93 my $field = SQL::Translator::Schema::Field->new(
100 Get or set the comments on a field. May be called several times to
101 set and it will accumulate the comments. Called in an array context,
102 returns each comment individually; called in a scalar context, returns
103 all the comments joined on newlines.
105 $field->comments('foo');
106 $field->comments('bar');
107 print join( ', ', $field->comments ); # prints "foo, bar"
113 coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
114 default => quote_sub(q{ [] }),
117 around comments => sub {
122 $arg = $arg->[0] if ref $arg;
123 push @{ $self->$orig }, $arg if $arg;
128 : join( "\n", @{ $self->$orig } );
134 Get or set the field's data type.
136 my $data_type = $field->data_type('integer');
140 has data_type => ( is => 'rw', default => quote_sub(q{ '' }) );
144 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
149 has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
151 sub _build_sql_data_type {
152 $type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
157 Get or set the field's default value. Will return undef if not defined
158 and could return the empty string (it's a valid default value), so don't
159 assume an error like other methods.
161 my $default = $field->default_value('foo');
165 has default_value => ( is => 'rw' );
167 =head2 foreign_key_reference
169 Get or set the field's foreign key reference;
171 my $constraint = $field->foreign_key_reference( $constraint );
175 has foreign_key_reference => (
177 predicate => '_has_foreign_key_reference',
178 isa => schema_obj('Constraint'),
182 around foreign_key_reference => sub {
186 if ( my $arg = shift ) {
188 'Foreign key reference for ', $self->name, 'already defined'
189 ) if $self->_has_foreign_key_reference;
191 return ex2err($orig, $self, $arg);
196 =head2 is_auto_increment
198 Get or set the field's C<is_auto_increment> attribute.
200 my $is_auto = $field->is_auto_increment(1);
204 has is_auto_increment => (
206 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
211 sub _build_is_auto_increment {
214 if ( my $table = $self->table ) {
215 if ( my $schema = $table->schema ) {
217 $schema->database eq 'PostgreSQL' &&
218 $self->data_type eq 'serial'
227 =head2 is_foreign_key
229 Returns whether or not the field is a foreign key.
231 my $is_fk = $field->is_foreign_key;
235 has is_foreign_key => (
237 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
242 sub _build_is_foreign_key {
245 if ( my $table = $self->table ) {
246 for my $c ( $table->get_constraints ) {
247 if ( $c->type eq FOREIGN_KEY ) {
248 my %fields = map { $_, 1 } $c->fields;
249 if ( $fields{ $self->name } ) {
250 $self->foreign_key_reference( $c );
261 Get or set whether the field can be null. If not defined, then
262 returns "1" (assumes the field can be null). The argument is evaluated
263 by Perl for True or False, so the following are equivalent:
265 $is_nullable = $field->is_nullable(0);
266 $is_nullable = $field->is_nullable('');
267 $is_nullable = $field->is_nullable('0');
269 While this is technically a field constraint, it's probably easier to
270 represent this as an attribute of the field. In order keep things
271 consistent, any other constraint on the field (unique, primary, and
272 foreign keys; checks) are represented as table constraints.
278 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
279 default => quote_sub(q{ 1 }),
282 around is_nullable => sub {
283 my ($orig, $self, $arg) = @_;
285 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
288 =head2 is_primary_key
290 Get or set the field's C<is_primary_key> attribute. Does not create
291 a table constraint (should it?).
293 my $is_pk = $field->is_primary_key(1);
297 has is_primary_key => (
299 coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
304 sub _build_is_primary_key {
307 if ( my $table = $self->table ) {
308 if ( my $pk = $table->primary_key ) {
309 my %fields = map { $_, 1 } $pk->fields;
310 return $fields{ $self->name } || 0;
318 Determine whether the field has a UNIQUE constraint or not.
320 my $is_unique = $field->is_unique;
324 has is_unique => ( is => 'lazy', init_arg => undef );
326 around is_unique => carp_ro('is_unique');
328 sub _build_is_unique {
331 if ( my $table = $self->table ) {
332 for my $c ( $table->get_constraints ) {
333 if ( $c->type eq UNIQUE ) {
334 my %fields = map { $_, 1 } $c->fields;
335 if ( $fields{ $self->name } ) {
350 Determine whether the field is valid or not.
352 my $ok = $field->is_valid;
357 return $self->error('No name') unless $self->name;
358 return $self->error('No data type') unless $self->data_type;
359 return $self->error('No table object') unless $self->table;
365 Get or set the field's name.
367 my $name = $field->name('foo');
369 The field object will also stringify to its name.
371 my $setter_name = "set_$field";
373 Errors ("No field name") if you try to set a blank name.
377 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
383 if ( my ($arg) = @_ ) {
384 if ( my $schema = $self->table ) {
385 return $self->error( qq[Can't use field name "$arg": field exists] )
386 if $schema->get_field( $arg );
390 return ex2err($orig, $self, @_);
397 Read only method to return the fields name with its table name pre-pended.
403 return $self->table.".".$self->name;
408 Get or set the field's order.
410 my $order = $field->order(3);
414 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
416 around order => sub {
417 my ( $orig, $self, $arg ) = @_;
419 if ( defined $arg && $arg =~ /^\d+$/ ) {
420 return $self->$orig($arg);
430 Shortcut to get the fields schema ($field->table->schema) or undef if it
433 my $schema = $field->schema;
438 if ( my $table = $self->table ) { return $table->schema || undef; }
444 Get or set the field's size. Accepts a string, array or arrayref of
445 numbers and returns a string.
448 $field->size( [ 255 ] );
449 $size = $field->size( 10, 2 );
450 print $size; # prints "10,2"
452 $size = $field->size( '10, 2' );
453 print $size; # prints "10,2"
459 default => quote_sub(q{ [0] }),
461 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
462 @sizes ? \@sizes : [0];
469 my $numbers = parse_list_arg( @_ );
473 for my $num ( @$numbers ) {
474 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
478 $self->$orig(\@new) if @new; # only set if all OK
482 ? @{ $self->$orig || [0] }
483 : join( ',', @{ $self->$orig || [0] } )
489 Get or set the field's table object. As the table object stringifies this can
490 also be used to get the table name.
492 my $table = $field->table;
493 print "Table name: $table";
497 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
499 around table => \&ex2err;
503 Returns the field exactly as the parser found it
507 has parsed_field => ( is => 'rw' );
509 around parsed_field => sub {
513 return $self->$orig(@_) || $self;
518 Determines if this field is the same as another
520 my $isIdentical = $field1->equals( $field2 );
524 around equals => sub {
528 my $case_insensitive = shift;
530 return 0 unless $self->$orig($other);
531 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
533 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
534 if ($self->sql_data_type && $other->sql_data_type) {
535 return 0 unless $self->sql_data_type == $other->sql_data_type
537 return 0 unless lc($self->data_type) eq lc($other->data_type)
540 return 0 unless $self->size eq $other->size;
543 my $lhs = $self->default_value;
544 $lhs = \'NULL' unless defined $lhs;
545 my $lhs_is_ref = ! ! ref $lhs;
547 my $rhs = $other->default_value;
548 $rhs = \'NULL' unless defined $rhs;
549 my $rhs_is_ref = ! ! ref $rhs;
551 # If only one is a ref, fail. -- rjbs, 2008-12-02
552 return 0 if $lhs_is_ref xor $rhs_is_ref;
554 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
555 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
557 if ( $self->_is_numeric_data_type
558 && Scalar::Util::looks_like_number($effective_lhs)
559 && Scalar::Util::looks_like_number($effective_rhs) ) {
560 return 0 if ($effective_lhs + 0) != ($effective_rhs + 0);
563 return 0 if $effective_lhs ne $effective_rhs;
567 return 0 unless $self->is_nullable eq $other->is_nullable;
568 # return 0 unless $self->is_unique eq $other->is_unique;
569 return 0 unless $self->is_primary_key eq $other->is_primary_key;
570 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
571 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
572 # return 0 unless $self->comments eq $other->comments;
573 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
577 # Must come after all 'has' declarations
578 around new => \&ex2err;
580 sub _is_numeric_data_type {
582 return $self->_numeric_sql_data_types->{ $self->sql_data_type };
591 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.