lib/SQL/Translator/Schema/Table.pm

   1 package SQL::Translator::Schema::Table;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Table.pm,v 1.4 2003-05-07 20:42:34 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::Table - SQL::Translator table object
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator::Schema::Table;
  32   my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
  33
  34 =head1 DESCSIPTION
  35
  36 C<SQL::Translator::Schema::Table> is the table object.
  37
  38 =head1 METHODS
  39
  40 =cut
  41
  42 use strict;
  43 use Class::Base;
  44 use SQL::Translator::Schema::Constants;
  45 use SQL::Translator::Schema::Constraint;
  46 use SQL::Translator::Schema::Field;
  47 use SQL::Translator::Schema::Index;
  48
  49 use base 'Class::Base';
  50 use vars qw( $VERSION $FIELD_ORDER );
  51
  52 $VERSION = 1.00;
  53
  54 # ----------------------------------------------------------------------
  55 sub init {
  56
  57 =pod
  58
  59 =head2 new
  60
  61 Object constructor.
  62
  63   my $table  =  SQL::Translator::Schema::Table->new(
  64       schema => $schema,
  65       name   => 'foo',
  66   );
  67
  68 =cut
  69
  70     my ( $self, $config ) = @_;
  71
  72     for my $arg ( qw[ schema name ] ) {
  73         next unless defined $config->{ $arg };
  74         $self->$arg( $config->{ $arg } ) or return;
  75     }
  76
  77     return $self;
  78 }
  79
  80 # ----------------------------------------------------------------------
  81 sub name {
  82
  83 =pod
  84
  85 =head2 name
  86
  87 Get or set the table's name.
  88
  89 If provided an argument, checks the schema object for a table of
  90 that name and disallows the change if one exists.
  91
  92   my $table_name = $table->name('foo');
  93
  94 =cut
  95
  96     my $self = shift;
  97
  98     if ( my $arg = shift ) {
  99         if ( my $schema = $self->schema ) {
 100             return $self->error( qq[Can't use table name "$arg": table exists] )
 101                 if $schema->get_table( $arg );
 102         }
 103         $self->{'name'} = $arg;
 104     }
 105
 106     return $self->{'name'} || '';
 107 }
 108
 109 # ----------------------------------------------------------------------
 110 sub add_constraint {
 111
 112 =pod
 113
 114 =head2 add_constraint
 115
 116 Add a constraint to the table.  Returns the newly created
 117 C<SQL::Translator::Schema::Constraint> object.
 118
 119   my $constraint1 = $table->add_constraint(
 120       name        => 'pk',
 121       type        => PRIMARY_KEY,
 122       fields      => [ 'foo_id' ],
 123   );
 124
 125   my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
 126   $constraint2    = $table->add_constraint( $constraint );
 127
 128 =cut
 129
 130     my $self             = shift;
 131     my $constraint_class = 'SQL::Translator::Schema::Constraint';
 132     my $constraint;
 133
 134     if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
 135         $constraint = shift;
 136         $constraint->table( $self );
 137     }
 138     else {
 139         my %args = @_;
 140         $args{'table'} = $self;
 141         $constraint = $constraint_class->new( \%args ) or
 142             return $self->error( $constraint_class->error );
 143     }
 144
 145     push @{ $self->{'constraints'} }, $constraint;
 146     return $constraint;
 147 }
 148
 149 # ----------------------------------------------------------------------
 150 sub add_index {
 151
 152 =pod
 153
 154 =head2 add_index
 155
 156 Add an index to the table.  Returns the newly created
 157 C<SQL::Translator::Schema::Index> object.
 158
 159   my $index1 = $table->add_index(
 160       name   => 'name',
 161       fields => [ 'name' ],
 162       type   => 'normal',
 163   );
 164
 165   my $index2 = SQL::Translator::Schema::Index->new( name => 'id' );
 166   $index2    = $table->add_index( $index );
 167
 168 =cut
 169
 170     my $self        = shift;
 171     my $index_class = 'SQL::Translator::Schema::Index';
 172     my $index;
 173
 174     if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
 175         $index = shift;
 176         $index->table( $self );
 177     }
 178     else {
 179         my %args = @_;
 180         $args{'table'} = $self;
 181         $index = $index_class->new( \%args ) or return
 182             $self->error( $index_class->error );
 183     }
 184
 185     push @{ $self->{'indices'} }, $index;
 186     return $index;
 187 }
 188
 189 # ----------------------------------------------------------------------
 190 sub add_field {
 191
 192 =pod
 193
 194 =head2 add_field
 195
 196 Add an field to the table.  Returns the newly created
 197 C<SQL::Translator::Schema::Field> object.  The "name" parameter is
 198 required.  If you try to create a field with the same name as an
 199 existing field, you will get an error and the field will not be created.
 200
 201   my $field1    =  $table->add_field(
 202       name      => 'foo_id',
 203       data_type => 'integer',
 204       size      => 11,
 205   );
 206
 207   my $field2 =  SQL::Translator::Schema::Field->new(
 208       name   => 'name',
 209       table  => $table,
 210   );
 211   $field2    = $table->add_field( $field2 ) or die $table->error;
 212
 213 =cut
 214
 215     my $self  = shift;
 216     my $field_class = 'SQL::Translator::Schema::Field';
 217     my $field;
 218
 219     if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
 220         $field = shift;
 221         $field->table( $self );
 222     }
 223     else {
 224         my %args = @_;
 225         $args{'table'} = $self;
 226         $field = $field_class->new( \%args ) or return
 227             $self->error( $field_class->error );
 228     }
 229
 230     my $field_name = $field->name or return $self->error('No name');
 231
 232     if ( exists $self->{'fields'}{ $field_name } ) {
 233         return $self->error(qq[Can't create field: "$field_name" exists]);
 234     }
 235     else {
 236         $self->{'fields'}{ $field_name } = $field;
 237         $self->{'fields'}{ $field_name }{'order'} = ++$FIELD_ORDER;
 238     }
 239
 240     return $field;
 241 }
 242
 243 # ----------------------------------------------------------------------
 244 sub get_constraints {
 245
 246 =pod
 247
 248 =head2 get_constraints
 249
 250 Returns all the constraint objects as an array or array reference.
 251
 252   my @constraints = $table->get_constraints;
 253
 254 =cut
 255
 256     my $self = shift;
 257
 258     if ( ref $self->{'constraints'} ) {
 259         return wantarray
 260             ? @{ $self->{'constraints'} } : $self->{'constraints'};
 261     }
 262     else {
 263         $self->error('No constraints');
 264         return wantarray ? () : undef;
 265     }
 266 }
 267
 268 # ----------------------------------------------------------------------
 269 sub get_indices {
 270
 271 =pod
 272
 273 =head2 get_indices
 274
 275 Returns all the index objects as an array or array reference.
 276
 277   my @indices = $table->get_indices;
 278
 279 =cut
 280
 281     my $self = shift;
 282
 283     if ( ref $self->{'indices'} ) {
 284         return wantarray
 285             ? @{ $self->{'indices'} }
 286             : $self->{'indices'};
 287     }
 288     else {
 289         $self->error('No indices');
 290         return wantarray ? () : undef;
 291     }
 292 }
 293
 294 # ----------------------------------------------------------------------
 295 sub get_field {
 296
 297 =pod
 298
 299 =head2 get_field
 300
 301 Returns a field by the name provided.
 302
 303   my $field = $table->get_field('foo');
 304
 305 =cut
 306
 307     my $self       = shift;
 308     my $field_name = shift or return $self->error('No field name');
 309     return $self->error( qq[Field "$field_name" does not exist] ) unless
 310         exists $self->{'fields'}{ $field_name };
 311     return $self->{'fields'}{ $field_name };
 312 }
 313
 314 # ----------------------------------------------------------------------
 315 sub get_fields {
 316
 317 =pod
 318
 319 =head2 get_fields
 320
 321 Returns all the field objects as an array or array reference.
 322
 323   my @fields = $table->get_fields;
 324
 325 =cut
 326
 327     my $self = shift;
 328     my @fields =
 329         sort { $a->{'order'} <=> $b->{'order'} }
 330         values %{ $self->{'fields'} || {} };
 331
 332     if ( @fields ) {
 333         return wantarray ? @fields : \@fields;
 334     }
 335     else {
 336         $self->error('No fields');
 337         return wantarray ? () : undef;
 338     }
 339 }
 340
 341 # ----------------------------------------------------------------------
 342 sub is_valid {
 343
 344 =pod
 345
 346 =head2 is_valid
 347
 348 Determine whether the view is valid or not.
 349
 350   my $ok = $view->is_valid;
 351
 352 =cut
 353
 354     my $self = shift;
 355     return $self->error('No name')   unless $self->name;
 356     return $self->error('No fields') unless $self->get_fields;
 357
 358     for my $object (
 359         $self->get_fields, $self->get_indices, $self->get_constraints
 360     ) {
 361         return $object->error unless $object->is_valid;
 362     }
 363
 364     return 1;
 365 }
 366
 367 # ----------------------------------------------------------------------
 368 sub schema {
 369
 370 =pod
 371
 372 =head2 schema
 373
 374 Get or set the table's schema object.
 375
 376   my $schema = $table->schema;
 377
 378 =cut
 379
 380     my $self = shift;
 381     if ( my $arg = shift ) {
 382         return $self->error('Not a schema object') unless
 383             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 384         $self->{'schema'} = $arg;
 385     }
 386
 387     return $self->{'schema'};
 388 }
 389
 390 # ----------------------------------------------------------------------
 391 sub primary_key {
 392
 393 =pod
 394
 395 =head2 options
 396
 397 Gets or sets the table's primary key(s).  Takes one or more field
 398 names (as a string, list or array[ref]) as an argument.  If the field
 399 names are present, it will create a new PK if none exists, or it will
 400 add to the fields of an existing PK (and will unique the field names).
 401 Returns the C<SQL::Translator::Schema::Constraint> object representing
 402 the primary key.
 403
 404 These are eqivalent:
 405
 406   $table->primary_key('id');
 407   $table->primary_key(['name']);
 408   $table->primary_key('id','name']);
 409   $table->primary_key(['id','name']);
 410   $table->primary_key('id,name');
 411   $table->primary_key(qw[ id name ]);
 412
 413   my $pk = $table->primary_key;
 414
 415 =cut
 416
 417     my $self = shift;
 418     my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
 419         ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
 420
 421     my $constraint;
 422     if ( @$fields ) {
 423         for my $f ( @$fields ) {
 424             return $self->error(qq[Invalid field "$f"]) unless
 425                 $self->get_field($f);
 426         }
 427
 428         my $has_pk;
 429         for my $c ( $self->get_constraints ) {
 430             if ( $c->type eq PRIMARY_KEY ) {
 431                 $has_pk = 1;
 432                 $c->fields( @{ $c->fields }, @$fields );
 433                 $constraint = $c;
 434             }
 435         }
 436
 437         unless ( $has_pk ) {
 438             $constraint = $self->add_constraint(
 439                 type   => PRIMARY_KEY,
 440                 fields => $fields,
 441             );
 442         }
 443     }
 444
 445     if ( $constraint ) {
 446         return $constraint;
 447     }
 448     else {
 449         for my $c ( $self->get_constraints ) {
 450             return $c if $c->type eq PRIMARY_KEY;
 451         }
 452     }
 453
 454     return $self->error('No primary key');
 455 }
 456
 457 # ----------------------------------------------------------------------
 458 sub options {
 459
 460 =pod
 461
 462 =head2 options
 463
 464 Get or set the table's options (e.g., table types for MySQL).  Returns
 465 an array or array reference.
 466
 467   my @options = $table->options;
 468
 469 =cut
 470
 471     my $self    = shift;
 472     my $options = UNIVERSAL::isa( $_[0], 'ARRAY' )
 473         ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
 474
 475     push @{ $self->{'options'} }, @$options;
 476
 477     if ( ref $self->{'options'} ) {
 478         return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
 479     }
 480     else {
 481         return wantarray ? () : [];
 482     }
 483 }
 484
 485 1;
 486
 487 # ----------------------------------------------------------------------
 488
 489 =pod
 490
 491 =head1 AUTHOR
 492
 493 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 494
 495 =cut