DBSchema/Table.pm

   1 package DBIx::DBSchema::Table;
   2
   3 use strict;
   4 use Carp;
   5 use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
   6 use DBIx::DBSchema::Column 0.14;
   7 use DBIx::DBSchema::Index;
   8 use DBIx::DBSchema::ForeignKey 0.13;
   9
  10 our $VERSION = '0.12';
  11 our $DEBUG = 0;
  12
  13 =head1 NAME
  14
  15 DBIx::DBSchema::Table - Table objects
  16
  17 =head1 SYNOPSIS
  18
  19   use DBIx::DBSchema::Table;
  20
  21   #new style (preferred), pass a hashref of parameters
  22   $table = new DBIx::DBSchema::Table (
  23     {
  24       name         => "table_name",
  25       primary_key  => "primary_key",
  26       columns      => \@dbix_dbschema_column_objects,
  27       #deprecated# unique      => $dbix_dbschema_colgroup_unique_object,
  28       #deprecated# 'index'     => $dbix_dbschema_colgroup_index_object,
  29       indices      => \@dbix_dbschema_index_objects,
  30       foreign_keys => \@dbix_dbschema_foreign_key_objects,
  31     }
  32   );
  33
  34   #old style (VERY deprecated)
  35   $table = new DBIx::DBSchema::Table (
  36     "table_name",
  37     "primary_key",
  38     $dbix_dbschema_colgroup_unique_object,
  39     $dbix_dbschema_colgroup_index_object,
  40     @dbix_dbschema_column_objects,
  41   );
  42
  43   $table->addcolumn ( $dbix_dbschema_column_object );
  44
  45   $table_name = $table->name;
  46   $table->name("table_name");
  47
  48   $primary_key = $table->primary_key;
  49   $table->primary_key("primary_key");
  50
  51   #deprecated# $dbix_dbschema_colgroup_unique_object = $table->unique;
  52   #deprecated# $table->unique( $dbix_dbschema__colgroup_unique_object );
  53
  54   #deprecated# $dbix_dbschema_colgroup_index_object = $table->index;
  55   #deprecated# $table->index( $dbix_dbschema_colgroup_index_object );
  56
  57   %indices = $table->indices;
  58   $dbix_dbschema_index_object = $indices{'index_name'};
  59   @all_index_names = keys %indices;
  60   @all_dbix_dbschema_index_objects = values %indices;
  61
  62   @column_names = $table->columns;
  63
  64   $dbix_dbschema_column_object = $table->column("column");
  65
  66   #preferred
  67   @sql_statements = $table->sql_create_table( $dbh );
  68   @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
  69
  70   #possible problems
  71   @sql_statements = $table->sql_create_table( $datasrc );
  72   @sql_statements = $table->sql_create_table;
  73
  74 =head1 DESCRIPTION
  75
  76 DBIx::DBSchema::Table objects represent a single database table.
  77
  78 =head1 METHODS
  79
  80 =over 4
  81
  82 =item new HASHREF
  83
  84 Creates a new DBIx::DBSchema::Table object.  The preferred usage is to pass a
  85 hash reference of named parameters.
  86
  87   {
  88     name          => TABLE_NAME,
  89     primary_key   => PRIMARY_KEY,
  90     columns       => COLUMNS,
  91     indices       => INDICES,
  92     local_options => OPTIONS,
  93   }
  94
  95 TABLE_NAME is the name of the table.
  96
  97 PRIMARY_KEY is the primary key (may be empty).
  98
  99 COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
 100 (see L<DBIx::DBSchema::Column>).
 101
 102 INDICES is a reference to an array of DBIx::DBSchema::Index objects
 103 (see L<DBIx::DBSchema::Index>), or a hash reference of index names (keys) and
 104 DBIx::DBSchema::Index objects (values).
 105
 106 FOREIGN_KEYS is a references to an array of DBIx::DBSchema::ForeignKey objects
 107 (see L<DBIx::DBSchema::ForeignKey>).
 108
 109 OPTIONS is a scalar of database-specific table options, such as "WITHOUT OIDS"
 110 for Pg or "TYPE=InnoDB" for mysql.
 111
 112 =cut
 113
 114 sub new {
 115   my $proto = shift;
 116   my $class = ref($proto) || $proto;
 117
 118   my $self;
 119   if ( ref($_[0]) ) {
 120
 121     $self = shift;
 122     $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
 123     $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
 124
 125     $self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
 126        if ref($self->{indices}) eq 'ARRAY';
 127
 128     $self->{foreign_keys} ||= [];
 129
 130   } else {
 131
 132     carp "Old-style $class creation without named parameters is deprecated!";
 133     #croak "FATAL: old-style $class creation no longer supported;".
 134     #      " use named parameters";
 135
 136     my($name,$primary_key,$unique,$index,@columns) = @_;
 137
 138     my %columns = map { $_->name, $_ } @columns;
 139     my @column_order = map { $_->name } @columns;
 140
 141     $self = {
 142       'name'         => $name,
 143       'primary_key'  => $primary_key,
 144       'unique'       => $unique,
 145       'index'        => $index,
 146       'columns'      => \%columns,
 147       'column_order' => \@column_order,
 148       'foreign_keys' => [],
 149     };
 150
 151   }
 152
 153   #check $primary_key, $unique and $index to make sure they are $columns ?
 154   # (and sanity check?)
 155
 156   bless ($self, $class);
 157
 158   $_->table_obj($self) foreach values %{ $self->{columns} };
 159
 160   $self;
 161 }
 162
 163 =item new_odbc DATABASE_HANDLE TABLE_NAME
 164
 165 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
 166 handle for the specified table.  This uses the experimental DBI type_info
 167 method to create a table with standard (ODBC) SQL column types that most
 168 closely correspond to any non-portable column types.   Use this to import a
 169 schema that you wish to use with many different database engines.  Although
 170 primary key and (unique) index information will only be imported from databases
 171 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
 172 column names and attributes *should* work for any database.
 173
 174 Note: the _odbc refers to the column types used and nothing else - you do not
 175 have to have ODBC installed or connect to the database via ODBC.
 176
 177 =cut
 178
 179 our %create_params = (
 180 #  undef             => sub { '' },
 181   ''                => sub { '' },
 182   'max length'      => sub { $_[0]->{PRECISION}->[$_[1]]; },
 183   'precision,scale' =>
 184     sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
 185 );
 186
 187 sub new_odbc {
 188   my( $proto, $dbh, $name) = @_;
 189
 190   my $driver = _load_driver($dbh);
 191   my $sth = _null_sth($dbh, $name);
 192   my $sthpos = 0;
 193
 194   my $indices_hr =
 195     ( $driver
 196         ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
 197         : {}
 198     );
 199
 200   $proto->new({
 201     'name'        => $name,
 202     'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 203
 204     'columns'     => [
 205
 206       map {
 207
 208             my $col_name = $_;
 209
 210             my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
 211               or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
 212                      "returned no results for type ".  $sth->{TYPE}->[$sthpos];
 213
 214             my $length = &{ $create_params{ $type_info->{CREATE_PARAMS} } }
 215                           ( $sth, $sthpos++ );
 216
 217             my $default = '';
 218             if ( $driver ) {
 219               $default = ${ [
 220                 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
 221               ] }[4];
 222             }
 223
 224             DBIx::DBSchema::Column->new({
 225                 'name'    => $col_name,
 226                 #'type'    => "SQL_". uc($type_info->{'TYPE_NAME'}),
 227                 'type'    => $type_info->{'TYPE_NAME'},
 228                 'null'    => $sth->{NULLABLE}->[$sthpos],
 229                 'length'  => $length,
 230                 'default' => $default,
 231                 #'local'   => # DB-local
 232             });
 233
 234           }
 235           @{$sth->{NAME}}
 236
 237     ],
 238
 239     #indices
 240     'indices' => { map { my $indexname = $_;
 241                          $indexname =>
 242                            DBIx::DBSchema::Index->new($indices_hr->{$indexname})
 243                        }
 244                        keys %$indices_hr
 245                  },
 246
 247   });
 248 }
 249
 250 =item new_native DATABASE_HANDLE TABLE_NAME
 251
 252 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
 253 handle for the specified table.  This uses database-native methods to read the
 254 schema, and will preserve any non-portable column types.  The method is only
 255 available if there is a DBIx::DBSchema::DBD for the corresponding database
 256 engine (currently, MySQL and PostgreSQL).
 257
 258 =cut
 259
 260 sub new_native {
 261   my( $proto, $dbh, $name) = @_;
 262   my $driver = _load_driver($dbh);
 263
 264   my $primary_key =
 265     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 266
 267   my $indices_hr =
 268   ( $driver
 269       ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
 270       : {}
 271   );
 272
 273   $proto->new({
 274     'name'         => $name,
 275     'primary_key'  => $primary_key,
 276
 277     'columns'      => [
 278       map DBIx::DBSchema::Column->new( @{$_} ),
 279           eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
 280     ],
 281
 282     'indices' => { map { my $indexname = $_;
 283                          $indexname =>
 284                            DBIx::DBSchema::Index->new($indices_hr->{$indexname})
 285                        }
 286                        keys %$indices_hr
 287                  },
 288
 289     'foreign_keys' => [
 290       map DBIx::DBSchema::ForeignKey->new( $_ ),
 291           eval "DBIx::DBSchema::DBD::$driver->constraints(\$dbh, \$name)"
 292     ],
 293
 294
 295   });
 296 }
 297
 298 =item addcolumn COLUMN
 299
 300 Adds this DBIx::DBSchema::Column object.
 301
 302 =cut
 303
 304 sub addcolumn {
 305   my($self, $column) = @_;
 306   $column->table_obj($self);
 307   ${$self->{'columns'}}{$column->name} = $column; #sanity check?
 308   push @{$self->{'column_order'}}, $column->name;
 309 }
 310
 311 =item delcolumn COLUMN_NAME
 312
 313 Deletes this column.  Returns false if no column of this name was found to
 314 remove, true otherwise.
 315
 316 =cut
 317
 318 sub delcolumn {
 319   my($self,$column) = @_;
 320   return 0 unless exists $self->{'columns'}{$column};
 321   $self->{'columns'}{$column}->table_obj('');
 322   delete $self->{'columns'}{$column};
 323   @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}};  1;
 324 }
 325
 326 =item name [ TABLE_NAME ]
 327
 328 Returns or sets the table name.
 329
 330 =cut
 331
 332 sub name {
 333   my($self,$value)=@_;
 334   if ( defined($value) ) {
 335     $self->{name} = $value;
 336   } else {
 337     $self->{name};
 338   }
 339 }
 340
 341 =item local_options [ OPTIONS ]
 342
 343 Returns or sets the database-specific table options string.
 344
 345 =cut
 346
 347 sub local_options {
 348   my($self,$value)=@_;
 349   if ( defined($value) ) {
 350     $self->{local_options} = $value;
 351   } else {
 352     defined $self->{local_options} ? $self->{local_options} : '';
 353   }
 354 }
 355
 356 =item primary_key [ PRIMARY_KEY ]
 357
 358 Returns or sets the primary key.
 359
 360 =cut
 361
 362 sub primary_key {
 363   my($self,$value)=@_;
 364   if ( defined($value) ) {
 365     $self->{primary_key} = $value;
 366   } else {
 367     #$self->{primary_key};
 368     #hmm.  maybe should untaint the entire structure when it comes off disk
 369     # cause if you don't trust that, ?
 370     $self->{primary_key} =~ /^(\w*)$/
 371       #aah!
 372       or die "Illegal primary key: ", $self->{primary_key};
 373     $1;
 374   }
 375 }
 376
 377 =item columns
 378
 379 Returns a list consisting of the names of all columns.
 380
 381 =cut
 382
 383 sub columns {
 384   my($self)=@_;
 385   #keys %{$self->{'columns'}};
 386   #must preserve order
 387   @{ $self->{'column_order'} };
 388 }
 389
 390 =item column COLUMN_NAME
 391
 392 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
 393 COLUMN_NAME.
 394
 395 =cut
 396
 397 sub column {
 398   my($self,$column)=@_;
 399   $self->{'columns'}->{$column};
 400 }
 401
 402 =item indices
 403
 404 Returns a list of key-value pairs suitable for assigning to a hash.  Keys are
 405 index names, and values are index objects (see L<DBIx::DBSchema::Index>).
 406
 407 =cut
 408
 409 sub indices {
 410   my $self = shift;
 411   exists( $self->{'indices'} )
 412     ? %{ $self->{'indices'} }
 413     : ();
 414 }
 415
 416 =item unique_singles
 417
 418 Meet exciting and unique singles using this method!
 419
 420 This method returns a list of column names that are indexed with their own,
 421 unique, non-compond (that's the "single" part) indices.
 422
 423 =cut
 424
 425 sub unique_singles {
 426   my $self = shift;
 427   my %indices = $self->indices;
 428
 429   map { ${ $indices{$_}->columns }[0] }
 430       grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
 431            keys %indices;
 432 }
 433
 434 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 435
 436 Returns a list of SQL statments to create this table.
 437
 438 The data source can be specified by passing an open DBI database handle, or by
 439 passing the DBI data source name, username and password.
 440
 441 Although the username and password are optional, it is best to call this method
 442 with a database handle or data source including a valid username and password -
 443 a DBI connection will be opened and the quoting and type mapping will be more
 444 reliable.
 445
 446 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
 447 MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
 448 (if applicable) may also be supported in the future.
 449
 450 =cut
 451
 452 sub sql_create_table {
 453   my($self, $dbh) = ( shift, _dbh(@_) );
 454
 455   my $driver = _load_driver($dbh);
 456
 457 #should be in the DBD somehwere :/
 458 #  my $saved_pkey = '';
 459 #  if ( $driver eq 'Pg' && $self->primary_key ) {
 460 #    my $pcolumn = $self->column( (
 461 #      grep { $self->column($_)->name eq $self->primary_key } $self->columns
 462 #    )[0] );
 463 ##AUTO-INCREMENT#    $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
 464 #    $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
 465 #    #my $saved_pkey = $self->primary_key;
 466 #    #$self->primary_key('');
 467 #    #change it back afterwords :/
 468 #  }
 469
 470   my @columns = map { $self->column($_)->line($dbh) } $self->columns;
 471
 472   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
 473     if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
 474
 475 #  push @columns, $self->foreign_keys_sql;
 476
 477   my $indexnum = 1;
 478
 479   my @r = (
 480     "CREATE TABLE ". $self->name. " (\n  ". join(",\n  ", @columns). "\n)\n".
 481     $self->local_options
 482   );
 483
 484   my %indices = $self->indices;
 485   #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
 486   foreach my $index ( keys %indices ) {
 487     push @r, $indices{$index}->sql_create_index( $self->name );
 488   }
 489
 490   #$self->primary_key($saved_pkey) if $saved_pkey;
 491   @r;
 492 }
 493
 494 =item sql_add_constraints [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 495
 496 Returns a list of SQL statments to add constraints (foreign keys) to this table.
 497
 498 The data source can be specified by passing an open DBI database handle, or by
 499 passing the DBI data source name, username and password.
 500
 501 Although the username and password are optional, it is best to call this method
 502 with a database handle or data source including a valid username and password -
 503 a DBI connection will be opened and the quoting and type mapping will be more
 504 reliable.
 505
 506 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
 507 MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
 508 (if applicable) may also be supported in the future.
 509
 510 =cut
 511
 512 sub sql_add_constraints {
 513   my $self = shift;
 514   my @fks = $self->foreign_keys_sql or return ();
 515   (
 516     'ALTER TABLE '. $self->name. ' '. join(",\n  ", map "ADD $_", @fks)
 517   );
 518 }
 519
 520 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 521
 522 Returns a list of SQL statements to alter this table so that it is identical
 523 to the provided table, also a DBIx::DBSchema::Table object.
 524
 525 The data source can be specified by passing an open DBI database handle, or by
 526 passing the DBI data source name, username and password.
 527
 528 Although the username and password are optional, it is best to call this method
 529 with a database handle or data source including a valid username and password -
 530 a DBI connection will be opened and used to check the database version as well
 531 as for more reliable quoting and type mapping.  Note that the database
 532 connection will be used passively, B<not> to actually run the CREATE
 533 statements.
 534
 535 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
 536 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 537 Currently supported databases are MySQL and PostgreSQL.
 538
 539 If not passed a data source (or handle), or if there is no driver for the
 540 specified database, will attempt to use generic SQL syntax.
 541
 542 =cut
 543
 544 #gosh, false laziness w/DBSchema::sql_update_schema
 545
 546 sub sql_alter_table {
 547   my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 548
 549   my $driver = _load_driver($dbh);
 550
 551   my $table = $self->name;
 552
 553   my @at = ();
 554   my @r = ();
 555   my @r_later = ();
 556   my $tempnum = 1;
 557
 558   ###
 559   # columns (add/alter)
 560   ###
 561
 562   foreach my $column ( $new->columns ) {
 563
 564     if ( $self->column($column) )  {
 565       warn "  $table.$column exists\n" if $DEBUG > 1;
 566
 567       my ($alter_table, $sql) =
 568         $self->column($column)->sql_alter_column( $new->column($column),
 569                                                   $dbh,
 570                                                   $opt,
 571                                                 );
 572       push @at, @$alter_table;
 573       push @r, @$sql;
 574
 575     } else {
 576       warn "column $table.$column does not exist.\n" if $DEBUG > 1;
 577
 578       my ($alter_table, $sql) = $new->column($column)->sql_add_column( $dbh );
 579       push @at, @$alter_table;
 580       push @r, @$sql;
 581
 582     }
 583
 584   }
 585
 586   ###
 587   # indices
 588   ###
 589
 590   my %old_indices = $self->indices;
 591   my %new_indices = $new->indices;
 592
 593   foreach my $old ( keys %old_indices ) {
 594
 595     if ( exists( $new_indices{$old} )
 596          && $old_indices{$old}->cmp( $new_indices{$old} )
 597        )
 598     {
 599       warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
 600       delete $old_indices{$old};
 601       delete $new_indices{$old};
 602
 603     } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
 604
 605       my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
 606                       keys %new_indices;
 607
 608       if ( @same ) {
 609
 610         #warn if there's more than one?
 611         my $same = shift @same;
 612
 613         warn "index $table.$old is identical to $same; renaming\n"
 614           if $DEBUG > 1;
 615
 616         my $temp = 'dbs_temp'.$tempnum++;
 617
 618         push @r, "ALTER INDEX $old RENAME TO $temp";
 619         push @r_later, "ALTER INDEX $temp RENAME TO $same";
 620
 621         delete $old_indices{$old};
 622         delete $new_indices{$same};
 623
 624       }
 625
 626     }
 627
 628   }
 629
 630   foreach my $old ( keys %old_indices ) {
 631     warn "removing obsolete index $table.$old ON ( ".
 632          $old_indices{$old}->columns_sql. " )\n"
 633       if $DEBUG > 1;
 634     push @r, 'DROP INDEX '.
 635              ( $driver ne 'mysql' ? ' IF EXISTS ' : '');
 636              " $old ".
 637              ( $driver eq 'mysql' ? " ON $table " : '');
 638   }
 639
 640   foreach my $new ( keys %new_indices ) {
 641     warn "creating new index $table.$new\n" if $DEBUG > 1;
 642     push @r, $new_indices{$new}->sql_create_index($table);
 643   }
 644
 645   ###
 646   # columns (drop)
 647   ###
 648
 649   foreach my $column ( grep !$new->column($_), $self->columns ) {
 650
 651     warn "column $table.$column should be dropped.\n" if $DEBUG;
 652
 653     push @at, $self->column($column)->sql_drop_column( $dbh );
 654
 655   }
 656
 657   ###
 658   # return the statements
 659   ###
 660
 661   unshift @r, "ALTER TABLE $table ". join(', ', @at) if @at;
 662
 663   push @r, @r_later;
 664
 665   warn join('', map "$_\n", @r)
 666     if $DEBUG && @r;
 667
 668   @r;
 669
 670 }
 671
 672 =item sql_alter_constraints PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 673
 674 Returns a list of SQL statements to alter this table's constraints (foreign
 675 keys) so that they are identical to the provided table, also a
 676 DBIx::DBSchema::Table object.
 677
 678 The data source can be specified by passing an open DBI database handle, or by
 679 passing the DBI data source name, username and password.
 680
 681 Although the username and password are optional, it is best to call this method
 682 with a database handle or data source including a valid username and password -
 683 a DBI connection will be opened and used to check the database version as well
 684 as for more reliable quoting and type mapping.  Note that the database
 685 connection will be used passively, B<not> to actually run the CREATE
 686 statements.
 687
 688 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
 689 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 690 Currently supported databases are MySQL and PostgreSQL.
 691
 692 If not passed a data source (or handle), or if there is no driver for the
 693 specified database, will attempt to use generic SQL syntax.
 694
 695 =cut
 696
 697 sub sql_alter_constraints {
 698   my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 699
 700   my $driver = _load_driver($dbh);
 701
 702   my $table = $self->name;
 703
 704   my @at = ();
 705
 706   # foreign keys (add)
 707   foreach my $foreign_key ( $new->foreign_keys ) {
 708
 709     next if grep $foreign_key->cmp($_), $self->foreign_keys;
 710
 711     push @at, 'ADD '. $foreign_key->sql_foreign_key;
 712   }
 713
 714   #foreign keys (drop)
 715   foreach my $foreign_key ( $self->foreign_keys ) {
 716
 717     next if grep $foreign_key->cmp($_), $new->foreign_keys;
 718     next unless $foreign_key->constraint;
 719
 720     push @at, 'DROP CONSTRAINT '. $foreign_key->constraint;
 721   }
 722
 723   return () unless @at;
 724   (
 725     'ALTER TABLE '. $self->name. ' '. join(",\n  ", @at)
 726   );
 727
 728 }
 729
 730 sub sql_drop_table {
 731   my( $self, $dbh ) = ( shift, _dbh(@_) );
 732
 733   my $name = $self->name;
 734
 735   ("DROP TABLE $name");
 736 }
 737
 738 =item foreign_keys_sql
 739
 740 =cut
 741
 742 sub foreign_keys_sql {
 743   my $self = shift;
 744   map $_->sql_foreign_key, $self->foreign_keys;
 745 }
 746
 747 =item foreign_keys
 748
 749 Returns a list of foreign keys (DBIx::DBSchema::ForeignKey objects).
 750
 751 =cut
 752
 753 sub foreign_keys {
 754   my $self = shift;
 755   exists( $self->{'foreign_keys'} )
 756     ? @{ $self->{'foreign_keys'} }
 757     : ();
 758 }
 759
 760
 761 sub _null_sth {
 762   my($dbh, $table) = @_;
 763   my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
 764     or die $dbh->errstr;
 765   $sth->execute or die $sth->errstr;
 766   $sth;
 767 }
 768
 769 =back
 770
 771 =head1 AUTHOR
 772
 773 Ivan Kohler <ivan-dbix-dbschema@420.am>
 774
 775 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
 776 with no indices.
 777
 778 =head1 COPYRIGHT
 779
 780 Copyright (c) 2000-2007 Ivan Kohler
 781 Copyright (c) 2000 Mail Abuse Prevention System LLC
 782 Copyright (c) 2007-2013 Freeside Internet Services, Inc.
 783 All rights reserved.
 784 This program is free software; you can redistribute it and/or modify it under
 785 the same terms as Perl itself.
 786
 787 =head1 BUGS
 788
 789 sql_create_table() has database-specific foo that probably ought to be
 790 abstracted into the DBIx::DBSchema::DBD:: modules (or no?  it doesn't anymore?).
 791
 792 sql_alter_table() also has database-specific foo that ought to be abstracted
 793 into the DBIx::DBSchema::DBD:: modules.
 794
 795 sql_create_table() may change or destroy the object's data.  If you need to use
 796 the object after sql_create_table, make a copy beforehand.
 797
 798 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
 799
 800 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
 801
 802 indices method should be a setter, not just a getter?
 803
 804 =head1 SEE ALSO
 805
 806 L<DBIx::DBSchema>, L<DBIx::DBSchema::Column>, L<DBI>,
 807 L<DBIx::DBSchema::Index>, L<DBIx::DBSchema::FoeignKey>
 808
 809 =cut
 810
 811 1;
 812