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);
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 contstant
48 integer => SQL_INTEGER,
51 smallint => SQL_SMALLINT,
52 bigint => 9999, # DBI doesn't export a constatn 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 => sub { 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" attibutes (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 => sub { $_[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 => sub { $_[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 eqivalent:
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 => sub { $_[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 => sub { $_[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 sub _build_is_unique {
327 if ( my $table = $self->table ) {
328 for my $c ( $table->get_constraints ) {
329 if ( $c->type eq UNIQUE ) {
330 my %fields = map { $_, 1 } $c->fields;
331 if ( $fields{ $self->name } ) {
346 Determine whether the field is valid or not.
348 my $ok = $field->is_valid;
353 return $self->error('No name') unless $self->name;
354 return $self->error('No data type') unless $self->data_type;
355 return $self->error('No table object') unless $self->table;
361 Get or set the field's name.
363 my $name = $field->name('foo');
365 The field object will also stringify to its name.
367 my $setter_name = "set_$field";
369 Errors ("No field name") if you try to set a blank name.
373 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
379 if ( my ($arg) = @_ ) {
380 if ( my $schema = $self->table ) {
381 return $self->error( qq[Can't use field name "$arg": field exists] )
382 if $schema->get_field( $arg );
386 return ex2err($orig, $self, @_);
393 Read only method to return the fields name with its table name pre-pended.
399 return $self->table.".".$self->name;
404 Get or set the field's order.
406 my $order = $field->order(3);
410 has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
412 around order => sub {
413 my ( $orig, $self, $arg ) = @_;
415 if ( defined $arg && $arg =~ /^\d+$/ ) {
416 return $self->$orig($arg);
426 Shortcut to get the fields schema ($field->table->schema) or undef if it
429 my $schema = $field->schema;
434 if ( my $table = $self->table ) { return $table->schema || undef; }
440 Get or set the field's size. Accepts a string, array or arrayref of
441 numbers and returns a string.
444 $field->size( [ 255 ] );
445 $size = $field->size( 10, 2 );
446 print $size; # prints "10,2"
448 $size = $field->size( '10, 2' );
449 print $size; # prints "10,2"
455 default => quote_sub(q{ [0] }),
457 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
458 @sizes ? \@sizes : [0];
465 my $numbers = parse_list_arg( @_ );
469 for my $num ( @$numbers ) {
470 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
474 $self->$orig(\@new) if @new; # only set if all OK
478 ? @{ $self->$orig || [0] }
479 : join( ',', @{ $self->$orig || [0] } )
485 Get or set the field's table object. As the table object stringifies this can
486 also be used to get the table name.
488 my $table = $field->table;
489 print "Table name: $table";
493 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
495 around table => \&ex2err;
499 Returns the field exactly as the parser found it
503 has parsed_field => ( is => 'rw' );
505 around parsed_field => sub {
509 return $self->$orig(@_) || $self;
514 Determines if this field is the same as another
516 my $isIdentical = $field1->equals( $field2 );
520 around equals => sub {
524 my $case_insensitive = shift;
526 return 0 unless $self->$orig($other);
527 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
529 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
530 if ($self->sql_data_type && $other->sql_data_type) {
531 return 0 unless $self->sql_data_type == $other->sql_data_type
533 return 0 unless lc($self->data_type) eq lc($other->data_type)
536 return 0 unless $self->size eq $other->size;
539 my $lhs = $self->default_value;
540 $lhs = \'NULL' unless defined $lhs;
541 my $lhs_is_ref = ! ! ref $lhs;
543 my $rhs = $other->default_value;
544 $rhs = \'NULL' unless defined $rhs;
545 my $rhs_is_ref = ! ! ref $rhs;
547 # If only one is a ref, fail. -- rjbs, 2008-12-02
548 return 0 if $lhs_is_ref xor $rhs_is_ref;
550 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
551 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
553 return 0 if $effective_lhs ne $effective_rhs;
556 return 0 unless $self->is_nullable eq $other->is_nullable;
557 # return 0 unless $self->is_unique eq $other->is_unique;
558 return 0 unless $self->is_primary_key eq $other->is_primary_key;
559 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
560 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
561 # return 0 unless $self->comments eq $other->comments;
562 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
566 # Must come after all 'has' declarations
567 around new => \&ex2err;
575 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.