X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FField.pm;h=37bb5a623681759a1e65a0e3054448365a0ed980;hb=44659089c28216f1984873bc4aa8641e2e0e3410;hp=7e8fe3ed2da60ee7f928d3cb954dbe40f8ef8794;hpb=abf315bb9c2c78e40da9af6519e5daae76d60f08;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 7e8fe3e..37bb5a6 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/lib/SQL/Translator/Schema/Field.pm @@ -1,9 +1,7 @@ package SQL::Translator::Schema::Field; # ---------------------------------------------------------------------- -# $Id: Field.pm,v 1.23 2005-06-27 21:59:19 duality72 Exp $ -# ---------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors +# Copyright (C) 2002-2009 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 @@ -50,7 +48,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.59'; # 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 @@ -61,12 +59,44 @@ use overload fallback => 1, ; +use DBI qw(:sql_types); + +# Mapping from string to sql contstant +our %type_mapping = ( + integer => SQL_INTEGER, + int => SQL_INTEGER, + + smallint => SQL_SMALLINT, + bigint => 9999, # DBI doesn't export a constatn for this. Le suck + + double => SQL_DOUBLE, + + decimal => SQL_DECIMAL, + numeric => SQL_NUMERIC, + dec => SQL_DECIMAL, + + bit => SQL_BIT, + + date => SQL_DATE, + datetime => SQL_DATETIME, + timestamp => SQL_TIMESTAMP, + time => SQL_TIME, + + char => SQL_CHAR, + varchar => SQL_VARCHAR, + binary => SQL_BINARY, + varbinary => SQL_VARBINARY, + tinyblob => SQL_BLOB, + blob => SQL_BLOB, + text => SQL_LONGVARCHAR + +); # ---------------------------------------------------------------------- __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 + is_unique order sql_data_type /); =pod @@ -132,10 +162,28 @@ Get or set the field's data type. =cut my $self = shift; - $self->{'data_type'} = shift if @_; + if (@_) { + $self->{'data_type'} = $_[0]; + $self->{'sql_data_type'} = $type_mapping{lc $_[0]} || SQL_UNKNOWN_TYPE unless exists $self->{sql_data_type}; + } return $self->{'data_type'} || ''; } +sub sql_data_type { + +=head2 sql_data_type + +Constant from DBI package representing this data type. See L +for more details. + +=cut + + my $self = shift; + $self->{sql_data_type} = shift if @_; + return $self->{sql_data_type} || 0; + +} + # ---------------------------------------------------------------------- sub default_value { @@ -151,8 +199,8 @@ assume an error like other methods. =cut - my ( $self, $arg ) = @_; - $self->{'default_value'} = $arg if defined $arg; + my $self = shift; + $self->{'default_value'} = shift if @_; return $self->{'default_value'}; } @@ -548,6 +596,24 @@ also be used to get the table name. return $self->{'table'}; } +sub parsed_field { + +=head2 + +Returns the field exactly as the parser found it + +=cut + + my $self = shift; + + if (@_) { + my $value = shift; + $self->{parsed_field} = $value; + return $value || $self; + } + return $self->{parsed_field} || $self; +} + # ---------------------------------------------------------------------- sub equals { @@ -567,18 +633,41 @@ Determines if this field is the same as another return 0 unless $self->SUPER::equals($other); return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; - return 0 unless $self->is_valid eq $other->is_valid; - return 0 unless $self->data_type eq $other->data_type; + + # Comparing types: use sql_data_type if both are not 0. Else use string data_type + if ($self->sql_data_type && $other->sql_data_type) { + return 0 unless $self->sql_data_type == $other->sql_data_type + } else { + return 0 unless lc($self->data_type) eq lc($other->data_type) + } + return 0 unless $self->size eq $other->size; - return 0 unless defined $self->default_value eq defined $other->default_value; - return 0 if defined $self->default_value && $self->default_value ne $other->default_value; + + { + my $lhs = $self->default_value; + $lhs = \'NULL' unless defined $lhs; + my $lhs_is_ref = ! ! ref $lhs; + + my $rhs = $other->default_value; + $rhs = \'NULL' unless defined $rhs; + my $rhs_is_ref = ! ! ref $rhs; + + # If only one is a ref, fail. -- rjbs, 2008-12-02 + return 0 if $lhs_is_ref xor $rhs_is_ref; + + my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs; + my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs; + + return 0 if $effective_lhs ne $effective_rhs; + } + return 0 unless $self->is_nullable eq $other->is_nullable; - return 0 unless $self->is_unique eq $other->is_unique; +# return 0 unless $self->is_unique eq $other->is_unique; return 0 unless $self->is_primary_key eq $other->is_primary_key; - return 0 unless $self->is_foreign_key eq $other->is_foreign_key; +# return 0 unless $self->is_foreign_key eq $other->is_foreign_key; return 0 unless $self->is_auto_increment eq $other->is_auto_increment; # return 0 unless $self->comments eq $other->comments; - return 0 unless $self->_compare_objects($self->extra, $other->extra); + return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); return 1; } @@ -600,6 +689,6 @@ sub DESTROY { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut