DBSchema/Table.pm

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