X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FField.pm;h=e87e121c53333950551385959770648b3f34d1b2;hb=b178940934ec79968ed16511ec2644f3736c92f2;hp=00b03cc10401f01506efdf54e316c43da2958415;hpb=3c5de62a52d2d49bd3de3768d6f649565fa620e9;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 00b03cc..e87e121 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/lib/SQL/Translator/Schema/Field.pm @@ -1,9 +1,9 @@ package SQL::Translator::Schema::Field; # ---------------------------------------------------------------------- -# $Id: Field.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# $Id: Field.pm,v 1.22 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- -# Copyright (C) 2003 Ken Y. Clark +# Copyright (C) 2002-4 SQLFairy Authors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -30,8 +30,8 @@ SQL::Translator::Schema::Field - SQL::Translator field object use SQL::Translator::Schema::Field; my $field = SQL::Translator::Schema::Field->new( - name => 'foo', - sql => 'select * from foo', + name => 'foo', + table => $table, ); =head1 DESCRIPTION @@ -43,15 +43,31 @@ C is the field object. =cut use strict; -use Class::Base; +use SQL::Translator::Schema::Constants; +use SQL::Translator::Utils 'parse_list_arg'; + +use base 'SQL::Translator::Schema::Object'; -use base 'Class::Base'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = 1.00; +$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\d+)\.(\d+)/; + +# Stringify to our name, being careful not to pass any args through so we don't +# accidentally set it to undef. We also have to tweak bool so the object is +# still true when it doesn't have a name (which shouldn't happen!). +use overload + '""' => sub { shift->name }, + 'bool' => sub { $_[0]->name || $_[0] }, + fallback => 1, +; # ---------------------------------------------------------------------- -sub init { + +__PACKAGE__->_attributes( qw/ + table name data_type size is_primary_key is_nullable + is_auto_increment default_value comments is_foreign_key + is_unique order +/); =pod @@ -59,15 +75,49 @@ sub init { Object constructor. - my $schema = SQL::Translator::Schema::Field->new; + my $field = SQL::Translator::Schema::Field->new( + name => 'foo', + table => $table, + ); =cut - my ( $self, $config ) = @_; - $self->params( $config, qw[ name data_type size is_primary_key ] ); - 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 { @@ -75,7 +125,7 @@ sub data_type { =head2 data_type -Get or set the field's data_type. +Get or set the field's data type. my $data_type = $field->data_type('integer'); @@ -87,13 +137,189 @@ Get or set the field's data_type. } # ---------------------------------------------------------------------- +sub default_value { + +=pod + +=head2 default_value + +Get or set the field's default value. Will return undef if not defined +and could return the empty string (it's a valid default value), so don't +assume an error like other methods. + + my $default = $field->default_value('foo'); + +=cut + + my ( $self, $arg ) = @_; + $self->{'default_value'} = $arg if defined $arg; + return $self->{'default_value'}; +} + +# ---------------------------------------------------------------------- +=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 + + +# ---------------------------------------------------------------------- +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 + +=head2 is_auto_increment + +Get or set the field's C attribute. + + my $is_auto = $field->is_auto_increment(1); + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg ) { + $self->{'is_auto_increment'} = $arg ? 1 : 0; + } + + unless ( defined $self->{'is_auto_increment'} ) { + if ( my $table = $self->table ) { + if ( my $schema = $table->schema ) { + if ( + $schema->database eq 'PostgreSQL' && + $self->data_type eq 'serial' + ) { + $self->{'is_auto_increment'} = 1; + } + } + } + } + + return $self->{'is_auto_increment'} || 0; +} + +# ---------------------------------------------------------------------- +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 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 is_primary_key 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); @@ -105,10 +331,74 @@ Get or set the field's is_primary_key attribute. $self->{'is_primary_key'} = $arg ? 1 : 0; } + unless ( defined $self->{'is_primary_key'} ) { + if ( my $table = $self->table ) { + if ( my $pk = $table->primary_key ) { + my %fields = map { $_, 1 } $pk->fields; + $self->{'is_primary_key'} = $fields{ $self->name } || 0; + } + else { + $self->{'is_primary_key'} = 0; + } + } + } + return $self->{'is_primary_key'} || 0; } # ---------------------------------------------------------------------- +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 @@ -117,52 +407,155 @@ sub name { Get or set the field's name. - my $name = $field->name('foo'); + my $name = $field->name('foo'); + +The field object will also stringify to its name. + + my $setter_name = "set_$field"; + +Errors ("No field name") if you try to set a blank name. =cut my $self = shift; - $self->{'name'} = shift if @_; + + if ( @_ ) { + my $arg = shift || return $self->error( "No field name" ); + if ( my $table = $self->table ) { + return $self->error( qq[Can't use field name "$arg": field exists] ) + if $table->get_field( $arg ); + } + + $self->{'name'} = $arg; + } + return $self->{'name'} || ''; } +sub full_name { + +=head2 full_name + +Read only method to return the fields name with its table name pre-pended. +e.g. "person.foo". + +=cut + + my $self = shift; + return $self->table.".".$self->name; +} + # ---------------------------------------------------------------------- -sub size { +sub order { =pod -=head2 size +=head2 order -Get or set the field's size. +Get or set the field's order. - my $size = $field->size('25'); + my $order = $field->order(3); =cut my ( $self, $arg ) = @_; - if ( $arg =~ m/^\d+(?:\.\d+)?$/ ) { - $self->{'size'} = $arg; + if ( defined $arg && $arg =~ /^\d+$/ ) { + $self->{'order'} = $arg; } - return $self->{'size'} || 0; + return $self->{'order'} || 0; } # ---------------------------------------------------------------------- -sub is_valid { +sub schema { + +=head2 schema + +Shortcut to get the fields schema ($field->table->schema) or undef if it +doesn't have one. + + my $schema = $field->schema; + +=cut + + my $self = shift; + if ( my $table = $self->table ) { return $table->schema || undef; } + return undef; +} + +# ---------------------------------------------------------------------- +sub size { =pod -=head2 is_valid +=head2 size -Determine whether the field is valid or not. +Get or set the field's size. Accepts a string, array or arrayref of +numbers and returns a string. - my $ok = $field->is_valid; + $field->size( 30 ); + $field->size( [ 255 ] ); + $size = $field->size( 10, 2 ); + print $size; # prints "10,2" + + $size = $field->size( '10, 2' ); + print $size; # prints "10,2" + +=cut + + my $self = shift; + my $numbers = parse_list_arg( @_ ); + + if ( @$numbers ) { + my @new; + for my $num ( @$numbers ) { + if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) { + push @new, $num; + } + } + $self->{'size'} = \@new if @new; # only set if all OK + } + + return wantarray + ? @{ $self->{'size'} || [0] } + : join( ',', @{ $self->{'size'} || [0] } ) + ; +} + +# ---------------------------------------------------------------------- +sub table { + +=pod + +=head2 table + +Get or set the field's table object. As the table object stringifies this can +also be used to get the table name. + + my $table = $field->table; + print "Table name: $table"; =cut my $self = shift; - return 1 if $self->name && $self->data_type; + if ( my $arg = shift ) { + return $self->error('Not a table object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); + $self->{'table'} = $arg; + } + + return $self->{'table'}; +} + +# ---------------------------------------------------------------------- +sub DESTROY { +# +# Destroy cyclical references. +# + my $self = shift; + undef $self->{'table'}; + undef $self->{'foreign_key_reference'}; } 1; @@ -173,6 +566,6 @@ Determine whether the field is valid or not. =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE +Ken Y. Clark Ekclark@cpan.orgE. =cut