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 <kclark@cpan.org>
+# 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
use SQL::Translator::Schema::Field;
my $field = SQL::Translator::Schema::Field->new(
- name => 'foo',
- sql => 'select * from foo',
+ name => 'foo',
+ table => $table,
);
=head1 DESCRIPTION
=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
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 {
=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');
}
# ----------------------------------------------------------------------
+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<is_auto_increment> 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<is_primary_key> attribute. Does not create
+a table constraint (should it?).
my $is_pk = $field->is_primary_key(1);
$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
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;
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=cut
projects / dbsrgits/SQL-Translator.git / blobdiff