X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FField.pm;h=c2b4fa6ef1ffd0ef959534b8db4985bda2d4d07f;hb=aafe595b2a974fa16aa5b2daf7709f099dd09522;hp=c31e0753d976330d961aeffa8fc43893741c7219;hpb=43b9dc7ab0953ab9f4cbadf7810509d63d2ed87a;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index c31e075..c2b4fa6 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/lib/SQL/Translator/Schema/Field.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Field; # ---------------------------------------------------------------------- -# $Id: Field.pm,v 1.3 2003-05-05 04:32:39 kycl4rk Exp $ +# $Id: Field.pm,v 1.12 2003-08-12 22:03:59 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -45,11 +45,12 @@ C is the field object. use strict; use Class::Base; use SQL::Translator::Schema::Constants; +use SQL::Translator::Utils 'parse_list_arg'; use base 'Class::Base'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = 1.00; +$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/; # ---------------------------------------------------------------------- sub init { @@ -66,14 +67,56 @@ Object constructor. my ( $self, $config ) = @_; - for my $arg ( qw[ name data_type size is_primary_key nullable table ] ) { + for my $arg ( + qw[ + table name data_type size is_primary_key is_nullable + is_auto_increment default_value comments + ] + ) { next unless defined $config->{ $arg }; - $self->$arg( $config->{ $arg } ) or return; + defined $self->$arg( $config->{ $arg } ) or return; } + return $self; } # ---------------------------------------------------------------------- +sub comments { + +=pod + +=head2 comments + +Get or set the comments on a field. May be called several times to +set and it will accumulate the comments. Called in an array context, +returns each comment individually; called in a scalar context, returns +all the comments joined on newlines. + + $field->comments('foo'); + $field->comments('bar'); + print join( ', ', $field->comments ); # prints "foo, bar" + +=cut + + my $self = shift; + + for my $arg ( @_ ) { + $arg = $arg->[0] if ref $arg; + push @{ $self->{'comments'} }, $arg if $arg; + } + + if ( @{ $self->{'comments'} || [] } ) { + return wantarray + ? @{ $self->{'comments'} || [] } + : join( "\n", @{ $self->{'comments'} || [] } ); + } + else { + return wantarray ? () : ''; + } +} + + +# ---------------------------------------------------------------------- sub data_type { =pod @@ -112,6 +155,65 @@ assume an error like other methods. } # ---------------------------------------------------------------------- +sub extra { + +=pod + +=head2 extra + +Get or set the field's "extra" attibutes (e.g., "ZEROFILL" for MySQL). +Accepts a hash(ref) of name/value pairs to store; returns a hash. + + $field->extra( qualifier => 'ZEROFILL' ); + my %extra = $field->extra; + +=cut + + my $self = shift; + my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; + + while ( my ( $key, $value ) = each %$args ) { + $self->{'extra'}{ $key } = $value; + } + + return %{ $self->{'extra'} || {} }; +} + +# ---------------------------------------------------------------------- +sub foreign_key_reference { + +=pod + +=head2 foreign_key_reference + +Get or set the field's foreign key reference; + + my $constraint = $field->foreign_key_reference( $constraint ); + +=cut + + my $self = shift; + + if ( my $arg = shift ) { + my $class = 'SQL::Translator::Schema::Constraint'; + if ( UNIVERSAL::isa( $arg, $class ) ) { + return $self->error( + 'Foreign key reference for ', $self->name, 'already defined' + ) if $self->{'foreign_key_reference'}; + + $self->{'foreign_key_reference'} = $arg; + } + else { + return $self->error( + "Argument to foreign_key_reference is not an $class object" + ); + } + } + + return $self->{'foreign_key_reference'}; +} + +# ---------------------------------------------------------------------- sub is_auto_increment { =pod @@ -147,13 +249,86 @@ Get or set the field's C attribute. } # ---------------------------------------------------------------------- +sub is_foreign_key { + +=pod + +=head2 is_foreign_key + +Returns whether or not the field is a foreign key. + + my $is_fk = $field->is_foreign_key; + +=cut + + my ( $self, $arg ) = @_; + + unless ( defined $self->{'is_foreign_key'} ) { + if ( my $table = $self->table ) { + for my $c ( $table->get_constraints ) { + if ( $c->type eq FOREIGN_KEY ) { + my %fields = map { $_, 1 } $c->fields; + if ( $fields{ $self->name } ) { + $self->{'is_foreign_key'} = 1; + $self->foreign_key_reference( $c ); + last; + } + } + } + } + } + + return $self->{'is_foreign_key'} || 0; +} + +# ---------------------------------------------------------------------- +sub is_nullable { + +=pod + +=head2 is_nullable + +Get or set the whether the field can be null. If not defined, then +returns "1" (assumes the field can be null). The argument is evaluated +by Perl for True or False, so the following are eqivalent: + + $is_nullable = $field->is_nullable(0); + $is_nullable = $field->is_nullable(''); + $is_nullable = $field->is_nullable('0'); + +While this is technically a field constraint, it's probably easier to +represent this as an attribute of the field. In order keep things +consistent, any other constraint on the field (unique, primary, and +foreign keys; checks) are represented as table constraints. + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg ) { + $self->{'is_nullable'} = $arg ? 1 : 0; + } + + if ( + defined $self->{'is_nullable'} && + $self->{'is_nullable'} == 1 && + $self->is_primary_key + ) { + $self->{'is_nullable'} = 0; + } + + return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1; +} + +# ---------------------------------------------------------------------- sub is_primary_key { =pod =head2 is_primary_key -Get or set the field's C attribute. +Get or set the field's C attribute. Does not create +a table constraint (should it?). my $is_pk = $field->is_primary_key(1); @@ -181,6 +356,58 @@ Get or set the field's C attribute. } # ---------------------------------------------------------------------- +sub is_unique { + +=pod + +=head2 is_unique + +Determine whether the field has a UNIQUE constraint or not. + + my $is_unique = $field->is_unique; + +=cut + + my $self = shift; + + unless ( defined $self->{'is_unique'} ) { + if ( my $table = $self->table ) { + for my $c ( $table->get_constraints ) { + if ( $c->type eq UNIQUE ) { + my %fields = map { $_, 1 } $c->fields; + if ( $fields{ $self->name } ) { + $self->{'is_unique'} = 1; + last; + } + } + } + } + } + + return $self->{'is_unique'} || 0; +} + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the field is valid or not. + + my $ok = $field->is_valid; + +=cut + + my $self = shift; + return $self->error('No name') unless $self->name; + return $self->error('No data type') unless $self->data_type; + return $self->error('No table object') unless $self->table; + return 1; +} + +# ---------------------------------------------------------------------- sub name { =pod @@ -208,29 +435,25 @@ Get or set the field's name. } # ---------------------------------------------------------------------- -sub nullable { +sub order { =pod -=head2 nullable +=head2 order -Get or set the whether the field can be null. If not defined, then -returns "1" (assumes the field can be null). The argument is evaluated -by Perl for True or False, so the following are eqivalent: +Get or set the field's order. - $nullable = $field->nullable(0); - $nullable = $field->nullable(''); - $nullable = $field->nullable('0'); + my $order = $field->order(3); =cut my ( $self, $arg ) = @_; - if ( defined $arg ) { - $self->{'nullable'} = $arg ? 1 : 0; + if ( defined $arg && $arg =~ /^\d+$/ ) { + $self->{'order'} = $arg; } - return defined $self->{'nullable'} ? $self->{'nullable'} : 1; + return $self->{'order'} || 0; } # ---------------------------------------------------------------------- @@ -254,8 +477,7 @@ numbers and returns a string. =cut my $self = shift; - my $numbers = UNIVERSAL::isa( $_[0], 'ARRAY' ) - ? shift : [ map { split /,/ } @_ ]; + my $numbers = parse_list_arg( @_ ); if ( @$numbers ) { my @new; @@ -267,27 +489,10 @@ numbers and returns a string. $self->{'size'} = \@new if @new; # only set if all OK } - return join( ',', @{ $self->{'size'} || [0] } ); -} - -# ---------------------------------------------------------------------- -sub is_valid { - -=pod - -=head2 is_valid - -Determine whether the field is valid or not. - - my $ok = $field->is_valid; - -=cut - - my $self = shift; - return $self->error('No name') unless $self->name; - return $self->error('No data type') unless $self->data_type; - return $self->error('No table object') unless $self->table; - return 1; + return wantarray + ? @{ $self->{'size'} || [0] } + : join( ',', @{ $self->{'size'} || [0] } ) + ; } # ---------------------------------------------------------------------- @@ -313,6 +518,16 @@ Get or set the field's table object. return $self->{'table'}; } +# ---------------------------------------------------------------------- +sub DESTROY { +# +# Destroy cyclical references. +# + my $self = shift; + undef $self->{'table'}; + undef $self->{'foreign_key_reference'}; +} + 1; # ----------------------------------------------------------------------