lib/SQL/Translator/Schema/Table.pm

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