lib/SQL/Translator/Schema/Table.pm

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