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::Utils 'parse_list_arg';
29 use base 'SQL::Translator::Schema::Object';
31 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
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
77 __PACKAGE__->_attributes( qw/
78 table name data_type size is_primary_key is_nullable
79 is_auto_increment default_value comments is_foreign_key
80 is_unique order sql_data_type
89 my $field = SQL::Translator::Schema::Field->new(
102 Get or set the comments on a field. May be called several times to
103 set and it will accumulate the comments. Called in an array context,
104 returns each comment individually; called in a scalar context, returns
105 all the comments joined on newlines.
107 $field->comments('foo');
108 $field->comments('bar');
109 print join( ', ', $field->comments ); # prints "foo, bar"
116 $arg = $arg->[0] if ref $arg;
117 push @{ $self->{'comments'} }, $arg if $arg;
120 if ( @{ $self->{'comments'} || [] } ) {
122 ? @{ $self->{'comments'} || [] }
123 : join( "\n", @{ $self->{'comments'} || [] } );
126 return wantarray ? () : '';
137 Get or set the field's data type.
139 my $data_type = $field->data_type('integer');
145 $self->{'data_type'} = $_[0];
146 $self->{'sql_data_type'} = $type_mapping{lc $_[0]} || SQL_UNKNOWN_TYPE unless exists $self->{sql_data_type};
148 return $self->{'data_type'} || '';
155 Constant from DBI package representing this data type. See L<DBI/DBI Constants>
161 $self->{sql_data_type} = shift if @_;
162 return $self->{sql_data_type} || 0;
172 Get or set the field's default value. Will return undef if not defined
173 and could return the empty string (it's a valid default value), so don't
174 assume an error like other methods.
176 my $default = $field->default_value('foo');
181 $self->{'default_value'} = shift if @_;
182 return $self->{'default_value'};
189 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
190 Accepts a hash(ref) of name/value pairs to store; returns a hash.
192 $field->extra( qualifier => 'ZEROFILL' );
193 my %extra = $field->extra;
197 sub foreign_key_reference {
201 =head2 foreign_key_reference
203 Get or set the field's foreign key reference;
205 my $constraint = $field->foreign_key_reference( $constraint );
211 if ( my $arg = shift ) {
212 my $class = 'SQL::Translator::Schema::Constraint';
213 if ( UNIVERSAL::isa( $arg, $class ) ) {
215 'Foreign key reference for ', $self->name, 'already defined'
216 ) if $self->{'foreign_key_reference'};
218 $self->{'foreign_key_reference'} = $arg;
222 "Argument to foreign_key_reference is not an $class object"
227 return $self->{'foreign_key_reference'};
230 sub is_auto_increment {
234 =head2 is_auto_increment
236 Get or set the field's C<is_auto_increment> attribute.
238 my $is_auto = $field->is_auto_increment(1);
242 my ( $self, $arg ) = @_;
244 if ( defined $arg ) {
245 $self->{'is_auto_increment'} = $arg ? 1 : 0;
248 unless ( defined $self->{'is_auto_increment'} ) {
249 if ( my $table = $self->table ) {
250 if ( my $schema = $table->schema ) {
252 $schema->database eq 'PostgreSQL' &&
253 $self->data_type eq 'serial'
255 $self->{'is_auto_increment'} = 1;
261 return $self->{'is_auto_increment'} || 0;
268 =head2 is_foreign_key
270 Returns whether or not the field is a foreign key.
272 my $is_fk = $field->is_foreign_key;
276 my ( $self, $arg ) = @_;
278 unless ( defined $self->{'is_foreign_key'} ) {
279 if ( my $table = $self->table ) {
280 for my $c ( $table->get_constraints ) {
281 if ( $c->type eq FOREIGN_KEY ) {
282 my %fields = map { $_, 1 } $c->fields;
283 if ( $fields{ $self->name } ) {
284 $self->{'is_foreign_key'} = 1;
285 $self->foreign_key_reference( $c );
293 return $self->{'is_foreign_key'} || 0;
302 Get or set whether the field can be null. If not defined, then
303 returns "1" (assumes the field can be null). The argument is evaluated
304 by Perl for True or False, so the following are eqivalent:
306 $is_nullable = $field->is_nullable(0);
307 $is_nullable = $field->is_nullable('');
308 $is_nullable = $field->is_nullable('0');
310 While this is technically a field constraint, it's probably easier to
311 represent this as an attribute of the field. In order keep things
312 consistent, any other constraint on the field (unique, primary, and
313 foreign keys; checks) are represented as table constraints.
317 my ( $self, $arg ) = @_;
319 if ( defined $arg ) {
320 $self->{'is_nullable'} = $arg ? 1 : 0;
324 defined $self->{'is_nullable'} &&
325 $self->{'is_nullable'} == 1 &&
326 $self->is_primary_key
328 $self->{'is_nullable'} = 0;
331 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
338 =head2 is_primary_key
340 Get or set the field's C<is_primary_key> attribute. Does not create
341 a table constraint (should it?).
343 my $is_pk = $field->is_primary_key(1);
347 my ( $self, $arg ) = @_;
349 if ( defined $arg ) {
350 $self->{'is_primary_key'} = $arg ? 1 : 0;
353 unless ( defined $self->{'is_primary_key'} ) {
354 if ( my $table = $self->table ) {
355 if ( my $pk = $table->primary_key ) {
356 my %fields = map { $_, 1 } $pk->fields;
357 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
360 $self->{'is_primary_key'} = 0;
365 return $self->{'is_primary_key'} || 0;
374 Determine whether the field has a UNIQUE constraint or not.
376 my $is_unique = $field->is_unique;
382 unless ( defined $self->{'is_unique'} ) {
383 if ( my $table = $self->table ) {
384 for my $c ( $table->get_constraints ) {
385 if ( $c->type eq UNIQUE ) {
386 my %fields = map { $_, 1 } $c->fields;
387 if ( $fields{ $self->name } ) {
388 $self->{'is_unique'} = 1;
396 return $self->{'is_unique'} || 0;
405 Determine whether the field is valid or not.
407 my $ok = $field->is_valid;
412 return $self->error('No name') unless $self->name;
413 return $self->error('No data type') unless $self->data_type;
414 return $self->error('No table object') unless $self->table;
424 Get or set the field's name.
426 my $name = $field->name('foo');
428 The field object will also stringify to its name.
430 my $setter_name = "set_$field";
432 Errors ("No field name") if you try to set a blank name.
439 my $arg = shift || return $self->error( "No field name" );
440 if ( my $table = $self->table ) {
441 return $self->error( qq[Can't use field name "$arg": field exists] )
442 if $table->get_field( $arg );
445 $self->{'name'} = $arg;
448 return $self->{'name'} || '';
455 Read only method to return the fields name with its table name pre-pended.
461 return $self->table.".".$self->name;
470 Get or set the field's order.
472 my $order = $field->order(3);
476 my ( $self, $arg ) = @_;
478 if ( defined $arg && $arg =~ /^\d+$/ ) {
479 $self->{'order'} = $arg;
482 return $self->{'order'} || 0;
489 Shortcut to get the fields schema ($field->table->schema) or undef if it
492 my $schema = $field->schema;
497 if ( my $table = $self->table ) { return $table->schema || undef; }
507 Get or set the field's size. Accepts a string, array or arrayref of
508 numbers and returns a string.
511 $field->size( [ 255 ] );
512 $size = $field->size( 10, 2 );
513 print $size; # prints "10,2"
515 $size = $field->size( '10, 2' );
516 print $size; # prints "10,2"
521 my $numbers = parse_list_arg( @_ );
525 for my $num ( @$numbers ) {
526 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
530 $self->{'size'} = \@new if @new; # only set if all OK
534 ? @{ $self->{'size'} || [0] }
535 : join( ',', @{ $self->{'size'} || [0] } )
545 Get or set the field's table object. As the table object stringifies this can
546 also be used to get the table name.
548 my $table = $field->table;
549 print "Table name: $table";
554 if ( my $arg = shift ) {
555 return $self->error('Not a table object') unless
556 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
557 $self->{'table'} = $arg;
560 return $self->{'table'};
567 Returns the field exactly as the parser found it
575 $self->{parsed_field} = $value;
576 return $value || $self;
578 return $self->{parsed_field} || $self;
587 Determines if this field is the same as another
589 my $isIdentical = $field1->equals( $field2 );
595 my $case_insensitive = shift;
597 return 0 unless $self->SUPER::equals($other);
598 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
600 # Comparing types: use sql_data_type if both are not 0. Else use string data_type
601 if ($self->sql_data_type && $other->sql_data_type) {
602 return 0 unless $self->sql_data_type == $other->sql_data_type
604 return 0 unless lc($self->data_type) eq lc($other->data_type)
607 return 0 unless $self->size eq $other->size;
610 my $lhs = $self->default_value;
611 $lhs = \'NULL' unless defined $lhs;
612 my $lhs_is_ref = ! ! ref $lhs;
614 my $rhs = $other->default_value;
615 $rhs = \'NULL' unless defined $rhs;
616 my $rhs_is_ref = ! ! ref $rhs;
618 # If only one is a ref, fail. -- rjbs, 2008-12-02
619 return 0 if $lhs_is_ref xor $rhs_is_ref;
621 my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
622 my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
624 return 0 if $effective_lhs ne $effective_rhs;
627 return 0 unless $self->is_nullable eq $other->is_nullable;
628 # return 0 unless $self->is_unique eq $other->is_unique;
629 return 0 unless $self->is_primary_key eq $other->is_primary_key;
630 # return 0 unless $self->is_foreign_key eq $other->is_foreign_key;
631 return 0 unless $self->is_auto_increment eq $other->is_auto_increment;
632 # return 0 unless $self->comments eq $other->comments;
633 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
639 # Destroy cyclical references.
642 undef $self->{'table'};
643 undef $self->{'foreign_key_reference'};
652 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.