1 package SQL::Translator::Schema::Object;
7 SQL::Translator::Schema::Object - Base class SQL::Translator Schema objects.
13 Base class for Schema objects. Sub classes L<Class::Base> and adds the following
20 use base 'Class::Data::Inheritable';
21 use base 'Class::Base';
24 our $VERSION = '1.59';
28 Derived classes should declare their attributes using the C<_attributes>
29 method. They can then inherit the C<init> method from here which will call
30 accessors of the same name for any values given in the hash passed to C<new>.
31 Note that you will have to impliment the accessors your self and we expect perl
32 style methods; call with no args to get and with arg to set.
34 e.g. If we setup our class as follows;
36 package SQL::Translator::Schema::Table;
37 use base qw/SQL::Translator::Schema::Object/;
39 __PACKAGE__->_attributes( qw/schema name/ );
44 Then we can construct it with
46 my $table = SQL::Translator::Schema::Table->new(
51 and init will call C<< $table->name("foo") >> and C<< $table->schema($schema) >>
52 to set it up. Any undefined args will be ignored.
54 Multiple calls to C<_attributes> are cumulative and sub classes will inherit
55 their parents attribute names.
57 This is currently experimental, but will hopefull go on to form an introspection
58 API for the Schema objects.
63 __PACKAGE__->mk_classdata("__attributes");
65 # Define any global attributes here
66 __PACKAGE__->__attributes([qw/extra/]);
68 # Set the classes attribute names. Multiple calls are cumulative.
69 # We need to be careful to create a new ref so that all classes don't end up
70 # with the same ref and hence the same attributes!
73 if (@_) { $class->__attributes( [ @{$class->__attributes}, @_ ] ); }
74 return @{$class->__attributes};
77 # Call accessors for any args in hashref passed
79 my ( $self, $config ) = @_;
81 for my $arg ( $self->_attributes ) {
82 next unless defined $config->{$arg};
83 defined $self->$arg( $config->{$arg} ) or return;
93 =head1 Global Attributes
95 The following attributes are defined here, therefore all schema objects will
100 Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields).
101 Call with no args to get all the extra data.
102 Call with a single name arg to get the value of the named extra attribute,
103 returned as a scalar. Call with a hash or hashref to set extra attributes.
104 Returns a hash or a hashref.
106 $field->extra( qualifier => 'ZEROFILL' );
108 $qualifier = $field->extra('qualifier');
110 %extra = $field->extra;
111 $extra = $field->extra;
116 @_ = %{$_[0]} if ref $_[0] eq "HASH";
117 my $extra = $self->{'extra'} ||= {};
120 return exists($extra->{$_[0]}) ? $extra->{$_[0]} : undef ;
124 while ( my ( $key, $value ) = each %args ) {
125 $extra->{$key} = $value;
129 return wantarray ? %$extra : $extra;
136 L</extra> can only be used to get or set "extra" attributes but not to
137 remove some. Call with no args to remove all extra attributes that
138 have been set before. Call with a list of key names to remove
139 certain extra attributes only.
141 # remove all extra attributes
142 $field->remove_extra();
144 # remove timezone and locale attributes only
145 $field->remove_extra(qw/timezone locale/);
149 my ( $self, @keys ) = @_;
151 $self->{'extra'} = {};
154 delete $self->{'extra'}{$_} for @keys;
164 Determines if this object is the same as another.
166 my $isIdentical = $object1->equals( $object2 );
173 return 0 unless $other;
174 return 1 if overload::StrVal($self) eq overload::StrVal($other);
175 return 0 unless $other->isa( __PACKAGE__ );
179 sub _compare_objects {
180 # my ($self, $obj1, $obj2) = @_;
183 Data::Dumper->new([$_[1]])->Terse(1)->Indent(0)->Deparse(1)->Sortkeys(1)->Maxdepth(0)->Dump
185 Data::Dumper->new([$_[2]])->Terse(1)->Indent(0)->Deparse(1)->Sortkeys(1)->Maxdepth(0)->Dump
188 # use Carp qw(cluck);
189 # cluck("How did I get here?");
191 # $Data::Dumper::Maxdepth = 1;
192 # print "obj1: ", Dumper($obj1), "\n";
193 # print "obj2: ", Dumper($obj2), "\n";
210 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
211 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.