use Moo;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Types qw(schema_obj);
-use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
+use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
+use Sub::Quote qw(quote_sub);
+use Scalar::Util ();
-with qw(
- SQL::Translator::Schema::Role::Extra
- SQL::Translator::Schema::Role::Error
- SQL::Translator::Schema::Role::Compare
-);
-
-our ( $TABLE_COUNT, $VIEW_COUNT );
+extends 'SQL::Translator::Schema::Object';
our $VERSION = '1.59';
use DBI qw(:sql_types);
-# Mapping from string to sql contstant
+# Mapping from string to sql constant
our %type_mapping = (
integer => SQL_INTEGER,
int => SQL_INTEGER,
+ tinyint => SQL_TINYINT,
smallint => SQL_SMALLINT,
- bigint => 9999, # DBI doesn't export a constatn for this. Le suck
+ bigint => SQL_BIGINT,
double => SQL_DOUBLE,
);
+has _numeric_sql_data_types => ( is => 'lazy' );
+
+sub _build__numeric_sql_data_types {
+ return {
+ map { $_ => 1 }
+ (SQL_INTEGER, SQL_TINYINT, SQL_SMALLINT, SQL_BIGINT, SQL_DOUBLE,
+ SQL_NUMERIC, SQL_DECIMAL, SQL_FLOAT, SQL_REAL)
+ };
+}
+
=head2 new
Object constructor.
table => $table,
);
-=cut
-
-around BUILDARGS => sub {
- my $orig = shift;
- my $self = shift;
- my $args = $self->$orig(@_);
-
- foreach my $arg (keys %{$args}) {
- delete $args->{$arg} unless defined($args->{$arg});
- }
- return $args;
-};
-
=head2 comments
Get or set the comments on a field. May be called several times to
has comments => (
is => 'rw',
- coerce => sub { ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] },
- default => sub { [] },
+ coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
+ default => quote_sub(q{ [] }),
);
around comments => sub {
=cut
-has data_type => ( is => 'rw', default => sub { '' } );
+has data_type => ( is => 'rw', default => quote_sub(q{ '' }) );
=head2 sql_data_type
has default_value => ( is => 'rw' );
-=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
-
=head2 foreign_key_reference
Get or set the field's foreign key reference;
is => 'rw',
predicate => '_has_foreign_key_reference',
isa => schema_obj('Constraint'),
+ weak_ref => 1,
);
around foreign_key_reference => sub {
has is_auto_increment => (
is => 'rw',
- coerce => sub { $_[0] ? 1 : 0 },
+ coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
builder => 1,
lazy => 1,
);
has is_foreign_key => (
is => 'rw',
- coerce => sub { $_[0] ? 1 : 0 },
+ coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
builder => 1,
lazy => 1,
);
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:
+by Perl for True or False, so the following are equivalent:
$is_nullable = $field->is_nullable(0);
$is_nullable = $field->is_nullable('');
has is_nullable => (
is => 'rw',
- coerce => sub { $_[0] ? 1 : 0 },
- default => sub { 1 },
+ coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
+ default => quote_sub(q{ 1 }),
);
around is_nullable => sub {
has is_primary_key => (
is => 'rw',
- coerce => sub { $_[0] ? 1 : 0 },
+ coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
lazy => 1,
builder => 1,
);
has is_unique => ( is => 'lazy', init_arg => undef );
+around is_unique => carp_ro('is_unique');
+
sub _build_is_unique {
my ( $self ) = @_;
=cut
-has order => ( is => 'rw', default => sub { 0 } );
+has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
around order => sub {
my ( $orig, $self, $arg ) = @_;
has size => (
is => 'rw',
- default => sub { [0] },
+ default => quote_sub(q{ [0] }),
coerce => sub {
my @sizes = grep { defined && m/^\d+(?:\.\d+)?$/ } @{parse_list_arg($_[0])};
@sizes ? \@sizes : [0];
=cut
-has table => ( is => 'rw', isa => schema_obj('Table') );
+has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
around table => \&ex2err;
-=head2
+=head2 parsed_field
Returns the field exactly as the parser found it
my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
- return 0 if $effective_lhs ne $effective_rhs;
+ if ( $self->_is_numeric_data_type
+ && Scalar::Util::looks_like_number($effective_lhs)
+ && Scalar::Util::looks_like_number($effective_rhs) ) {
+ return 0 if ($effective_lhs + 0) != ($effective_rhs + 0);
+ }
+ else {
+ return 0 if $effective_lhs ne $effective_rhs;
+ }
}
return 0 unless $self->is_nullable eq $other->is_nullable;
return 1;
};
-sub DESTROY {
-#
-# Destroy cyclical references.
-#
- my $self = shift;
- undef $self->{'table'};
- undef $self->{'foreign_key_reference'};
-}
-
# Must come after all 'has' declarations
around new => \&ex2err;
+sub _is_numeric_data_type {
+ my $self = shift;
+ return $self->_numeric_sql_data_types->{ $self->sql_data_type };
+}
+
1;
=pod