package SQL::Translator::Schema::Field;
# ----------------------------------------------------------------------
-# $Id: Field.pm,v 1.4 2003-05-09 17:08:14 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 'Class::Base';
+use base 'SQL::Translator::Schema::Object';
+
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 ) = @_;
+# ----------------------------------------------------------------------
+sub comments {
- for my $arg (
- qw[
- table name data_type size is_primary_key is_nullable
- is_auto_increment
- ]
- ) {
- next unless defined $config->{ $arg };
- $self->$arg( $config->{ $arg } ) or return;
+=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 ? () : '';
}
- return $self;
}
+
# ----------------------------------------------------------------------
sub data_type {
}
# ----------------------------------------------------------------------
+=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
Get or set the field's C<is_auto_increment> attribute.
- my $is_pk = $field->is_auto_increment(1);
+ my $is_auto = $field->is_auto_increment(1);
=cut
}
# ----------------------------------------------------------------------
+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
+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:
$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_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
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;
- if ( my $arg = shift ) {
+ 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": table exists] )
+ return $self->error( qq[Can't use field name "$arg": field exists] )
if $table->get_field( $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 order {
}
# ----------------------------------------------------------------------
+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
}
return wantarray
- ? @{ $self->{'size'} }
+ ? @{ $self->{'size'} || [0] }
: join( ',', @{ $self->{'size'} || [0] } )
;
}
=head2 table
-Get or set the field's table object.
+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
# ----------------------------------------------------------------------
sub DESTROY {
+#
+# Destroy cyclical references.
+#
my $self = shift;
- undef $self->{'table'}; # destroy cyclical reference
+ 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