X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FField.pm;h=1173a88d6a106a6e143f0688b6e0bacc73271fc9;hb=4ab3763d2ad756c236b757306989cafa08e7f35e;hp=483becc99b1f7e82c80342b4c4dc09eea38ad484;hpb=0bf88ce5eaf4272108cfacc5080415cfb7f35164;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 483becc..1173a88 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.17 2004-03-23 21:45:19 grommit 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 @@ -43,14 +41,14 @@ 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 'Class::Base'; +use base 'SQL::Translator::Schema::Object'; + use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\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,8 +59,45 @@ 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 + +); # ---------------------------------------------------------------------- -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 sql_data_type +/); =pod @@ -77,21 +112,6 @@ Object constructor. =cut - my ( $self, $config ) = @_; - - for my $arg ( - qw[ - table name data_type size is_primary_key is_nullable - is_auto_increment default_value comments - ] - ) { - next unless defined $config->{ $arg }; - defined $self->$arg( $config->{ $arg } ) or return; - } - - return $self; -} - # ---------------------------------------------------------------------- sub comments { @@ -142,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 { @@ -167,8 +205,6 @@ assume an error like other methods. } # ---------------------------------------------------------------------- -sub extra { - =pod =head2 extra @@ -181,15 +217,6 @@ Accepts a hash(ref) of name/value pairs to store; returns a hash. =cut - my $self = shift; - my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; - - while ( my ( $key, $value ) = each %$args ) { - $self->{'extra'}{ $key } = $value; - } - - return %{ $self->{'extra'} || {} }; -} # ---------------------------------------------------------------------- sub foreign_key_reference { @@ -489,6 +516,23 @@ Get or set the field's 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 @@ -552,6 +596,81 @@ 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 { + +=pod + +=head2 equals + +Determines if this field is the same as another + + my $isIdentical = $field1->equals( $field2 ); + +=cut + + my $self = shift; + my $other = shift; + my $case_insensitive = shift; + + return 0 unless $self->SUPER::equals($other); + return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; + + # 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; + + { + 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_primary_key eq $other->is_primary_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(scalar $self->extra, scalar $other->extra); + return 1; +} + # ---------------------------------------------------------------------- sub DESTROY { #