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'),
184 around foreign_key_reference => sub {
188 if ( my $arg = shift ) {
190 'Foreign key reference for ', $self->name, 'already defined'
191 ) if $self->_has_foreign_key_reference;
193 return ex2err($orig, $self, $arg);
198 =head2 is_auto_increment
200 Get or set the field's C<is_auto_increment> attribute.
202 my $is_auto = $field->is_auto_increment(1);
206 has is_auto_increment => (
208 coerce => sub { $_[0] ? 1 : 0 },
213 sub _build_is_auto_increment {
216 if ( my $table = $self->table ) {
217 if ( my $schema = $table->schema ) {
219 $schema->database eq 'PostgreSQL' &&
220 $self->data_type eq 'serial'
229 =head2 is_foreign_key
231 Returns whether or not the field is a foreign key.
233 my $is_fk = $field->is_foreign_key;
237 has is_foreign_key => (
239 coerce => sub { $_[0] ? 1 : 0 },
244 sub _build_is_foreign_key {
247 if ( my $table = $self->table ) {
248 for my $c ( $table->get_constraints ) {
249 if ( $c->type eq FOREIGN_KEY ) {
250 my %fields = map { $_, 1 } $c->fields;
251 if ( $fields{ $self->name } ) {
252 $self->foreign_key_reference( $c );
263 Get or set whether the field can be null. If not defined, then
264 returns "1" (assumes the field can be null). The argument is evaluated
265 by Perl for True or False, so the following are eqivalent:
267 $is_nullable = $field->is_nullable(0);
268 $is_nullable = $field->is_nullable('');
269 $is_nullable = $field->is_nullable('0');
271 While this is technically a field constraint, it's probably easier to
272 represent this as an attribute of the field. In order keep things
273 consistent, any other constraint on the field (unique, primary, and
274 foreign keys; checks) are represented as table constraints.
280 coerce => sub { $_[0] ? 1 : 0 },
281 default => sub { 1 },
284 around is_nullable => sub {
285 my ($orig, $self, $arg) = @_;
287 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
290 =head2 is_primary_key
292 Get or set the field's C<is_primary_key> attribute. Does not create
293 a table constraint (should it?).
295 my $is_pk = $field->is_primary_key(1);
299 has is_primary_key => (
301 coerce => sub { $_[0] ? 1 : 0 },
306 sub _build_is_primary_key {
309 if ( my $table = $self->table ) {
310 if ( my $pk = $table->primary_key ) {
311 my %fields = map { $_, 1 } $pk->fields;
312 return $fields{ $self->name } || 0;
320 Determine whether the field has a UNIQUE constraint or not.
322 my $is_unique = $field->is_unique;
326 has is_unique => ( is => 'lazy', init_arg => undef );
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 => sub { 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 => sub { [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 return 0 if $effective_lhs ne $effective_rhs;
560 return 0 unless $self->is_nullable eq $other->is_nullable;
561 # return 0 unless $self->is_unique eq $other->is_unique;
562 return 0 unless $self->is_primary_key eq $other->is_primary_key;
563 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
564 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
565 # return 0 unless $self->comments eq $other->comments;
566 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
570 # Must come after all 'has' declarations
571 around new => \&ex2err;
579 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.