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 @at = ()
 627   my @r = ();
 628   my @r_later = ();
 629   my $tempnum = 1;
 630
 631   ###
 632   # columns (add/alter)
 633   ###
 634
 635   foreach my $column ( $new->columns ) {
 636
 637     if ( $self->column($column) )  {
 638       warn "  $table.$column exists\n" if $DEBUG > 1;
 639
 640       my ($alter_table, $sql) =
 641         $self->column($column)->sql_alter_column( $new->column($column),
 642                                                   $dbh,
 643                                                   $opt,
 644                                                 );
 645       push @at, @$alter_table;
 646       push @r, @$sql;
 647
 648     } else {
 649       warn "column $table.$column does not exist.\n" if $DEBUG > 1;
 650
 651       my ($alter_table, $sql) = $new->column($column)->sql_add_column( $dbh );
 652       push @at, @$alter_table;
 653       push @r, @$sql;
 654
 655     }
 656
 657   }
 658
 659   ###
 660   # indices
 661   ###
 662
 663   my %old_indices = $self->indices;
 664   my %new_indices = $new->indices;
 665
 666   foreach my $old ( keys %old_indices ) {
 667
 668     if ( exists( $new_indices{$old} )
 669          && $old_indices{$old}->cmp( $new_indices{$old} )
 670        )
 671     {
 672       warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
 673       delete $old_indices{$old};
 674       delete $new_indices{$old};
 675
 676     } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
 677
 678       my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
 679                       keys %new_indices;
 680
 681       if ( @same ) {
 682
 683         #warn if there's more than one?
 684         my $same = shift @same;
 685
 686         warn "index $table.$old is identical to $same; renaming\n"
 687           if $DEBUG > 1;
 688
 689         my $temp = 'dbs_temp'.$tempnum++;
 690
 691         push @r, "ALTER INDEX $old RENAME TO $temp";
 692         push @r_later, "ALTER INDEX $temp RENAME TO $same";
 693
 694         delete $old_indices{$old};
 695         delete $new_indices{$same};
 696
 697       }
 698
 699     }
 700
 701   }
 702
 703   foreach my $old ( keys %old_indices ) {
 704     warn "removing obsolete index $table.$old ON ( ".
 705          $old_indices{$old}->columns_sql. " )\n"
 706       if $DEBUG > 1;
 707     push @r, "DROP INDEX $old".
 708              ( $driver eq 'mysql' ? " ON $table" : '');
 709   }
 710
 711   foreach my $new ( keys %new_indices ) {
 712     warn "creating new index $table.$new\n" if $DEBUG > 1;
 713     push @r, $new_indices{$new}->sql_create_index($table);
 714   }
 715
 716   ###
 717   # columns (drop)
 718   ###
 719
 720   foreach my $column ( grep !$new->column($_), $self->columns ) {
 721
 722     warn "column $table.$column should be dropped.\n" if $DEBUG;
 723
 724     push @at, $self->column($column)->sql_drop_column( $dbh );
 725
 726   }
 727
 728   unshift @r, "ALTER TABLE $table ", join(', ', @at) if @at;
 729
 730   ###
 731   # return the statements
 732   ###
 733
 734   push @r, @r_later;
 735
 736   warn join('', map "$_\n", @r)
 737     if $DEBUG && @r;
 738
 739   @r;
 740
 741 }
 742
 743 sub sql_drop_table {
 744   my( $self, $dbh ) = ( shift, _dbh(@_) );
 745
 746   my $name = $self->name;
 747
 748   ("DROP TABLE $name");
 749 }
 750
 751 sub _null_sth {
 752   my($dbh, $table) = @_;
 753   my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
 754     or die $dbh->errstr;
 755   $sth->execute or die $sth->errstr;
 756   $sth;
 757 }
 758
 759 =back
 760
 761 =head1 AUTHOR
 762
 763 Ivan Kohler <ivan-dbix-dbschema@420.am>
 764
 765 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
 766 with no indices.
 767
 768 =head1 COPYRIGHT
 769
 770 Copyright (c) 2000-2007 Ivan Kohler
 771 Copyright (c) 2000 Mail Abuse Prevention System LLC
 772 Copyright (c) 2007-2013 Freeside Internet Services, Inc.
 773 All rights reserved.
 774 This program is free software; you can redistribute it and/or modify it under
 775 the same terms as Perl itself.
 776
 777 =head1 BUGS
 778
 779 sql_create_table() has database-specific foo that probably ought to be
 780 abstracted into the DBIx::DBSchema::DBD:: modules (or no?  it doesn't anymore?).
 781
 782 sql_alter_table() also has database-specific foo that ought to be abstracted
 783 into the DBIx::DBSchema::DBD:: modules.
 784
 785 sql_create_table() may change or destroy the object's data.  If you need to use
 786 the object after sql_create_table, make a copy beforehand.
 787
 788 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
 789
 790 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
 791
 792 indices method should be a setter, not just a getter?
 793
 794 =head1 SEE ALSO
 795
 796 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
 797 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
 798
 799 =cut
 800
 801 1;
 802