1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.14 2004-03-23 21:05:19 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(
34 sql => 'select * from foo',
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.14 $ =~ /(\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 $schema = SQL::Translator::Schema::Field->new;
77 my ( $self, $config ) = @_;
81 table name data_type size is_primary_key is_nullable
82 is_auto_increment default_value comments
85 next unless defined $config->{ $arg };
86 defined $self->$arg( $config->{ $arg } ) or return;
92 # ----------------------------------------------------------------------
99 Get or set the comments on a field. May be called several times to
100 set and it will accumulate the comments. Called in an array context,
101 returns each comment individually; called in a scalar context, returns
102 all the comments joined on newlines.
104 $field->comments('foo');
105 $field->comments('bar');
106 print join( ', ', $field->comments ); # prints "foo, bar"
113 $arg = $arg->[0] if ref $arg;
114 push @{ $self->{'comments'} }, $arg if $arg;
117 if ( @{ $self->{'comments'} || [] } ) {
119 ? @{ $self->{'comments'} || [] }
120 : join( "\n", @{ $self->{'comments'} || [] } );
123 return wantarray ? () : '';
128 # ----------------------------------------------------------------------
135 Get or set the field's data type.
137 my $data_type = $field->data_type('integer');
142 $self->{'data_type'} = shift if @_;
143 return $self->{'data_type'} || '';
146 # ----------------------------------------------------------------------
153 Get or set the field's default value. Will return undef if not defined
154 and could return the empty string (it's a valid default value), so don't
155 assume an error like other methods.
157 my $default = $field->default_value('foo');
161 my ( $self, $arg ) = @_;
162 $self->{'default_value'} = $arg if defined $arg;
163 return $self->{'default_value'};
166 # ----------------------------------------------------------------------
173 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
174 Accepts a hash(ref) of name/value pairs to store; returns a hash.
176 $field->extra( qualifier => 'ZEROFILL' );
177 my %extra = $field->extra;
182 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
184 while ( my ( $key, $value ) = each %$args ) {
185 $self->{'extra'}{ $key } = $value;
188 return %{ $self->{'extra'} || {} };
191 # ----------------------------------------------------------------------
192 sub foreign_key_reference {
196 =head2 foreign_key_reference
198 Get or set the field's foreign key reference;
200 my $constraint = $field->foreign_key_reference( $constraint );
206 if ( my $arg = shift ) {
207 my $class = 'SQL::Translator::Schema::Constraint';
208 if ( UNIVERSAL::isa( $arg, $class ) ) {
210 'Foreign key reference for ', $self->name, 'already defined'
211 ) if $self->{'foreign_key_reference'};
213 $self->{'foreign_key_reference'} = $arg;
217 "Argument to foreign_key_reference is not an $class object"
222 return $self->{'foreign_key_reference'};
225 # ----------------------------------------------------------------------
226 sub is_auto_increment {
230 =head2 is_auto_increment
232 Get or set the field's C<is_auto_increment> attribute.
234 my $is_pk = $field->is_auto_increment(1);
238 my ( $self, $arg ) = @_;
240 if ( defined $arg ) {
241 $self->{'is_auto_increment'} = $arg ? 1 : 0;
244 unless ( defined $self->{'is_auto_increment'} ) {
245 if ( my $table = $self->table ) {
246 if ( my $schema = $table->schema ) {
248 $schema->database eq 'PostgreSQL' &&
249 $self->data_type eq 'serial'
251 $self->{'is_auto_increment'} = 1;
257 return $self->{'is_auto_increment'} || 0;
260 # ----------------------------------------------------------------------
265 =head2 is_foreign_key
267 Returns whether or not the field is a foreign key.
269 my $is_fk = $field->is_foreign_key;
273 my ( $self, $arg ) = @_;
275 unless ( defined $self->{'is_foreign_key'} ) {
276 if ( my $table = $self->table ) {
277 for my $c ( $table->get_constraints ) {
278 if ( $c->type eq FOREIGN_KEY ) {
279 my %fields = map { $_, 1 } $c->fields;
280 if ( $fields{ $self->name } ) {
281 $self->{'is_foreign_key'} = 1;
282 $self->foreign_key_reference( $c );
290 return $self->{'is_foreign_key'} || 0;
293 # ----------------------------------------------------------------------
300 Get or set the whether the field can be null. If not defined, then
301 returns "1" (assumes the field can be null). The argument is evaluated
302 by Perl for True or False, so the following are eqivalent:
304 $is_nullable = $field->is_nullable(0);
305 $is_nullable = $field->is_nullable('');
306 $is_nullable = $field->is_nullable('0');
308 While this is technically a field constraint, it's probably easier to
309 represent this as an attribute of the field. In order keep things
310 consistent, any other constraint on the field (unique, primary, and
311 foreign keys; checks) are represented as table constraints.
315 my ( $self, $arg ) = @_;
317 if ( defined $arg ) {
318 $self->{'is_nullable'} = $arg ? 1 : 0;
322 defined $self->{'is_nullable'} &&
323 $self->{'is_nullable'} == 1 &&
324 $self->is_primary_key
326 $self->{'is_nullable'} = 0;
329 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
332 # ----------------------------------------------------------------------
337 =head2 is_primary_key
339 Get or set the field's C<is_primary_key> attribute. Does not create
340 a table constraint (should it?).
342 my $is_pk = $field->is_primary_key(1);
346 my ( $self, $arg ) = @_;
348 if ( defined $arg ) {
349 $self->{'is_primary_key'} = $arg ? 1 : 0;
352 unless ( defined $self->{'is_primary_key'} ) {
353 if ( my $table = $self->table ) {
354 if ( my $pk = $table->primary_key ) {
355 my %fields = map { $_, 1 } $pk->fields;
356 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
359 $self->{'is_primary_key'} = 0;
364 return $self->{'is_primary_key'} || 0;
367 # ----------------------------------------------------------------------
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;
399 # ----------------------------------------------------------------------
406 Determine whether the field is valid or not.
408 my $ok = $field->is_valid;
413 return $self->error('No name') unless $self->name;
414 return $self->error('No data type') unless $self->data_type;
415 return $self->error('No table object') unless $self->table;
419 # ----------------------------------------------------------------------
426 Get or set the field's name.
428 my $name = $field->name('foo');
430 The field object will also stringify to its name.
432 my $setter_name = "set_$field";
434 Errors ("No field name") if you try to set a blank name.
441 my $arg = shift || return $self->error( "No field name" );
442 if ( my $table = $self->table ) {
443 return $self->error( qq[Can't use field name "$arg": field exists] )
444 if $table->get_field( $arg );
447 $self->{'name'} = $arg;
450 return $self->{'name'} || '';
453 # ----------------------------------------------------------------------
460 Get or set the field's order.
462 my $order = $field->order(3);
466 my ( $self, $arg ) = @_;
468 if ( defined $arg && $arg =~ /^\d+$/ ) {
469 $self->{'order'} = $arg;
472 return $self->{'order'} || 0;
475 # ----------------------------------------------------------------------
482 Get or set the field's size. Accepts a string, array or arrayref of
483 numbers and returns a string.
486 $field->size( [ 255 ] );
487 $size = $field->size( 10, 2 );
488 print $size; # prints "10,2"
490 $size = $field->size( '10, 2' );
491 print $size; # prints "10,2"
496 my $numbers = parse_list_arg( @_ );
500 for my $num ( @$numbers ) {
501 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
505 $self->{'size'} = \@new if @new; # only set if all OK
509 ? @{ $self->{'size'} || [0] }
510 : join( ',', @{ $self->{'size'} || [0] } )
514 # ----------------------------------------------------------------------
521 Get or set the field's table object.
523 my $table = $field->table;
528 if ( my $arg = shift ) {
529 return $self->error('Not a table object') unless
530 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
531 $self->{'table'} = $arg;
534 return $self->{'table'};
537 # ----------------------------------------------------------------------
540 # Destroy cyclical references.
543 undef $self->{'table'};
544 undef $self->{'foreign_key_reference'};
549 # ----------------------------------------------------------------------
555 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.