lib/SQL/Translator/Schema/Field.pm

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