lib/SQL/Translator/Schema/Object.pm

   1 package SQL::Translator::Schema::Object;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Object.pm,v 1.2 2004-11-05 13:19:31 grommit Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   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.
  11 #
  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.
  16 #
  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
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =pod
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Schema::Object - Base class SQL::Translator Schema objects.
  28
  29 =head1 SYNOPSIS
  30
  31 =head1 DESCSIPTION
  32
  33 Base class for Schema objects. Sub classes L<Class::Base> and adds the following
  34 extra functionality.
  35
  36 =cut
  37
  38 use strict;
  39 use Class::Base;
  40 use base 'Class::Data::Inheritable';
  41 use base 'Class::Base';
  42
  43 use vars qw[ $VERSION ];
  44
  45 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  46
  47
  48 =head1 Construction
  49
  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.
  55
  56 e.g. If we setup our class as follows;
  57
  58  package SQL::Translator::Schema::Table;
  59  use base qw/SQL::Translator::Schema::Object/;
  60
  61  __PACKAGE__->_attributes( qw/schema name/ );
  62
  63  sub name   { ... }
  64  sub schema { ... }
  65
  66 Then we can construct it with
  67
  68  my $table  =  SQL::Translator::Schema::Table->new(
  69      schema => $schema,
  70      name   => 'foo',
  71  );
  72
  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.
  75
  76 Multiple calls to C<_attributes> are cumulative and sub classes will inherit
  77 their parents attribute names.
  78
  79 This is currently experimental, but will hopefull go on to form an introspection
  80 API for the Schema objects.
  81
  82 =cut
  83
  84
  85 __PACKAGE__->mk_classdata("__attributes");
  86 __PACKAGE__->__attributes([]);
  87
  88 # Set the classes attribute names. Multiple calls are cumulative.
  89 # We need to be careful to create a new ref so that all classes don't end up
  90 # with the same ref and hence the same attributes!
  91 sub _attributes {
  92     my $class = shift;
  93     if (@_) { $class->__attributes( [ @{$class->__attributes}, @_ ] ); }
  94     return @{$class->__attributes};
  95 }
  96
  97 # Call accessors for any args in hashref passed
  98 sub init {
  99     my ( $self, $config ) = @_;
 100
 101     for my $arg ( $self->_attributes ) {
 102         next unless defined $config->{$arg};
 103         defined $self->$arg( $config->{$arg} ) or return;
 104     }
 105
 106     return $self;
 107 }
 108
 109
 110 #=============================================================================
 111
 112 1;
 113
 114 =pod
 115
 116 =head1 SEE ALSO
 117
 118 =head1 TODO
 119
 120 =head1 BUGS
 121
 122 =head1 AUTHOR
 123
 124 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>, Mark Addison E<lt>mark.addison@itn.co.ukE<gt>
 125
 126 =cut