1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.22 2004-11-05 15:03:10 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.
46 use SQL::Translator::Schema::Constants;
47 use SQL::Translator::Utils 'parse_list_arg';
49 use base 'SQL::Translator::Schema::Object';
51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
53 $VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\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 # ----------------------------------------------------------------------
66 __PACKAGE__->_attributes( qw/
67 table name data_type size is_primary_key is_nullable
68 is_auto_increment default_value comments is_foreign_key
78 my $field = SQL::Translator::Schema::Field->new(
85 # ----------------------------------------------------------------------
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"
106 $arg = $arg->[0] if ref $arg;
107 push @{ $self->{'comments'} }, $arg if $arg;
110 if ( @{ $self->{'comments'} || [] } ) {
112 ? @{ $self->{'comments'} || [] }
113 : join( "\n", @{ $self->{'comments'} || [] } );
116 return wantarray ? () : '';
121 # ----------------------------------------------------------------------
128 Get or set the field's data type.
130 my $data_type = $field->data_type('integer');
135 $self->{'data_type'} = shift if @_;
136 return $self->{'data_type'} || '';
139 # ----------------------------------------------------------------------
146 Get or set the field's default value. Will return undef if not defined
147 and could return the empty string (it's a valid default value), so don't
148 assume an error like other methods.
150 my $default = $field->default_value('foo');
154 my ( $self, $arg ) = @_;
155 $self->{'default_value'} = $arg if defined $arg;
156 return $self->{'default_value'};
159 # ----------------------------------------------------------------------
164 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
165 Accepts a hash(ref) of name/value pairs to store; returns a hash.
167 $field->extra( qualifier => 'ZEROFILL' );
168 my %extra = $field->extra;
173 # ----------------------------------------------------------------------
174 sub foreign_key_reference {
178 =head2 foreign_key_reference
180 Get or set the field's foreign key reference;
182 my $constraint = $field->foreign_key_reference( $constraint );
188 if ( my $arg = shift ) {
189 my $class = 'SQL::Translator::Schema::Constraint';
190 if ( UNIVERSAL::isa( $arg, $class ) ) {
192 'Foreign key reference for ', $self->name, 'already defined'
193 ) if $self->{'foreign_key_reference'};
195 $self->{'foreign_key_reference'} = $arg;
199 "Argument to foreign_key_reference is not an $class object"
204 return $self->{'foreign_key_reference'};
207 # ----------------------------------------------------------------------
208 sub is_auto_increment {
212 =head2 is_auto_increment
214 Get or set the field's C<is_auto_increment> attribute.
216 my $is_auto = $field->is_auto_increment(1);
220 my ( $self, $arg ) = @_;
222 if ( defined $arg ) {
223 $self->{'is_auto_increment'} = $arg ? 1 : 0;
226 unless ( defined $self->{'is_auto_increment'} ) {
227 if ( my $table = $self->table ) {
228 if ( my $schema = $table->schema ) {
230 $schema->database eq 'PostgreSQL' &&
231 $self->data_type eq 'serial'
233 $self->{'is_auto_increment'} = 1;
239 return $self->{'is_auto_increment'} || 0;
242 # ----------------------------------------------------------------------
247 =head2 is_foreign_key
249 Returns whether or not the field is a foreign key.
251 my $is_fk = $field->is_foreign_key;
255 my ( $self, $arg ) = @_;
257 unless ( defined $self->{'is_foreign_key'} ) {
258 if ( my $table = $self->table ) {
259 for my $c ( $table->get_constraints ) {
260 if ( $c->type eq FOREIGN_KEY ) {
261 my %fields = map { $_, 1 } $c->fields;
262 if ( $fields{ $self->name } ) {
263 $self->{'is_foreign_key'} = 1;
264 $self->foreign_key_reference( $c );
272 return $self->{'is_foreign_key'} || 0;
275 # ----------------------------------------------------------------------
282 Get or set whether the field can be null. If not defined, then
283 returns "1" (assumes the field can be null). The argument is evaluated
284 by Perl for True or False, so the following are eqivalent:
286 $is_nullable = $field->is_nullable(0);
287 $is_nullable = $field->is_nullable('');
288 $is_nullable = $field->is_nullable('0');
290 While this is technically a field constraint, it's probably easier to
291 represent this as an attribute of the field. In order keep things
292 consistent, any other constraint on the field (unique, primary, and
293 foreign keys; checks) are represented as table constraints.
297 my ( $self, $arg ) = @_;
299 if ( defined $arg ) {
300 $self->{'is_nullable'} = $arg ? 1 : 0;
304 defined $self->{'is_nullable'} &&
305 $self->{'is_nullable'} == 1 &&
306 $self->is_primary_key
308 $self->{'is_nullable'} = 0;
311 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
314 # ----------------------------------------------------------------------
319 =head2 is_primary_key
321 Get or set the field's C<is_primary_key> attribute. Does not create
322 a table constraint (should it?).
324 my $is_pk = $field->is_primary_key(1);
328 my ( $self, $arg ) = @_;
330 if ( defined $arg ) {
331 $self->{'is_primary_key'} = $arg ? 1 : 0;
334 unless ( defined $self->{'is_primary_key'} ) {
335 if ( my $table = $self->table ) {
336 if ( my $pk = $table->primary_key ) {
337 my %fields = map { $_, 1 } $pk->fields;
338 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
341 $self->{'is_primary_key'} = 0;
346 return $self->{'is_primary_key'} || 0;
349 # ----------------------------------------------------------------------
356 Determine whether the field has a UNIQUE constraint or not.
358 my $is_unique = $field->is_unique;
364 unless ( defined $self->{'is_unique'} ) {
365 if ( my $table = $self->table ) {
366 for my $c ( $table->get_constraints ) {
367 if ( $c->type eq UNIQUE ) {
368 my %fields = map { $_, 1 } $c->fields;
369 if ( $fields{ $self->name } ) {
370 $self->{'is_unique'} = 1;
378 return $self->{'is_unique'} || 0;
381 # ----------------------------------------------------------------------
388 Determine whether the field is valid or not.
390 my $ok = $field->is_valid;
395 return $self->error('No name') unless $self->name;
396 return $self->error('No data type') unless $self->data_type;
397 return $self->error('No table object') unless $self->table;
401 # ----------------------------------------------------------------------
408 Get or set the field's name.
410 my $name = $field->name('foo');
412 The field object will also stringify to its name.
414 my $setter_name = "set_$field";
416 Errors ("No field name") if you try to set a blank name.
423 my $arg = shift || return $self->error( "No field name" );
424 if ( my $table = $self->table ) {
425 return $self->error( qq[Can't use field name "$arg": field exists] )
426 if $table->get_field( $arg );
429 $self->{'name'} = $arg;
432 return $self->{'name'} || '';
439 Read only method to return the fields name with its table name pre-pended.
445 return $self->table.".".$self->name;
448 # ----------------------------------------------------------------------
455 Get or set the field's order.
457 my $order = $field->order(3);
461 my ( $self, $arg ) = @_;
463 if ( defined $arg && $arg =~ /^\d+$/ ) {
464 $self->{'order'} = $arg;
467 return $self->{'order'} || 0;
470 # ----------------------------------------------------------------------
475 Shortcut to get the fields schema ($field->table->schema) or undef if it
478 my $schema = $field->schema;
483 if ( my $table = $self->table ) { return $table->schema || undef; }
487 # ----------------------------------------------------------------------
494 Get or set the field's size. Accepts a string, array or arrayref of
495 numbers and returns a string.
498 $field->size( [ 255 ] );
499 $size = $field->size( 10, 2 );
500 print $size; # prints "10,2"
502 $size = $field->size( '10, 2' );
503 print $size; # prints "10,2"
508 my $numbers = parse_list_arg( @_ );
512 for my $num ( @$numbers ) {
513 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
517 $self->{'size'} = \@new if @new; # only set if all OK
521 ? @{ $self->{'size'} || [0] }
522 : join( ',', @{ $self->{'size'} || [0] } )
526 # ----------------------------------------------------------------------
533 Get or set the field's table object. As the table object stringifies this can
534 also be used to get the table name.
536 my $table = $field->table;
537 print "Table name: $table";
542 if ( my $arg = shift ) {
543 return $self->error('Not a table object') unless
544 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
545 $self->{'table'} = $arg;
548 return $self->{'table'};
551 # ----------------------------------------------------------------------
554 # Destroy cyclical references.
557 undef $self->{'table'};
558 undef $self->{'foreign_key_reference'};
563 # ----------------------------------------------------------------------
569 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.