1 package SQL::Translator::Schema::Field;
3 # ----------------------------------------------------------------------
4 # $Id: Field.pm,v 1.7 2003-06-06 22:35:44 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);
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"
102 push @{ $self->{'comments'} }, @_ if @_;
105 ? @{ $self->{'comments'} || [] }
106 : join( "\n", @{ $self->{'comments'} || [] } );
110 # ----------------------------------------------------------------------
117 Get or set the field's data type.
119 my $data_type = $field->data_type('integer');
124 $self->{'data_type'} = shift if @_;
125 return $self->{'data_type'} || '';
128 # ----------------------------------------------------------------------
135 Get or set the field's default value. Will return undef if not defined
136 and could return the empty string (it's a valid default value), so don't
137 assume an error like other methods.
139 my $default = $field->default_value('foo');
143 my ( $self, $arg ) = @_;
144 $self->{'default_value'} = $arg if defined $arg;
145 return $self->{'default_value'};
148 # ----------------------------------------------------------------------
155 Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL).
156 Accepts a hash(ref) of name/value pairs to store; returns a hash.
158 $field->extra( qualifier => 'ZEROFILL' );
159 my %extra = $field->extra;
164 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
166 while ( my ( $key, $value ) = each %$args ) {
167 $self->{'extra'}{ $key } = $value;
170 return %{ $self->{'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_pk = $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;
276 # ----------------------------------------------------------------------
283 Get or set the whether the field can be null. If not defined, then
284 returns "1" (assumes the field can be null). The argument is evaluated
285 by Perl for True or False, so the following are eqivalent:
287 $is_nullable = $field->is_nullable(0);
288 $is_nullable = $field->is_nullable('');
289 $is_nullable = $field->is_nullable('0');
291 While this is technically a field constraint, it's probably easier to
292 represent this as an attribute of the field. In order keep things
293 consistent, any other constraint on the field (unique, primary, and
294 foreign keys; checks) are represented as table constraints.
298 my ( $self, $arg ) = @_;
300 if ( defined $arg ) {
301 $self->{'is_nullable'} = $arg ? 1 : 0;
304 return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
307 # ----------------------------------------------------------------------
312 =head2 is_primary_key
314 Get or set the field's C<is_primary_key> attribute. Does not create
315 a table constraint (should it?).
317 my $is_pk = $field->is_primary_key(1);
321 my ( $self, $arg ) = @_;
323 if ( defined $arg ) {
324 $self->{'is_primary_key'} = $arg ? 1 : 0;
327 unless ( defined $self->{'is_primary_key'} ) {
328 if ( my $table = $self->table ) {
329 if ( my $pk = $table->primary_key ) {
330 my %fields = map { $_, 1 } $pk->fields;
331 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
334 $self->{'is_primary_key'} = 0;
339 return $self->{'is_primary_key'} || 0;
342 # ----------------------------------------------------------------------
349 Determine whether the field is valid or not.
351 my $ok = $field->is_valid;
356 return $self->error('No name') unless $self->name;
357 return $self->error('No data type') unless $self->data_type;
358 return $self->error('No table object') unless $self->table;
362 # ----------------------------------------------------------------------
369 Get or set the field's name.
371 my $name = $field->name('foo');
377 if ( my $arg = shift ) {
378 if ( my $table = $self->table ) {
379 return $self->error( qq[Can't use field name "$arg": table exists] )
380 if $table->get_field( $arg );
383 $self->{'name'} = $arg;
386 return $self->{'name'} || '';
389 # ----------------------------------------------------------------------
396 Get or set the field's order.
398 my $order = $field->order(3);
402 my ( $self, $arg ) = @_;
404 if ( defined $arg && $arg =~ /^\d+$/ ) {
405 $self->{'order'} = $arg;
408 return $self->{'order'} || 0;
411 # ----------------------------------------------------------------------
418 Get or set the field's size. Accepts a string, array or arrayref of
419 numbers and returns a string.
422 $field->size( [ 255 ] );
423 $size = $field->size( 10, 2 );
424 print $size; # prints "10,2"
426 $size = $field->size( '10, 2' );
427 print $size; # prints "10,2"
432 my $numbers = parse_list_arg( @_ );
436 for my $num ( @$numbers ) {
437 if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
441 $self->{'size'} = \@new if @new; # only set if all OK
445 ? @{ $self->{'size'} }
446 : join( ',', @{ $self->{'size'} || [0] } )
450 # ----------------------------------------------------------------------
457 Get or set the field's table object.
459 my $table = $field->table;
464 if ( my $arg = shift ) {
465 return $self->error('Not a table object') unless
466 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
467 $self->{'table'} = $arg;
470 return $self->{'table'};
473 # ----------------------------------------------------------------------
476 # Destroy cyclical references.
479 undef $self->{'table'};
480 undef $self->{'foreign_key_reference'};
485 # ----------------------------------------------------------------------
491 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>