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);
30 extends 'SQL::Translator::Schema::Object';
32 our $VERSION = '1.59';
34 # Stringify to our name, being careful not to pass any args through so we don't
35 # accidentally set it to undef. We also have to tweak bool so the object is
36 # still true when it doesn't have a name (which shouldn't happen!).
38 '""' => sub { shift->name },
39 'bool' => sub { $_[0]->name || $_[0] },
43 use DBI qw(:sql_types);
45 # Mapping from string to sql contstant
47 integer => SQL_INTEGER,
50 smallint => SQL_SMALLINT,
51 bigint => 9999, # DBI doesn't export a constatn for this. Le suck
55 decimal => SQL_DECIMAL,
56 numeric => SQL_NUMERIC,
62 datetime => SQL_DATETIME,
63 timestamp => SQL_TIMESTAMP,
67 varchar => SQL_VARCHAR,
69 varbinary => SQL_VARBINARY,
72 text => SQL_LONGVARCHAR
80 my $field = SQL::Translator::Schema::Field->new(
87 Get or set the comments on a field. May be called several times to
88 set and it will accumulate the comments. Called in an array context,
89 returns each comment individually; called in a scalar context, returns
90 all the comments joined on newlines.
92 $field->comments('foo');
93 $field->comments('bar');
94 print join( ', ', $field->comments ); # prints "foo, bar"
100 coerce => sub { ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] },
101 default => sub { [] },
104 around comments => sub {
109 $arg = $arg->[0] if ref $arg;
110 push @{ $self->$orig }, $arg if $arg;
115 : join( "\n", @{ $self->$orig } );
121 Get or set the field's data type.
123 my $data_type = $field->data_type('integer');
127 has data_type => ( is => 'rw', default => sub { '' } );
131 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
136 has sql_data_type => ( is => 'rw', lazy => 1, builder => 1 );
138 sub _build_sql_data_type {
139 $type_mapping{lc $_[0]->data_type} || SQL_UNKNOWN_TYPE;
144 Get or set the field's default value. Will return undef if not defined
145 and could return the empty string (it's a valid default value), so don't
146 assume an error like other methods.
148 my $default = $field->default_value('foo');
152 has default_value => ( is => 'rw' );
156 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
157 Accepts a hash(ref) of name/value pairs to store; returns a hash.
159 $field->extra( qualifier => 'ZEROFILL' );
160 my %extra = $field->extra;
164 =head2 foreign_key_reference
166 Get or set the field's foreign key reference;
168 my $constraint = $field->foreign_key_reference( $constraint );
172 has foreign_key_reference => (
174 predicate => '_has_foreign_key_reference',
175 isa => schema_obj('Constraint'),
179 around foreign_key_reference => sub {
183 if ( my $arg = shift ) {
185 'Foreign key reference for ', $self->name, 'already defined'
186 ) if $self->_has_foreign_key_reference;
188 return ex2err($orig, $self, $arg);
193 =head2 is_auto_increment
195 Get or set the field's C<is_auto_increment> attribute.
197 my $is_auto = $field->is_auto_increment(1);
201 has is_auto_increment => (
203 coerce => sub { $_[0] ? 1 : 0 },
208 sub _build_is_auto_increment {
211 if ( my $table = $self->table ) {
212 if ( my $schema = $table->schema ) {
214 $schema->database eq 'PostgreSQL' &&
215 $self->data_type eq 'serial'
224 =head2 is_foreign_key
226 Returns whether or not the field is a foreign key.
228 my $is_fk = $field->is_foreign_key;
232 has is_foreign_key => (
234 coerce => sub { $_[0] ? 1 : 0 },
239 sub _build_is_foreign_key {
242 if ( my $table = $self->table ) {
243 for my $c ( $table->get_constraints ) {
244 if ( $c->type eq FOREIGN_KEY ) {
245 my %fields = map { $_, 1 } $c->fields;
246 if ( $fields{ $self->name } ) {
247 $self->foreign_key_reference( $c );
258 Get or set whether the field can be null. If not defined, then
259 returns "1" (assumes the field can be null). The argument is evaluated
260 by Perl for True or False, so the following are eqivalent:
262 $is_nullable = $field->is_nullable(0);
263 $is_nullable = $field->is_nullable('');
264 $is_nullable = $field->is_nullable('0');
266 While this is technically a field constraint, it's probably easier to
267 represent this as an attribute of the field. In order keep things
268 consistent, any other constraint on the field (unique, primary, and
269 foreign keys; checks) are represented as table constraints.
275 coerce => sub { $_[0] ? 1 : 0 },
276 default => sub { 1 },
279 around is_nullable => sub {
280 my ($orig, $self, $arg) = @_;
282 $self->$orig($self->is_primary_key ? 0 : defined $arg ? $arg : ());
285 =head2 is_primary_key
287 Get or set the field's C<is_primary_key> attribute. Does not create
288 a table constraint (should it?).
290 my $is_pk = $field->is_primary_key(1);
294 has is_primary_key => (
296 coerce => sub { $_[0] ? 1 : 0 },
301 sub _build_is_primary_key {
304 if ( my $table = $self->table ) {
305 if ( my $pk = $table->primary_key ) {
306 my %fields = map { $_, 1 } $pk->fields;
307 return $fields{ $self->name } || 0;
315 Determine whether the field has a UNIQUE constraint or not.
317 my $is_unique = $field->is_unique;
321 has is_unique => ( is => 'lazy', init_arg => undef );
323 sub _build_is_unique {
326 if ( my $table = $self->table ) {
327 for my $c ( $table->get_constraints ) {
328 if ( $c->type eq UNIQUE ) {
329 my %fields = map { $_, 1 } $c->fields;
330 if ( $fields{ $self->name } ) {
345 Determine whether the field is valid or not.
347 my $ok = $field->is_valid;
352 return $self->error('No name') unless $self->name;
353 return $self->error('No data type') unless $self->data_type;
354 return $self->error('No table object') unless $self->table;
360 Get or set the field's name.
362 my $name = $field->name('foo');
364 The field object will also stringify to its name.
366 my $setter_name = "set_$field";
368 Errors ("No field name") if you try to set a blank name.
372 has name => ( is => 'rw', isa => sub { throw( "No field name" ) unless $_[0] } );
378 if ( my ($arg) = @_ ) {
379 if ( my $schema = $self->table ) {
380 return $self->error( qq[Can't use field name "$arg": field exists] )
381 if $schema->get_field( $arg );
385 return ex2err($orig, $self, @_);
392 Read only method to return the fields name with its table name pre-pended.
398 return $self->table.".".$self->name;
403 Get or set the field's order.
405 my $order = $field->order(3);
409 has order => ( is => 'rw', default => sub { 0 } );
411 around order => sub {
412 my ( $orig, $self, $arg ) = @_;
414 if ( defined $arg && $arg =~ /^\d+$/ ) {
415 return $self->$orig($arg);
425 Shortcut to get the fields schema ($field->table->schema) or undef if it
428 my $schema = $field->schema;
433 if ( my $table = $self->table ) { return $table->schema || undef; }
439 Get or set the field's size. Accepts a string, array or arrayref of
440 numbers and returns a string.
443 $field->size( [ 255 ] );
444 $size = $field->size( 10, 2 );
445 print $size; # prints "10,2"
447 $size = $field->size( '10, 2' );
448 print $size; # prints "10,2"
454 default => sub { [0] },
456 my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
457 @sizes ? \@sizes : [0];
464 my $numbers = parse_list_arg( @_ );
468 for my $num ( @$numbers ) {
469 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
473 $self->$orig(\@new) if @new; # only set if all OK
477 ? @{ $self->$orig || [0] }
478 : join( ',', @{ $self->$orig || [0] } )
484 Get or set the field's table object. As the table object stringifies this can
485 also be used to get the table name.
487 my $table = $field->table;
488 print "Table name: $table";
492 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
494 around table => \&ex2err;
498 Returns the field exactly as the parser found it
502 has parsed_field => ( is => 'rw' );
504 around parsed_field => sub {
508 return $self->$orig(@_) || $self;
513 Determines if this field is the same as another
515 my $isIdentical = $field1->equals( $field2 );
519 around equals => sub {
523 my $case_insensitive = shift;
525 return 0 unless $self->$orig($other);
526 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
528 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
529 if ($self->sql_data_type && $other->sql_data_type) {
530 return 0 unless $self->sql_data_type == $other->sql_data_type
532 return 0 unless lc($self->data_type) eq lc($other->data_type)
535 return 0 unless $self->size eq $other->size;
538 my $lhs = $self->default_value;
539 $lhs = \'NULL' unless defined $lhs;
540 my $lhs_is_ref = ! ! ref $lhs;
542 my $rhs = $other->default_value;
543 $rhs = \'NULL' unless defined $rhs;
544 my $rhs_is_ref = ! ! ref $rhs;
546 # If only one is a ref, fail. -- rjbs, 2008-12-02
547 return 0 if $lhs_is_ref xor $rhs_is_ref;
549 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
550 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
552 return 0 if $effective_lhs ne $effective_rhs;
555 return 0 unless $self->is_nullable eq $other->is_nullable;
556 # return 0 unless $self->is_unique eq $other->is_unique;
557 return 0 unless $self->is_primary_key eq $other->is_primary_key;
558 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
559 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
560 # return 0 unless $self->comments eq $other->comments;
561 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
565 # Must come after all 'has' declarations
566 around new => \&ex2err;
574 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.