lib/SQL/Translator/Schema/Table.pm

   1 package SQL::Translator::Schema::Table;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Table.pm,v 1.29 2004-11-05 15:03:10 grommit Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   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 SQL::Translator::Utils 'parse_list_arg';
  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 use Data::Dumper;
  49
  50 use base 'SQL::Translator::Schema::Object';
  51
  52 use vars qw( $VERSION $FIELD_ORDER );
  53
  54 $VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/;
  55
  56
  57 # Stringify to our name, being careful not to pass any args through so we don't
  58 # accidentally set it to undef. We also have to tweak bool so the object is
  59 # still true when it doesn't have a name (which shouldn't happen!).
  60 use overload
  61     '""'     => sub { shift->name },
  62     'bool'   => sub { $_[0]->name || $_[0] },
  63     fallback => 1,
  64 ;
  65
  66 # ----------------------------------------------------------------------
  67
  68 __PACKAGE__->_attributes( qw/schema name comments options order/ );
  69
  70 =pod
  71
  72 =head2 new
  73
  74 Object constructor.
  75
  76   my $table  =  SQL::Translator::Schema::Table->new(
  77       schema => $schema,
  78       name   => 'foo',
  79   );
  80
  81 =cut
  82
  83 # ----------------------------------------------------------------------
  84 sub add_constraint {
  85
  86 =pod
  87
  88 =head2 add_constraint
  89
  90 Add a constraint to the table.  Returns the newly created
  91 C<SQL::Translator::Schema::Constraint> object.
  92
  93   my $c1     = $table->add_constraint(
  94       name   => 'pk',
  95       type   => PRIMARY_KEY,
  96       fields => [ 'foo_id' ],
  97   );
  98
  99   my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
 100   $c2    = $table->add_constraint( $constraint );
 101
 102 =cut
 103
 104     my $self             = shift;
 105     my $constraint_class = 'SQL::Translator::Schema::Constraint';
 106     my $constraint;
 107
 108     if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
 109         $constraint = shift;
 110         $constraint->table( $self );
 111     }
 112     else {
 113         my %args = @_;
 114         $args{'table'} = $self;
 115         $constraint = $constraint_class->new( \%args ) or
 116            return $self->error( $constraint_class->error );
 117     }
 118
 119     #
 120     # If we're trying to add a PK when one is already defined,
 121     # then just add the fields to the existing definition.
 122     #
 123     my $ok = 1;
 124     my $pk = $self->primary_key;
 125     if ( $pk && $constraint->type eq PRIMARY_KEY ) {
 126         $self->primary_key( $constraint->fields );
 127         $pk->name($constraint->name) if $constraint->name;
 128         my %extra = $constraint->extra;
 129         $pk->extra(%extra) if keys %extra;
 130         $constraint = $pk;
 131         $ok         = 0;
 132     }
 133     elsif ( $constraint->type eq PRIMARY_KEY ) {
 134         for my $fname ( $constraint->fields ) {
 135             if ( my $f = $self->get_field( $fname ) ) {
 136                 $f->is_primary_key( 1 );
 137             }
 138         }
 139     }
 140     #
 141     # See if another constraint of the same type
 142     # covers the same fields.  -- This doesn't work!  ky
 143     #
 144 #    elsif ( $constraint->type ne CHECK_C ) {
 145 #        my @field_names = $constraint->fields;
 146 #        for my $c (
 147 #            grep { $_->type eq $constraint->type }
 148 #            $self->get_constraints
 149 #        ) {
 150 #            my %fields = map { $_, 1 } $c->fields;
 151 #            for my $field_name ( @field_names ) {
 152 #                if ( $fields{ $field_name } ) {
 153 #                    $constraint = $c;
 154 #                    $ok = 0;
 155 #                    last;
 156 #                }
 157 #            }
 158 #            last unless $ok;
 159 #        }
 160 #    }
 161
 162     if ( $ok ) {
 163         push @{ $self->{'constraints'} }, $constraint;
 164     }
 165
 166     return $constraint;
 167 }
 168
 169 # ----------------------------------------------------------------------
 170 sub add_index {
 171
 172 =pod
 173
 174 =head2 add_index
 175
 176 Add an index to the table.  Returns the newly created
 177 C<SQL::Translator::Schema::Index> object.
 178
 179   my $i1     = $table->add_index(
 180       name   => 'name',
 181       fields => [ 'name' ],
 182       type   => 'normal',
 183   );
 184
 185   my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
 186   $i2    = $table->add_index( $index );
 187
 188 =cut
 189
 190     my $self        = shift;
 191     my $index_class = 'SQL::Translator::Schema::Index';
 192     my $index;
 193
 194     if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
 195         $index = shift;
 196         $index->table( $self );
 197     }
 198     else {
 199         my %args = @_;
 200         $args{'table'} = $self;
 201         $index = $index_class->new( \%args ) or return
 202             $self->error( $index_class->error );
 203     }
 204
 205     push @{ $self->{'indices'} }, $index;
 206     return $index;
 207 }
 208
 209 # ----------------------------------------------------------------------
 210 sub add_field {
 211
 212 =pod
 213
 214 =head2 add_field
 215
 216 Add an field to the table.  Returns the newly created
 217 C<SQL::Translator::Schema::Field> object.  The "name" parameter is
 218 required.  If you try to create a field with the same name as an
 219 existing field, you will get an error and the field will not be created.
 220
 221   my $f1        =  $table->add_field(
 222       name      => 'foo_id',
 223       data_type => 'integer',
 224       size      => 11,
 225   );
 226
 227   my $f2     =  SQL::Translator::Schema::Field->new(
 228       name   => 'name',
 229       table  => $table,
 230   );
 231   $f2 = $table->add_field( $field2 ) or die $table->error;
 232
 233 =cut
 234
 235     my $self        = shift;
 236     my $field_class = 'SQL::Translator::Schema::Field';
 237     my $field;
 238
 239     if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
 240         $field = shift;
 241         $field->table( $self );
 242     }
 243     else {
 244         my %args = @_;
 245         $args{'table'} = $self;
 246         $field = $field_class->new( \%args ) or return
 247             $self->error( $field_class->error );
 248     }
 249
 250     $field->order( ++$FIELD_ORDER );
 251     # We know we have a name as the Field->new above errors if none given.
 252     my $field_name = $field->name;
 253
 254     if ( exists $self->{'fields'}{ $field_name } ) {
 255         return $self->error(qq[Can't create field: "$field_name" exists]);
 256     }
 257     else {
 258         $self->{'fields'}{ $field_name } = $field;
 259     }
 260
 261     return $field;
 262 }
 263
 264 # ----------------------------------------------------------------------
 265 sub comments {
 266
 267 =pod
 268
 269 =head2 comments
 270
 271 Get or set the comments on a table.  May be called several times to
 272 set and it will accumulate the comments.  Called in an array context,
 273 returns each comment individually; called in a scalar context, returns
 274 all the comments joined on newlines.
 275
 276   $table->comments('foo');
 277   $table->comments('bar');
 278   print join( ', ', $table->comments ); # prints "foo, bar"
 279
 280 =cut
 281
 282     my $self     = shift;
 283     my @comments = ref $_[0] ? @{ $_[0] } : @_;
 284
 285     for my $arg ( @comments ) {
 286         $arg = $arg->[0] if ref $arg;
 287         push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
 288     }
 289
 290     if ( @{ $self->{'comments'} || [] } ) {
 291         return wantarray
 292             ? @{ $self->{'comments'} }
 293             : join( "\n", @{ $self->{'comments'} } )
 294         ;
 295     }
 296     else {
 297         return wantarray ? () : undef;
 298     }
 299 }
 300
 301 # ----------------------------------------------------------------------
 302 sub get_constraints {
 303
 304 =pod
 305
 306 =head2 get_constraints
 307
 308 Returns all the constraint objects as an array or array reference.
 309
 310   my @constraints = $table->get_constraints;
 311
 312 =cut
 313
 314     my $self = shift;
 315
 316     if ( ref $self->{'constraints'} ) {
 317         return wantarray
 318             ? @{ $self->{'constraints'} } : $self->{'constraints'};
 319     }
 320     else {
 321         $self->error('No constraints');
 322         return wantarray ? () : undef;
 323     }
 324 }
 325
 326 # ----------------------------------------------------------------------
 327 sub get_indices {
 328
 329 =pod
 330
 331 =head2 get_indices
 332
 333 Returns all the index objects as an array or array reference.
 334
 335   my @indices = $table->get_indices;
 336
 337 =cut
 338
 339     my $self = shift;
 340
 341     if ( ref $self->{'indices'} ) {
 342         return wantarray
 343             ? @{ $self->{'indices'} }
 344             : $self->{'indices'};
 345     }
 346     else {
 347         $self->error('No indices');
 348         return wantarray ? () : undef;
 349     }
 350 }
 351
 352 # ----------------------------------------------------------------------
 353 sub get_field {
 354
 355 =pod
 356
 357 =head2 get_field
 358
 359 Returns a field by the name provided.
 360
 361   my $field = $table->get_field('foo');
 362
 363 =cut
 364
 365     my $self       = shift;
 366     my $field_name = shift or return $self->error('No field name');
 367     return $self->error( qq[Field "$field_name" does not exist] ) unless
 368         exists $self->{'fields'}{ $field_name };
 369     return $self->{'fields'}{ $field_name };
 370 }
 371
 372 # ----------------------------------------------------------------------
 373 sub get_fields {
 374
 375 =pod
 376
 377 =head2 get_fields
 378
 379 Returns all the field objects as an array or array reference.
 380
 381   my @fields = $table->get_fields;
 382
 383 =cut
 384
 385     my $self = shift;
 386     my @fields =
 387         map  { $_->[1] }
 388         sort { $a->[0] <=> $b->[0] }
 389         map  { [ $_->order, $_ ] }
 390         values %{ $self->{'fields'} || {} };
 391
 392     if ( @fields ) {
 393         return wantarray ? @fields : \@fields;
 394     }
 395     else {
 396         $self->error('No fields');
 397         return wantarray ? () : undef;
 398     }
 399 }
 400
 401 # ----------------------------------------------------------------------
 402 sub is_valid {
 403
 404 =pod
 405
 406 =head2 is_valid
 407
 408 Determine whether the view is valid or not.
 409
 410   my $ok = $view->is_valid;
 411
 412 =cut
 413
 414     my $self = shift;
 415     return $self->error('No name')   unless $self->name;
 416     return $self->error('No fields') unless $self->get_fields;
 417
 418     for my $object (
 419         $self->get_fields, $self->get_indices, $self->get_constraints
 420     ) {
 421         return $object->error unless $object->is_valid;
 422     }
 423
 424     return 1;
 425 }
 426
 427 # ----------------------------------------------------------------------
 428 sub is_trivial_link {
 429
 430 =pod
 431
 432 =head2 is_trivial_link
 433
 434 True if table has no data (non-key) fields and only uses single key joins.
 435
 436 =cut
 437
 438     my $self = shift;
 439     return 0 if $self->is_data;
 440     return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
 441
 442     $self->{'is_trivial_link'} = 1;
 443
 444     my %fk = ();
 445
 446     foreach my $field ( $self->get_fields ) {
 447           next unless $field->is_foreign_key;
 448           $fk{$field->foreign_key_reference->reference_table}++;
 449         }
 450
 451     foreach my $referenced (keys %fk){
 452         if($fk{$referenced} > 1){
 453           $self->{'is_trivial_link'} = 0;
 454           last;
 455         }
 456     }
 457
 458     return $self->{'is_trivial_link'};
 459
 460 }
 461
 462 sub is_data {
 463
 464 =pod
 465
 466 =head2 is_data
 467
 468 Returns true if the table has some non-key fields.
 469
 470 =cut
 471
 472     my $self = shift;
 473     return $self->{'is_data'} if defined $self->{'is_data'};
 474
 475     $self->{'is_data'} = 0;
 476
 477     foreach my $field ( $self->get_fields ) {
 478         if ( !$field->is_primary_key and !$field->is_foreign_key ) {
 479             $self->{'is_data'} = 1;
 480             return $self->{'is_data'};
 481         }
 482     }
 483
 484     return $self->{'is_data'};
 485 }
 486
 487 # ----------------------------------------------------------------------
 488 sub can_link {
 489
 490 =pod
 491
 492 =head2 can_link
 493
 494 Determine whether the table can link two arg tables via many-to-many.
 495
 496   my $ok = $table->can_link($table1,$table2);
 497
 498 =cut
 499
 500     my ( $self, $table1, $table2 ) = @_;
 501
 502     return $self->{'can_link'}{ $table1->name }{ $table2->name }
 503       if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
 504
 505     if ( $self->is_data == 1 ) {
 506         $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
 507         $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
 508         return $self->{'can_link'}{ $table1->name }{ $table2->name };
 509     }
 510
 511     my %fk = ();
 512
 513     foreach my $field ( $self->get_fields ) {
 514         if ( $field->is_foreign_key ) {
 515             push @{ $fk{ $field->foreign_key_reference->reference_table } },
 516               $field->foreign_key_reference;
 517         }
 518     }
 519
 520     if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
 521     {
 522         $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
 523         $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
 524         return $self->{'can_link'}{ $table1->name }{ $table2->name };
 525     }
 526
 527     # trivial traversal, only one way to link the two tables
 528     if (    scalar( @{ $fk{ $table1->name } } == 1 )
 529         and scalar( @{ $fk{ $table2->name } } == 1 ) )
 530     {
 531         $self->{'can_link'}{ $table1->name }{ $table2->name } =
 532           [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
 533         $self->{'can_link'}{ $table1->name }{ $table2->name } =
 534           [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
 535
 536         # non-trivial traversal.  one way to link table2,
 537         # many ways to link table1
 538     }
 539     elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
 540         and scalar( @{ $fk{ $table2->name } } == 1 ) )
 541     {
 542         $self->{'can_link'}{ $table1->name }{ $table2->name } =
 543           [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
 544         $self->{'can_link'}{ $table2->name }{ $table1->name } =
 545           [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
 546
 547         # non-trivial traversal.  one way to link table1,
 548         # many ways to link table2
 549     }
 550     elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
 551         and scalar( @{ $fk{ $table2->name } } > 1 ) )
 552     {
 553         $self->{'can_link'}{ $table1->name }{ $table2->name } =
 554           [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
 555         $self->{'can_link'}{ $table2->name }{ $table1->name } =
 556           [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
 557
 558         # non-trivial traversal.  many ways to link table1 and table2
 559     }
 560     elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
 561         and scalar( @{ $fk{ $table2->name } } > 1 ) )
 562     {
 563         $self->{'can_link'}{ $table1->name }{ $table2->name } =
 564           [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
 565         $self->{'can_link'}{ $table2->name }{ $table1->name } =
 566           [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
 567
 568         # one of the tables didn't export a key
 569         # to this table, no linking possible
 570     }
 571     else {
 572         $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
 573         $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
 574     }
 575
 576     return $self->{'can_link'}{ $table1->name }{ $table2->name };
 577 }
 578
 579 # ----------------------------------------------------------------------
 580 sub name {
 581
 582 =pod
 583
 584 =head2 name
 585
 586 Get or set the table's name.
 587
 588 Errors ("No table name") if you try to set a blank name.
 589
 590 If provided an argument, checks the schema object for a table of
 591 that name and disallows the change if one exists (setting the error to
 592 "Can't use table name "%s": table exists").
 593
 594   my $table_name = $table->name('foo');
 595
 596 =cut
 597
 598     my $self = shift;
 599
 600     if ( @_ ) {
 601         my $arg = shift || return $self->error( "No table name" );
 602         if ( my $schema = $self->schema ) {
 603             return $self->error( qq[Can't use table name "$arg": table exists] )
 604                 if $schema->get_table( $arg );
 605         }
 606         $self->{'name'} = $arg;
 607     }
 608
 609     return $self->{'name'} || '';
 610 }
 611
 612 # ----------------------------------------------------------------------
 613 sub schema {
 614
 615 =pod
 616
 617 =head2 schema
 618
 619 Get or set the table's schema object.
 620
 621   my $schema = $table->schema;
 622
 623 =cut
 624
 625     my $self = shift;
 626     if ( my $arg = shift ) {
 627         return $self->error('Not a schema object') unless
 628             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 629         $self->{'schema'} = $arg;
 630     }
 631
 632     return $self->{'schema'};
 633 }
 634
 635 # ----------------------------------------------------------------------
 636 sub primary_key {
 637
 638 =pod
 639
 640 =head2 primary_key
 641
 642 Gets or sets the table's primary key(s).  Takes one or more field
 643 names (as a string, list or array[ref]) as an argument.  If the field
 644 names are present, it will create a new PK if none exists, or it will
 645 add to the fields of an existing PK (and will unique the field names).
 646 Returns the C<SQL::Translator::Schema::Constraint> object representing
 647 the primary key.
 648
 649 These are eqivalent:
 650
 651   $table->primary_key('id');
 652   $table->primary_key(['name']);
 653   $table->primary_key('id','name']);
 654   $table->primary_key(['id','name']);
 655   $table->primary_key('id,name');
 656   $table->primary_key(qw[ id name ]);
 657
 658   my $pk = $table->primary_key;
 659
 660 =cut
 661
 662     my $self   = shift;
 663     my $fields = parse_list_arg( @_ );
 664
 665     my $constraint;
 666     if ( @$fields ) {
 667         for my $f ( @$fields ) {
 668             return $self->error(qq[Invalid field "$f"]) unless
 669                 $self->get_field($f);
 670         }
 671
 672         my $has_pk;
 673         for my $c ( $self->get_constraints ) {
 674             if ( $c->type eq PRIMARY_KEY ) {
 675                 $has_pk = 1;
 676                 $c->fields( @{ $c->fields }, @$fields );
 677                 $constraint = $c;
 678             }
 679         }
 680
 681         unless ( $has_pk ) {
 682             $constraint = $self->add_constraint(
 683                 type   => PRIMARY_KEY,
 684                 fields => $fields,
 685             ) or return;
 686         }
 687     }
 688
 689     if ( $constraint ) {
 690         return $constraint;
 691     }
 692     else {
 693         for my $c ( $self->get_constraints ) {
 694             return $c if $c->type eq PRIMARY_KEY;
 695         }
 696     }
 697
 698     return;
 699 }
 700
 701 # ----------------------------------------------------------------------
 702 sub options {
 703
 704 =pod
 705
 706 =head2 options
 707
 708 Get or set the table's options (e.g., table types for MySQL).  Returns
 709 an array or array reference.
 710
 711   my @options = $table->options;
 712
 713 =cut
 714
 715     my $self    = shift;
 716     my $options = parse_list_arg( @_ );
 717
 718     push @{ $self->{'options'} }, @$options;
 719
 720     if ( ref $self->{'options'} ) {
 721         return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
 722     }
 723     else {
 724         return wantarray ? () : [];
 725     }
 726 }
 727
 728 # ----------------------------------------------------------------------
 729 sub order {
 730
 731 =pod
 732
 733 =head2 order
 734
 735 Get or set the table's order.
 736
 737   my $order = $table->order(3);
 738
 739 =cut
 740
 741     my ( $self, $arg ) = @_;
 742
 743     if ( defined $arg && $arg =~ /^\d+$/ ) {
 744         $self->{'order'} = $arg;
 745     }
 746
 747     return $self->{'order'} || 0;
 748 }
 749
 750 # ----------------------------------------------------------------------
 751 sub field_names {
 752
 753 =head2 field_names
 754
 755 Read-only method to return a list or array ref of the field names. Returns undef
 756 or an empty list if the table has no fields set. Usefull if you want to
 757 avoid the overload magic of the Field objects returned by the get_fields method.
 758
 759   my @names = $constraint->field_names;
 760
 761 =cut
 762
 763     my $self = shift;
 764     my @fields =
 765         map  { $_->name }
 766         sort { $a->order <=> $b->order }
 767         values %{ $self->{'fields'} || {} };
 768
 769     if ( @fields ) {
 770         return wantarray ? @fields : \@fields;
 771     }
 772     else {
 773         $self->error('No fields');
 774         return wantarray ? () : undef;
 775     }
 776 }
 777
 778 # ----------------------------------------------------------------------
 779
 780 =head1 LOOKUP METHODS
 781
 782 The following are a set of shortcut methods for getting commonly used lists of
 783 fields and constraints. They all return lists or array refs of Field or
 784 Constraint objects.
 785
 786 =over 4
 787
 788 =item pkey_fields
 789
 790 The primary key fields.
 791
 792 =item fkey_fields
 793
 794 All foreign key fields.
 795
 796 =item nonpkey_fields
 797
 798 All the fields except the primary key.
 799
 800 =item data_fields
 801
 802 All non key fields.
 803
 804 =item unique_fields
 805
 806 All fields with unique constraints.
 807
 808 =item unique_constraints
 809
 810 All this tables unique constraints.
 811
 812 =item fkey_constraints
 813
 814 All this tables foreign key constraints. (See primary_key method to get the
 815 primary key constraint)
 816
 817 =back
 818
 819 =cut
 820
 821 sub pkey_fields {
 822     my $me = shift;
 823     my @fields = grep { $_->is_primary_key } $me->get_fields;
 824     return wantarray ? @fields : \@fields;
 825 }
 826
 827 # ----------------------------------------------------------------------
 828 sub fkey_fields {
 829     my $me = shift;
 830     my @fields;
 831     push @fields, $_->fields foreach $me->fkey_constraints;
 832     return wantarray ? @fields : \@fields;
 833 }
 834
 835 # ----------------------------------------------------------------------
 836 sub nonpkey_fields {
 837     my $me = shift;
 838     my @fields = grep { !$_->is_primary_key } $me->get_fields;
 839     return wantarray ? @fields : \@fields;
 840 }
 841
 842 # ----------------------------------------------------------------------
 843 sub data_fields {
 844     my $me = shift;
 845     my @fields =
 846         grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
 847     return wantarray ? @fields : \@fields;
 848 }
 849
 850 # ----------------------------------------------------------------------
 851 sub unique_fields {
 852     my $me = shift;
 853     my @fields;
 854     push @fields, $_->fields foreach $me->unique_constraints;
 855     return wantarray ? @fields : \@fields;
 856 }
 857
 858 # ----------------------------------------------------------------------
 859 sub unique_constraints {
 860     my $me = shift;
 861     my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
 862     return wantarray ? @cons : \@cons;
 863 }
 864
 865 # ----------------------------------------------------------------------
 866 sub fkey_constraints {
 867     my $me = shift;
 868     my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
 869     return wantarray ? @cons : \@cons;
 870 }
 871
 872 # ----------------------------------------------------------------------
 873 sub DESTROY {
 874     my $self = shift;
 875     undef $self->{'schema'}; # destroy cyclical reference
 876     undef $_ for @{ $self->{'constraints'} };
 877     undef $_ for @{ $self->{'indices'} };
 878     undef $_ for values %{ $self->{'fields'} };
 879 }
 880
 881 1;
 882
 883 # ----------------------------------------------------------------------
 884
 885 =pod
 886
 887 =head1 AUTHORS
 888
 889 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 890 Allen Day E<lt>allenday@ucla.eduE<gt>.
 891
 892 =cut