lib/SQL/Translator/Schema/Table.pm

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