lib/SQL/Translator/Schema/Field.pm

   1 package SQL::Translator::Schema::Field;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Field.pm,v 1.4 2003-05-09 17:08:14 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::Field - SQL::Translator field object
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator::Schema::Field;
  32   my $field = SQL::Translator::Schema::Field->new(
  33       name => 'foo',
  34       sql  => 'select * from foo',
  35   );
  36
  37 =head1 DESCRIPTION
  38
  39 C<SQL::Translator::Schema::Field> is the field object.
  40
  41 =head1 METHODS
  42
  43 =cut
  44
  45 use strict;
  46 use Class::Base;
  47 use SQL::Translator::Schema::Constants;
  48 use SQL::Translator::Utils 'parse_list_arg';
  49
  50 use base 'Class::Base';
  51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  52
  53 $VERSION = 1.00;
  54
  55 # ----------------------------------------------------------------------
  56 sub init {
  57
  58 =pod
  59
  60 =head2 new
  61
  62 Object constructor.
  63
  64   my $schema = SQL::Translator::Schema::Field->new;
  65
  66 =cut
  67
  68     my ( $self, $config ) = @_;
  69
  70     for my $arg (
  71         qw[
  72             table name data_type size is_primary_key is_nullable
  73             is_auto_increment
  74         ]
  75     ) {
  76         next unless defined $config->{ $arg };
  77         $self->$arg( $config->{ $arg } ) or return;
  78     }
  79     return $self;
  80 }
  81
  82 # ----------------------------------------------------------------------
  83 sub data_type {
  84
  85 =pod
  86
  87 =head2 data_type
  88
  89 Get or set the field's data type.
  90
  91   my $data_type = $field->data_type('integer');
  92
  93 =cut
  94
  95     my $self = shift;
  96     $self->{'data_type'} = shift if @_;
  97     return $self->{'data_type'} || '';
  98 }
  99
 100 # ----------------------------------------------------------------------
 101 sub default_value {
 102
 103 =pod
 104
 105 =head2 default_value
 106
 107 Get or set the field's default value.  Will return undef if not defined
 108 and could return the empty string (it's a valid default value), so don't
 109 assume an error like other methods.
 110
 111   my $default = $field->default_value('foo');
 112
 113 =cut
 114
 115     my ( $self, $arg ) = @_;
 116     $self->{'default_value'} = $arg if defined $arg;
 117     return $self->{'default_value'};
 118 }
 119
 120 # ----------------------------------------------------------------------
 121 sub is_auto_increment {
 122
 123 =pod
 124
 125 =head2 is_auto_increment
 126
 127 Get or set the field's C<is_auto_increment> attribute.
 128
 129   my $is_pk = $field->is_auto_increment(1);
 130
 131 =cut
 132
 133     my ( $self, $arg ) = @_;
 134
 135     if ( defined $arg ) {
 136         $self->{'is_auto_increment'} = $arg ? 1 : 0;
 137     }
 138
 139     unless ( defined $self->{'is_auto_increment'} ) {
 140         if ( my $table = $self->table ) {
 141             if ( my $schema = $table->schema ) {
 142                 if (
 143                     $schema->database eq 'PostgreSQL' &&
 144                     $self->data_type eq 'serial'
 145                 ) {
 146                     $self->{'is_auto_increment'} = 1;
 147                 }
 148             }
 149         }
 150     }
 151
 152     return $self->{'is_auto_increment'} || 0;
 153 }
 154
 155 # ----------------------------------------------------------------------
 156 sub is_nullable {
 157
 158 =pod
 159
 160 =head2 is_nullable
 161
 162 Get or set the whether the field can be null.  If not defined, then
 163 returns "1" (assumes the field can be null).  The argument is evaluated
 164 by Perl for True or False, so the following are eqivalent:
 165
 166   $is_nullable = $field->is_nullable(0);
 167   $is_nullable = $field->is_nullable('');
 168   $is_nullable = $field->is_nullable('0');
 169
 170 While this is technically a field constraint, it's probably easier to
 171 represent this as an attribute of the field.  In order keep things
 172 consistent, any other constraint on the field (unique, primary, and
 173 foreign keys; checks) are represented as table constraints.
 174
 175 =cut
 176
 177     my ( $self, $arg ) = @_;
 178
 179     if ( defined $arg ) {
 180         $self->{'is_nullable'} = $arg ? 1 : 0;
 181     }
 182
 183     return defined $self->{'is_nullable'} ? $self->{'is_nullable'} : 1;
 184 }
 185
 186 # ----------------------------------------------------------------------
 187 sub is_primary_key {
 188
 189 =pod
 190
 191 =head2 is_primary_key
 192
 193 Get or set the field's C<is_primary_key> attribute.  Does not create
 194 a table constraint (should it?).
 195
 196   my $is_pk = $field->is_primary_key(1);
 197
 198 =cut
 199
 200     my ( $self, $arg ) = @_;
 201
 202     if ( defined $arg ) {
 203         $self->{'is_primary_key'} = $arg ? 1 : 0;
 204     }
 205
 206     unless ( defined $self->{'is_primary_key'} ) {
 207         if ( my $table = $self->table ) {
 208             if ( my $pk = $table->primary_key ) {
 209                 my %fields = map { $_, 1 } $pk->fields;
 210                 $self->{'is_primary_key'} = $fields{ $self->name } || 0;
 211             }
 212             else {
 213                 $self->{'is_primary_key'} = 0;
 214             }
 215         }
 216     }
 217
 218     return $self->{'is_primary_key'} || 0;
 219 }
 220
 221 # ----------------------------------------------------------------------
 222 sub is_valid {
 223
 224 =pod
 225
 226 =head2 is_valid
 227
 228 Determine whether the field is valid or not.
 229
 230   my $ok = $field->is_valid;
 231
 232 =cut
 233
 234     my $self = shift;
 235     return $self->error('No name')         unless $self->name;
 236     return $self->error('No data type')    unless $self->data_type;
 237     return $self->error('No table object') unless $self->table;
 238     return 1;
 239 }
 240
 241 # ----------------------------------------------------------------------
 242 sub name {
 243
 244 =pod
 245
 246 =head2 name
 247
 248 Get or set the field's name.
 249
 250   my $name = $field->name('foo');
 251
 252 =cut
 253
 254     my $self = shift;
 255
 256     if ( my $arg = shift ) {
 257         if ( my $table = $self->table ) {
 258             return $self->error( qq[Can't use field name "$arg": table exists] )
 259                 if $table->get_field( $arg );
 260         }
 261
 262         $self->{'name'} = $arg;
 263     }
 264
 265     return $self->{'name'} || '';
 266 }
 267
 268 # ----------------------------------------------------------------------
 269 sub order {
 270
 271 =pod
 272
 273 =head2 order
 274
 275 Get or set the field's order.
 276
 277   my $order = $field->order(3);
 278
 279 =cut
 280
 281     my ( $self, $arg ) = @_;
 282
 283     if ( defined $arg && $arg =~ /^\d+$/ ) {
 284         $self->{'order'} = $arg;
 285     }
 286
 287     return $self->{'order'} || 0;
 288 }
 289
 290 # ----------------------------------------------------------------------
 291 sub size {
 292
 293 =pod
 294
 295 =head2 size
 296
 297 Get or set the field's size.  Accepts a string, array or arrayref of
 298 numbers and returns a string.
 299
 300   $field->size( 30 );
 301   $field->size( [ 255 ] );
 302   $size = $field->size( 10, 2 );
 303   print $size; # prints "10,2"
 304
 305   $size = $field->size( '10, 2' );
 306   print $size; # prints "10,2"
 307
 308 =cut
 309
 310     my $self    = shift;
 311     my $numbers = parse_list_arg( @_ );
 312
 313     if ( @$numbers ) {
 314         my @new;
 315         for my $num ( @$numbers ) {
 316             if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) {
 317                 push @new, $num;
 318             }
 319         }
 320         $self->{'size'} = \@new if @new; # only set if all OK
 321     }
 322
 323     return wantarray
 324         ? @{ $self->{'size'} }
 325         : join( ',', @{ $self->{'size'} || [0] } )
 326     ;
 327 }
 328
 329 # ----------------------------------------------------------------------
 330 sub table {
 331
 332 =pod
 333
 334 =head2 table
 335
 336 Get or set the field's table object.
 337
 338   my $table = $field->table;
 339
 340 =cut
 341
 342     my $self = shift;
 343     if ( my $arg = shift ) {
 344         return $self->error('Not a table object') unless
 345             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
 346         $self->{'table'} = $arg;
 347     }
 348
 349     return $self->{'table'};
 350 }
 351
 352 # ----------------------------------------------------------------------
 353 sub DESTROY {
 354     my $self = shift;
 355     undef $self->{'table'}; # destroy cyclical reference
 356 }
 357
 358 1;
 359
 360 # ----------------------------------------------------------------------
 361
 362 =pod
 363
 364 =head1 AUTHOR
 365
 366 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 367
 368 =cut