1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.18 2004-03-29 09:57:50 grommit Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
27 SQL::Translator::Schema::Field - SQL::Translator field object
31 use SQL::Translator::Schema::Field;
32 my $field = SQL::Translator::Schema::Field->new(
39 C<SQL::Translator::Schema::Field> is the field object.
47 use SQL::Translator::Schema::Constants;
48 use SQL::Translator::Utils 'parse_list_arg';
50 use base 'Class::Base';
51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
53 $VERSION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
55 # Stringify to our name, being careful not to pass any args through so we don't
56 # accidentally set it to undef. We also have to tweak bool so the object is
57 # still true when it doesn't have a name (which shouldn't happen!).
59 '""' => sub { shift->name },
60 'bool' => sub { $_[0]->name || $_[0] },
64 # ----------------------------------------------------------------------
73 my $field = SQL::Translator::Schema::Field->new(
80 my ( $self, $config ) = @_;
84 table name data_type size is_primary_key is_nullable
85 is_auto_increment default_value comments
88 next unless defined $config->{ $arg };
89 defined $self->$arg( $config->{ $arg } ) or return;
95 # ----------------------------------------------------------------------
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 ? () : '';
131 # ----------------------------------------------------------------------
138 Get or set the field's data type.
140 my $data_type = $field->data_type('integer');
145 $self->{'data_type'} = shift if @_;
146 return $self->{'data_type'} || '';
149 # ----------------------------------------------------------------------
156 Get or set the field's default value. Will return undef if not defined
157 and could return the empty string (it's a valid default value), so don't
158 assume an error like other methods.
160 my $default = $field->default_value('foo');
164 my ( $self, $arg ) = @_;
165 $self->{'default_value'} = $arg if defined $arg;
166 return $self->{'default_value'};
169 # ----------------------------------------------------------------------
176 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
177 Accepts a hash(ref) of name/value pairs to store; returns a hash.
179 $field->extra( qualifier => 'ZEROFILL' );
180 my %extra = $field->extra;
185 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
187 while ( my ( $key, $value ) = each %$args ) {
188 $self->{'extra'}{ $key } = $value;
191 return %{ $self->{'extra'} || {} };
194 # ----------------------------------------------------------------------
195 sub foreign_key_reference {
199 =head2 foreign_key_reference
201 Get or set the field's foreign key reference;
203 my $constraint = $field->foreign_key_reference( $constraint );
209 if ( my $arg = shift ) {
210 my $class = 'SQL::Translator::Schema::Constraint';
211 if ( UNIVERSAL::isa( $arg, $class ) ) {
213 'Foreign key reference for ', $self->name, 'already defined'
214 ) if $self->{'foreign_key_reference'};
216 $self->{'foreign_key_reference'} = $arg;
220 "Argument to foreign_key_reference is not an $class object"
225 return $self->{'foreign_key_reference'};
228 # ----------------------------------------------------------------------
229 sub is_auto_increment {
233 =head2 is_auto_increment
235 Get or set the field's C<is_auto_increment> attribute.
237 my $is_auto = $field->is_auto_increment(1);
241 my ( $self, $arg ) = @_;
243 if ( defined $arg ) {
244 $self->{'is_auto_increment'} = $arg ? 1 : 0;
247 unless ( defined $self->{'is_auto_increment'} ) {
248 if ( my $table = $self->table ) {
249 if ( my $schema = $table->schema ) {
251 $schema->database eq 'PostgreSQL' &&
252 $self->data_type eq 'serial'
254 $self->{'is_auto_increment'} = 1;
260 return $self->{'is_auto_increment'} || 0;
263 # ----------------------------------------------------------------------
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;
296 # ----------------------------------------------------------------------
303 Get or set whether the field can be null. If not defined, then
304 returns "1" (assumes the field can be null). The argument is evaluated
305 by Perl for True or False, so the following are eqivalent:
307 $is_nullable = $field->is_nullable(0);
308 $is_nullable = $field->is_nullable('');
309 $is_nullable = $field->is_nullable('0');
311 While this is technically a field constraint, it's probably easier to
312 represent this as an attribute of the field. In order keep things
313 consistent, any other constraint on the field (unique, primary, and
314 foreign keys; checks) are represented as table constraints.
318 my ( $self, $arg ) = @_;
320 if ( defined $arg ) {
321 $self->{'is_nullable'} = $arg ? 1 : 0;
325 defined $self->{'is_nullable'} &&
326 $self->{'is_nullable'} == 1 &&
327 $self->is_primary_key
329 $self->{'is_nullable'} = 0;
332 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
335 # ----------------------------------------------------------------------
340 =head2 is_primary_key
342 Get or set the field's C<is_primary_key> attribute. Does not create
343 a table constraint (should it?).
345 my $is_pk = $field->is_primary_key(1);
349 my ( $self, $arg ) = @_;
351 if ( defined $arg ) {
352 $self->{'is_primary_key'} = $arg ? 1 : 0;
355 unless ( defined $self->{'is_primary_key'} ) {
356 if ( my $table = $self->table ) {
357 if ( my $pk = $table->primary_key ) {
358 my %fields = map { $_, 1 } $pk->fields;
359 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
362 $self->{'is_primary_key'} = 0;
367 return $self->{'is_primary_key'} || 0;
370 # ----------------------------------------------------------------------
377 Determine whether the field has a UNIQUE constraint or not.
379 my $is_unique = $field->is_unique;
385 unless ( defined $self->{'is_unique'} ) {
386 if ( my $table = $self->table ) {
387 for my $c ( $table->get_constraints ) {
388 if ( $c->type eq UNIQUE ) {
389 my %fields = map { $_, 1 } $c->fields;
390 if ( $fields{ $self->name } ) {
391 $self->{'is_unique'} = 1;
399 return $self->{'is_unique'} || 0;
402 # ----------------------------------------------------------------------
409 Determine whether the field is valid or not.
411 my $ok = $field->is_valid;
416 return $self->error('No name') unless $self->name;
417 return $self->error('No data type') unless $self->data_type;
418 return $self->error('No table object') unless $self->table;
422 # ----------------------------------------------------------------------
429 Get or set the field's name.
431 my $name = $field->name('foo');
433 The field object will also stringify to its name.
435 my $setter_name = "set_$field";
437 Errors ("No field name") if you try to set a blank name.
444 my $arg = shift || return $self->error( "No field name" );
445 if ( my $table = $self->table ) {
446 return $self->error( qq[Can't use field name "$arg": field exists] )
447 if $table->get_field( $arg );
450 $self->{'name'} = $arg;
453 return $self->{'name'} || '';
460 Read only method to return the fields name with its table name pre-pended.
466 return $self->table.".".$self->name;
469 # ----------------------------------------------------------------------
476 Get or set the field's order.
478 my $order = $field->order(3);
482 my ( $self, $arg ) = @_;
484 if ( defined $arg && $arg =~ /^\d+$/ ) {
485 $self->{'order'} = $arg;
488 return $self->{'order'} || 0;
491 # ----------------------------------------------------------------------
496 Shortcut to get the fields schema ($field->table->schema) or undef if it
499 my $schema = $field->schema;
504 if ( my $table = $self->table ) { return $table->schema || undef; }
508 # ----------------------------------------------------------------------
515 Get or set the field's size. Accepts a string, array or arrayref of
516 numbers and returns a string.
519 $field->size( [ 255 ] );
520 $size = $field->size( 10, 2 );
521 print $size; # prints "10,2"
523 $size = $field->size( '10, 2' );
524 print $size; # prints "10,2"
529 my $numbers = parse_list_arg( @_ );
533 for my $num ( @$numbers ) {
534 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
538 $self->{'size'} = \@new if @new; # only set if all OK
542 ? @{ $self->{'size'} || [0] }
543 : join( ',', @{ $self->{'size'} || [0] } )
547 # ----------------------------------------------------------------------
554 Get or set the field's table object. As the table object stringifies this can
555 also be used to get the table name.
557 my $table = $field->table;
558 print "Table name: $table";
563 if ( my $arg = shift ) {
564 return $self->error('Not a table object') unless
565 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
566 $self->{'table'} = $arg;
569 return $self->{'table'};
572 # ----------------------------------------------------------------------
575 # Destroy cyclical references.
578 undef $self->{'table'};
579 undef $self->{'foreign_key_reference'};
584 # ----------------------------------------------------------------------
590 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.