Added equals function for equality testing
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Field.pm
index c2b4fa6..7e8fe3e 100644 (file)
@@ -1,9 +1,9 @@
 package SQL::Translator::Schema::Field;
 
 # ----------------------------------------------------------------------
-# $Id: Field.pm,v 1.12 2003-08-12 22:03:59 kycl4rk Exp $
+# $Id: Field.pm,v 1.23 2005-06-27 21:59:19 duality72 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
@@ -30,8 +30,8 @@ SQL::Translator::Schema::Field - SQL::Translator field object
 
   use SQL::Translator::Schema::Field;
   my $field = SQL::Translator::Schema::Field->new(
-      name => 'foo',
-      sql  => 'select * from foo',
+      name  => 'foo',
+      table => $table,
   );
 
 =head1 DESCRIPTION
@@ -43,17 +43,31 @@ C<SQL::Translator::Schema::Field> 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.12 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.23 $ =~ /(\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
 
@@ -61,25 +75,13 @@ sub init {
 
 Object constructor.
 
-  my $schema = SQL::Translator::Schema::Field->new;
+  my $field = SQL::Translator::Schema::Field->new(
+      name  => 'foo',
+      table => $table,
+  );
 
 =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 {
 
@@ -155,8 +157,6 @@ assume an error like other methods.
 }
 
 # ----------------------------------------------------------------------
-sub extra {
-
 =pod
 
 =head2 extra
@@ -169,15 +169,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 {
@@ -222,7 +213,7 @@ sub is_auto_increment {
 
 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
 
@@ -288,7 +279,7 @@ sub is_nullable {
 
 =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:
 
@@ -416,15 +407,22 @@ sub name {
 
 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 );
         }
 
@@ -434,6 +432,19 @@ Get or set the field's name.
     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 {
 
@@ -457,6 +468,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
@@ -502,9 +530,11 @@ sub table {
 
 =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
 
@@ -519,6 +549,40 @@ Get or set the field's table object.
 }
 
 # ----------------------------------------------------------------------
+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;
+    return 0 unless $self->is_valid eq $other->is_valid;
+    return 0 unless $self->data_type eq $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;
+    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($self->extra, $other->extra);
+    return 1;
+}
+
+# ----------------------------------------------------------------------
 sub DESTROY {
 #
 # Destroy cyclical references.
@@ -536,6 +600,6 @@ sub DESTROY {
 
 =head1 AUTHOR
 
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 
 =cut