lib/SQL/Translator/Schema/Field.pm

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