1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.11 2003-06-27 16:47:40 kycl4rk Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
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.11 $ =~ /(\d+)\.(\d+)/;
55 # ----------------------------------------------------------------------
64 my $schema = SQL::Translator::Schema::Field->new;
68 my ( $self, $config ) = @_;
72 table name data_type size is_primary_key is_nullable
73 is_auto_increment default_value comments
76 next unless defined $config->{ $arg };
77 defined $self->$arg( $config->{ $arg } ) or return;
83 # ----------------------------------------------------------------------
90 Get or set the comments on a field. May be called several times to
91 set and it will accumulate the comments. Called in an array context,
92 returns each comment individually; called in a scalar context, returns
93 all the comments joined on newlines.
95 $field->comments('foo');
96 $field->comments('bar');
97 print join( ', ', $field->comments ); # prints "foo, bar"
104 $arg = $arg->[0] if ref $arg;
105 push @{ $self->{'comments'} }, $arg if $arg;
108 if ( @{ $self->{'comments'} || [] } ) {
110 ? @{ $self->{'comments'} || [] }
111 : join( "\n", @{ $self->{'comments'} || [] } );
114 return wantarray ? () : '';
119 # ----------------------------------------------------------------------
126 Get or set the field's data type.
128 my $data_type = $field->data_type('integer');
133 $self->{'data_type'} = shift if @_;
134 return $self->{'data_type'} || '';
137 # ----------------------------------------------------------------------
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 my ( $self, $arg ) = @_;
153 $self->{'default_value'} = $arg if defined $arg;
154 return $self->{'default_value'};
157 # ----------------------------------------------------------------------
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 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
175 while ( my ( $key, $value ) = each %$args ) {
176 $self->{'extra'}{ $key } = $value;
179 return %{ $self->{'extra'} || {} };
182 # ----------------------------------------------------------------------
183 sub foreign_key_reference {
187 =head2 foreign_key_reference
189 Get or set the field's foreign key reference;
191 my $constraint = $field->foreign_key_reference( $constraint );
197 if ( my $arg = shift ) {
198 my $class = 'SQL::Translator::Schema::Constraint';
199 if ( UNIVERSAL::isa( $arg, $class ) ) {
201 'Foreign key reference for ', $self->name, 'already defined'
202 ) if $self->{'foreign_key_reference'};
204 $self->{'foreign_key_reference'} = $arg;
208 "Argument to foreign_key_reference is not an $class object"
213 return $self->{'foreign_key_reference'};
216 # ----------------------------------------------------------------------
217 sub is_auto_increment {
221 =head2 is_auto_increment
223 Get or set the field's C<is_auto_increment> attribute.
225 my $is_pk = $field->is_auto_increment(1);
229 my ( $self, $arg ) = @_;
231 if ( defined $arg ) {
232 $self->{'is_auto_increment'} = $arg ? 1 : 0;
235 unless ( defined $self->{'is_auto_increment'} ) {
236 if ( my $table = $self->table ) {
237 if ( my $schema = $table->schema ) {
239 $schema->database eq 'PostgreSQL' &&
240 $self->data_type eq 'serial'
242 $self->{'is_auto_increment'} = 1;
248 return $self->{'is_auto_increment'} || 0;
251 # ----------------------------------------------------------------------
256 =head2 is_foreign_key
258 Returns whether or not the field is a foreign key.
260 my $is_fk = $field->is_foreign_key;
264 my ( $self, $arg ) = @_;
266 unless ( defined $self->{'is_foreign_key'} ) {
267 if ( my $table = $self->table ) {
268 for my $c ( $table->get_constraints ) {
269 if ( $c->type eq FOREIGN_KEY ) {
270 my %fields = map { $_, 1 } $c->fields;
271 if ( $fields{ $self->name } ) {
272 $self->{'is_foreign_key'} = 1;
273 $self->foreign_key_reference( $c );
281 return $self->{'is_foreign_key'} || 0;
284 # ----------------------------------------------------------------------
291 Get or set the whether the field can be null. If not defined, then
292 returns "1" (assumes the field can be null). The argument is evaluated
293 by Perl for True or False, so the following are eqivalent:
295 $is_nullable = $field->is_nullable(0);
296 $is_nullable = $field->is_nullable('');
297 $is_nullable = $field->is_nullable('0');
299 While this is technically a field constraint, it's probably easier to
300 represent this as an attribute of the field. In order keep things
301 consistent, any other constraint on the field (unique, primary, and
302 foreign keys; checks) are represented as table constraints.
306 my ( $self, $arg ) = @_;
308 if ( defined $arg ) {
309 $self->{'is_nullable'} = $arg ? 1 : 0;
312 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
315 # ----------------------------------------------------------------------
320 =head2 is_primary_key
322 Get or set the field's C<is_primary_key> attribute. Does not create
323 a table constraint (should it?).
325 my $is_pk = $field->is_primary_key(1);
329 my ( $self, $arg ) = @_;
331 if ( defined $arg ) {
332 $self->{'is_primary_key'} = $arg ? 1 : 0;
335 unless ( defined $self->{'is_primary_key'} ) {
336 if ( my $table = $self->table ) {
337 if ( my $pk = $table->primary_key ) {
338 my %fields = map { $_, 1 } $pk->fields;
339 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
342 $self->{'is_primary_key'} = 0;
347 return $self->{'is_primary_key'} || 0;
350 # ----------------------------------------------------------------------
357 Determine whether the field has a UNIQUE constraint or not.
359 my $is_unique = $field->is_unique;
365 unless ( defined $self->{'is_unique'} ) {
366 if ( my $table = $self->table ) {
367 for my $c ( $table->get_constraints ) {
368 if ( $c->type eq UNIQUE ) {
369 my %fields = map { $_, 1 } $c->fields;
370 if ( $fields{ $self->name } ) {
371 $self->{'is_unique'} = 1;
379 return $self->{'is_unique'} || 0;
382 # ----------------------------------------------------------------------
389 Determine whether the field is valid or not.
391 my $ok = $field->is_valid;
396 return $self->error('No name') unless $self->name;
397 return $self->error('No data type') unless $self->data_type;
398 return $self->error('No table object') unless $self->table;
402 # ----------------------------------------------------------------------
409 Get or set the field's name.
411 my $name = $field->name('foo');
417 if ( my $arg = shift ) {
418 if ( my $table = $self->table ) {
419 return $self->error( qq[Can't use field name "$arg": table exists] )
420 if $table->get_field( $arg );
423 $self->{'name'} = $arg;
426 return $self->{'name'} || '';
429 # ----------------------------------------------------------------------
436 Get or set the field's order.
438 my $order = $field->order(3);
442 my ( $self, $arg ) = @_;
444 if ( defined $arg && $arg =~ /^\d+$/ ) {
445 $self->{'order'} = $arg;
448 return $self->{'order'} || 0;
451 # ----------------------------------------------------------------------
458 Get or set the field's size. Accepts a string, array or arrayref of
459 numbers and returns a string.
462 $field->size( [ 255 ] );
463 $size = $field->size( 10, 2 );
464 print $size; # prints "10,2"
466 $size = $field->size( '10, 2' );
467 print $size; # prints "10,2"
472 my $numbers = parse_list_arg( @_ );
476 for my $num ( @$numbers ) {
477 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
481 $self->{'size'} = \@new if @new; # only set if all OK
485 ? @{ $self->{'size'} || [0] }
486 : join( ',', @{ $self->{'size'} || [0] } )
490 # ----------------------------------------------------------------------
497 Get or set the field's table object.
499 my $table = $field->table;
504 if ( my $arg = shift ) {
505 return $self->error('Not a table object') unless
506 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
507 $self->{'table'} = $arg;
510 return $self->{'table'};
513 # ----------------------------------------------------------------------
516 # Destroy cyclical references.
519 undef $self->{'table'};
520 undef $self->{'foreign_key_reference'};
525 # ----------------------------------------------------------------------
531 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>