Upped version numbers, cleaned up code, fixed my name.

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Object.pm

diff --git a/lib/SQL/Translator/Schema/Object.pm b/lib/SQL/Translator/Schema/Object.pm
index bff5fb3..41ce4a7 100644 (file)
--- a/lib/SQL/Translator/Schema/Object.pm
+++ b/lib/SQL/Translator/Schema/Object.pm
@@ -1,9 +1,7 @@
 package SQL::Translator::Schema::Object;
 
 # ----------------------------------------------------------------------
-# $Id: Object.pm,v 1.2 2004-11-05 13:19:31 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
@@ -39,15 +37,15 @@ use strict;
 use Class::Base;
 use base 'Class::Data::Inheritable';
 use base 'Class::Base';
+use Class::MakeMethods::Utility::Ref qw( ref_compare );
 
 use vars qw[ $VERSION ];
 
-$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
-
+$VERSION = '1.60';
 
 =head1 Construction
 
-Derived classes should decalare their attributes using the C<_attributes>
+Derived classes should declare their attributes using the C<_attributes>
 method. They can then inherit the C<init> method from here which will call
 accessors of the same name for any values given in the hash passed to C<new>.
 Note that you will have to impliment the accessors your self and we expect perl
@@ -83,7 +81,9 @@ API for the Schema objects.
 
 
 __PACKAGE__->mk_classdata("__attributes");
-__PACKAGE__->__attributes([]); 
+
+# Define any global attributes here
+__PACKAGE__->__attributes([qw/extra/]); 
 
 # Set the classes attribute names. Multiple calls are cumulative.
 # We need to be careful to create a new ref so that all classes don't end up
@@ -106,21 +106,118 @@ sub init {
     return $self;
 }
 
+# ----------------------------------------------------------------------
+sub extra {
 
-#=============================================================================
+=pod
 
-1;
+=head1 Global Attributes
+
+The following attributes are defined here, therefore all schema objects will
+have them.
+
+=head2 extra
+
+Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields).
+Call with no args to get all the extra data.
+Call with a single name arg to get the value of the named extra attribute,
+returned as a scalar. Call with a hash or hashref to set extra attributes.
+Returns a hash or a hashref.
+
+  $field->extra( qualifier => 'ZEROFILL' );
+  
+  $qualifier = $field->extra('qualifier');
+  
+  %extra = $field->extra;
+  $extra = $field->extra;
+  
+=cut
+
+    my $self = shift;
+    @_ = %{$_[0]} if ref $_[0] eq "HASH";
+    my $extra = $self->{'extra'} ||= {};
+
+    if (@_==1) { 
+        return exists($extra->{$_[0]}) ? $extra->{$_[0]} : undef ;
+    }
+    elsif (@_) {
+        my %args = @_;
+        while ( my ( $key, $value ) = each %args ) {
+            $extra->{$key} = $value;
+        }
+    }
+    
+    return wantarray ? %$extra : $extra;
+}
+
+# ----------------------------------------------------------------------
+sub remove_extra {
+
+=head2 remove_extra
+
+L</extra> can only be used to get or set "extra" attributes but not to
+remove some. Call with no args to remove all extra attributes that
+have been set before. Call with a list of key names to remove
+certain extra attributes only.
+
+  # remove all extra attributes
+  $field->remove_extra(); 
+  
+  # remove timezone and locale attributes only
+  $field->remove_extra(qw/timezone locale/);
+
+=cut
+
+    my ( $self, @keys ) = @_;
+    unless (@keys) {
+        $self->{'extra'} = {};
+    }
+    else {
+        delete $self->{'extra'}{$_} for @keys;
+    }
+}
+
+# ----------------------------------------------------------------------
+sub equals {
 
 =pod
 
-=head1 SEE ALSO
+=head2 equals
+
+Determines if this object is the same as another.
 
-=head1 TODO
+  my $isIdentical = $object1->equals( $object2 );
 
-=head1 BUGS
+=cut
+
+    my $self = shift;
+    my $other = shift;
+    
+    return 0 unless $other;
+    return 1 if overload::StrVal($self) eq overload::StrVal($other);
+    return 0 unless $other->isa( __PACKAGE__ );
+    return 1;
+}
+
+# ----------------------------------------------------------------------
+sub _compare_objects {
+       my $self   = shift;
+       my $obj1   = shift;
+       my $obj2   = shift;
+       my $result = (ref_compare($obj1, $obj2) == 0);
+
+       return $result;
+}
+
+#=============================================================================
+
+1;
+
+=pod
 
 =head1 AUTHOR
 
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, Mark Addison E<lt>mark.addison@itn.co.ukE<gt> 
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>, 
+Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
 
 =cut