lib/SQL/Translator/Schema/Constraint.pm

   1 package SQL::Translator::Schema::Constraint;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Constraint.pm,v 1.1 2003-05-01 04:24:59 kycl4rk Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
   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::Constraint - SQL::Translator constraint object
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator::Schema::Constraint;
  32   my $constraint = SQL::Translator::Schema::Constraint->new(
  33       name   => 'foo',
  34       fields => [ id ],
  35       type   => 'primary_key',
  36   );
  37
  38 =head1 DESCRIPTION
  39
  40 C<SQL::Translator::Schema::Constraint> is the constraint object.
  41
  42 =head1 METHODS
  43
  44 =cut
  45
  46 use strict;
  47 use Class::Base;
  48
  49 use base 'Class::Base';
  50 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  51
  52 $VERSION = 1.00;
  53
  54 use constant VALID_TYPE => {
  55     primary_key => 1,
  56     unique      => 1,
  57     check       => 1,
  58     foreign_key => 1,
  59 };
  60
  61 # ----------------------------------------------------------------------
  62 sub init {
  63
  64 =pod
  65
  66 =head2 new
  67
  68 Object constructor.
  69
  70   my $schema           =  SQL::Translator::Schema::Constraint->new(
  71       type             => 'foreign_key', # type of table constraint
  72       name             => 'fk_phone_id', # the name of the constraint
  73       fields           => 'phone_id',    # the field in the referring table
  74       reference_fields => 'phone_id',    # the referenced table
  75       reference_table  => 'phone',       # the referenced fields
  76       match_type       => 'full',        # how to match
  77       on_delete_do     => 'cascade',     # what to do on deletes
  78       on_update_do     => '',            # what to do on updates
  79   );
  80
  81 =cut
  82
  83     my ( $self, $config ) = @_;
  84 #        reference_fields reference_table
  85 #        match_type on_delete_do on_update_do
  86     my @fields = qw[ name type fields ];
  87
  88     for my $arg ( @fields ) {
  89         next unless $config->{ $arg };
  90         $self->$arg( $config->{ $arg } ) or return;
  91     }
  92
  93     return $self;
  94 }
  95
  96 # ----------------------------------------------------------------------
  97 sub fields {
  98
  99 =pod
 100
 101 =head2 fields
 102
 103 Gets and set the fields the constraint is on.  Accepts a list or arrayref,
 104 return both, too.
 105
 106   my @fields = $constraint->fields( 'id' );
 107
 108 =cut
 109
 110     my $self   = shift;
 111     my $fields = ref $_[0] eq 'ARRAY' ? shift : [ @_ ];
 112
 113     if ( @$fields ) {
 114         $self->{'fields'} = $fields;
 115     }
 116
 117     return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
 118 }
 119
 120 # ----------------------------------------------------------------------
 121 sub name {
 122
 123 =pod
 124
 125 =head2 name
 126
 127 Get or set the constraint's name.
 128
 129   my $name = $constraint->name('foo');
 130
 131 =cut
 132
 133     my $self = shift;
 134     $self->{'name'} = shift if @_;
 135     return $self->{'name'} || '';
 136 }
 137
 138 # ----------------------------------------------------------------------
 139 sub type {
 140
 141 =pod
 142
 143 =head2 type
 144
 145 Get or set the constraint's type.
 146
 147   my $type = $constraint->type('primary_key');
 148
 149 =cut
 150
 151     my $self = shift;
 152
 153     if ( my $type = shift ) {
 154         return $self->error("Invalid constraint type: $type")
 155             unless VALID_TYPE->{ $type };
 156         $self->{'type'} = $type;
 157     }
 158
 159     return $self->{'type'} || '';
 160 }
 161
 162
 163 # ----------------------------------------------------------------------
 164 sub is_valid {
 165
 166 =pod
 167
 168 =head2 is_valid
 169
 170 Determine whether the constraint is valid or not.
 171
 172   my $ok = $constraint->is_valid;
 173
 174 =cut
 175
 176     my $self = shift;
 177     return ( $self->name && $self->{'type'} && @{ $self->fields } ) ? 1 : 0;
 178 }
 179
 180 1;
 181
 182 # ----------------------------------------------------------------------
 183
 184 =pod
 185
 186 =head1 AUTHOR
 187
 188 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 189
 190 =cut