1 package SQL::Translator::Schema::Object;
3 # ----------------------------------------------------------------------
4 # $Id: Object.pm,v 1.3 2004-11-05 15:03:10 grommit Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
27 SQL::Translator::Schema::Object - Base class SQL::Translator Schema objects.
33 Base class for Schema objects. Sub classes L<Class::Base> and adds the following
40 use base 'Class::Data::Inheritable';
41 use base 'Class::Base';
43 use vars qw[ $VERSION ];
45 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
50 Derived classes should decalare their attributes using the C<_attributes>
51 method. They can then inherit the C<init> method from here which will call
52 accessors of the same name for any values given in the hash passed to C<new>.
53 Note that you will have to impliment the accessors your self and we expect perl
54 style methods; call with no args to get and with arg to set.
56 e.g. If we setup our class as follows;
58 package SQL::Translator::Schema::Table;
59 use base qw/SQL::Translator::Schema::Object/;
61 __PACKAGE__->_attributes( qw/schema name/ );
66 Then we can construct it with
68 my $table = SQL::Translator::Schema::Table->new(
73 and init will call C<< $table->name("foo") >> and C<< $table->schema($schema) >>
74 to set it up. Any undefined args will be ignored.
76 Multiple calls to C<_attributes> are cumulative and sub classes will inherit
77 their parents attribute names.
79 This is currently experimental, but will hopefull go on to form an introspection
80 API for the Schema objects.
85 __PACKAGE__->mk_classdata("__attributes");
87 # Define any global attributes here
88 __PACKAGE__->__attributes([qw/extra/]);
90 # Set the classes attribute names. Multiple calls are cumulative.
91 # We need to be careful to create a new ref so that all classes don't end up
92 # with the same ref and hence the same attributes!
95 if (@_) { $class->__attributes( [ @{$class->__attributes}, @_ ] ); }
96 return @{$class->__attributes};
99 # Call accessors for any args in hashref passed
101 my ( $self, $config ) = @_;
103 for my $arg ( $self->_attributes ) {
104 next unless defined $config->{$arg};
105 defined $self->$arg( $config->{$arg} ) or return;
111 # ----------------------------------------------------------------------
116 =head1 Global Attributes
118 The following attributes are defined here, therefore all schema objects will
123 Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields).
124 Accepts a hash(ref) of name/value pairs to store; returns a hash.
126 $field->extra( qualifier => 'ZEROFILL' );
127 my %extra = $field->extra;
132 my $args = ref $_[0] eq 'HASH' ? shift : { @_ };
134 while ( my ( $key, $value ) = each %$args ) {
135 $self->{'extra'}{ $key } = $value;
138 return %{ $self->{'extra'} || {} };
141 #=============================================================================
155 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, Mark Addison E<lt>mark.addison@itn.co.ukE<gt>