package DBIx::DBSchema::Table;
use strict;
-use vars qw($VERSION $DEBUG %create_params);
use Carp;
-#use Exporter;
-use DBIx::DBSchema::_util qw(_load_driver _dbh);
-use DBIx::DBSchema::Column 0.07;
+use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
+use DBIx::DBSchema::Column 0.14;
use DBIx::DBSchema::Index;
-use DBIx::DBSchema::ColGroup::Unique;
-use DBIx::DBSchema::ColGroup::Index;
+use DBIx::DBSchema::ForeignKey 0.13;
-$VERSION = '0.04';
-$DEBUG = 0;
+our $VERSION = '0.12';
+our $DEBUG = 0;
=head1 NAME
#new style (preferred), pass a hashref of parameters
$table = new DBIx::DBSchema::Table (
{
- name => "table_name",
- primary_key => "primary_key",
- columns => \@dbix_dbschema_column_objects,
+ name => "table_name",
+ primary_key => "primary_key",
+ columns => \@dbix_dbschema_column_objects,
#deprecated# unique => $dbix_dbschema_colgroup_unique_object,
#deprecated# 'index' => $dbix_dbschema_colgroup_index_object,
- indices => \@dbix_dbschema_index_objects,
+ indices => \@dbix_dbschema_index_objects,
+ foreign_keys => \@dbix_dbschema_foreign_key_objects,
}
);
hash reference of named parameters.
{
- name => TABLE_NAME,
- primary_key => PRIMARY_KEY,
- columns => COLUMNS,
- indices => INDICES,
- #deprecated# unique => UNIQUE,
- #deprecated# index => INDEX,
+ name => TABLE_NAME,
+ primary_key => PRIMARY_KEY,
+ columns => COLUMNS,
+ indices => INDICES,
+ local_options => OPTIONS,
}
-TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
-empty). COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
-(see L<DBIx::DBSchema::Column>). INDICES is a reference to an array of
-DBIx::DBSchema::Index objects (see L<DBIx::DBSchema::Index>), or a hash
-reference of index names (keys) and DBIx::DBSchema::Index objects (values).
+TABLE_NAME is the name of the table.
-Deprecated options:
+PRIMARY_KEY is the primary key (may be empty).
-UNIQUE was a DBIx::DBSchema::ColGroup::Unique object (see
-L<DBIx::DBSchema::ColGroup::Unique>). INDEX was a
-DBIx::DBSchema::ColGroup::Index object (see
-L<DBIx::DBSchema::ColGroup::Index>).
+COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
+(see L<DBIx::DBSchema::Column>).
+
+INDICES is a reference to an array of DBIx::DBSchema::Index objects
+(see L<DBIx::DBSchema::Index>), or a hash reference of index names (keys) and
+DBIx::DBSchema::Index objects (values).
+
+FOREIGN_KEYS is a references to an array of DBIx::DBSchema::ForeignKey objects
+(see L<DBIx::DBSchema::ForeignKey>).
+
+OPTIONS is a scalar of database-specific table options, such as "WITHOUT OIDS"
+for Pg or "TYPE=InnoDB" for mysql.
=cut
$self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
if ref($self->{indices}) eq 'ARRAY';
+ $self->{foreign_keys} ||= [];
+
} else {
carp "Old-style $class creation without named parameters is deprecated!";
'index' => $index,
'columns' => \%columns,
'column_order' => \@column_order,
+ 'foreign_keys' => [],
};
}
=cut
-%create_params = (
+our %create_params = (
# undef => sub { '' },
'' => sub { '' },
'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
],
- #old-style indices
- #DBIx::DBSchema::ColGroup::Unique->new(
- # $driver
- # ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
- # : []
- #),
- #DBIx::DBSchema::ColGroup::Index->new(
- # $driver
- # ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
- # : []
- #),
-
- #new-style indices
+ #indices
'indices' => { map { my $indexname = $_;
$indexname =>
DBIx::DBSchema::Index->new($indices_hr->{$indexname})
my( $proto, $dbh, $name) = @_;
my $driver = _load_driver($dbh);
+ my $primary_key =
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+
my $indices_hr =
( $driver
? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
);
$proto->new({
- 'name' => $name,
- 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
- 'columns' => [
-
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+
+ 'columns' => [
map DBIx::DBSchema::Column->new( @{$_} ),
eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
],
- #old-style indices
- #DBIx::DBSchema::ColGroup::Unique->new(
- # [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
- #),
- #DBIx::DBSchema::ColGroup::Index->new(
- # [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
- #),
-
- #new-style indices
'indices' => { map { my $indexname = $_;
$indexname =>
DBIx::DBSchema::Index->new($indices_hr->{$indexname})
keys %$indices_hr
},
+ 'foreign_keys' => [
+ map DBIx::DBSchema::ForeignKey->new( $_ ),
+ eval "DBIx::DBSchema::DBD::$driver->constraints(\$dbh, \$name)"
+ ],
+
+
});
}
}
}
+=item local_options [ OPTIONS ]
+
+Returns or sets the database-specific table options string.
+
+=cut
+
+sub local_options {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{local_options} = $value;
+ } else {
+ defined $self->{local_options} ? $self->{local_options} : '';
+ }
+}
+
=item primary_key [ PRIMARY_KEY ]
Returns or sets the primary key.
}
}
-=item unique [ UNIQUE ]
-
-This method is deprecated and included for backwards-compatibility only.
-See L</indices> for the current method to access unique and non-unique index
-objects.
-
-Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
-
-=cut
-
-sub unique {
- my($self,$value)=@_;
-
- carp ref($self). "->unique method is deprecated; see ->indices";
- #croak ref($self). "->unique method is deprecated; see ->indices";
-
- if ( defined($value) ) {
- $self->{unique} = $value;
- } else {
- $self->{unique};
- }
-}
-
-=item index [ INDEX ]
-
-This method is deprecated and included for backwards-compatibility only.
-See L</indices> for the current method to access unique and non-unique index
-objects.
-
-Returns or sets the DBIx::DBSchema::ColGroup::Index object.
-
-=cut
-
-sub index {
- my($self,$value)=@_;
-
- carp ref($self). "->index method is deprecated; see ->indices";
- #croak ref($self). "->index method is deprecated; see ->indices";
-
- if ( defined($value) ) {
- $self->{'index'} = $value;
- } else {
- $self->{'index'};
- }
-}
-
=item columns
Returns a list consisting of the names of all columns.
$self->{'columns'}->{$column};
}
-=item indices COLUMN_NAME
+=item indices
Returns a list of key-value pairs suitable for assigning to a hash. Keys are
index names, and values are index objects (see L<DBIx::DBSchema::Index>).
: ();
}
+=item unique_singles
+
+Meet exciting and unique singles using this method!
+
+This method returns a list of column names that are indexed with their own,
+unique, non-compond (that's the "single" part) indices.
+
+=cut
+
+sub unique_singles {
+ my $self = shift;
+ my %indices = $self->indices;
+
+ map { ${ $indices{$_}->columns }[0] }
+ grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
+ keys %indices;
+}
+
=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
Returns a list of SQL statments to create this table.
-Optionally, the data source can be specified by passing an open DBI database
-handle, or by passing the DBI data source name, username and password.
-
The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.
push @columns, "PRIMARY KEY (". $self->primary_key. ")"
if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
+# push @columns, $self->foreign_keys_sql;
+
my $indexnum = 1;
my @r = (
- "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
+ "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n".
+ $self->local_options
);
- if ( $self->unique ) {
-
- warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
- " table has deprecated (non-named) unique indices\n";
-
- push @r, map {
- #my($index) = $self->name. "__". $_ . "_idx";
- #$index =~ s/,\s*/_/g;
- my $index = $self->name. $indexnum++;
- "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
- } $self->unique->sql_list;
-
- }
-
- if ( $self->index ) {
-
- warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
- " table has deprecated (non-named) indices\n";
-
- push @r, map {
- #my($index) = $self->name. "__". $_ . "_idx";
- #$index =~ s/,\s*/_/g;
- my $index = $self->name. $indexnum++;
- "CREATE INDEX $index ON ". $self->name. " ($_)\n"
- } $self->index->sql_list;
- }
-
my %indices = $self->indices;
#push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
foreach my $index ( keys %indices ) {
@r;
}
+=item sql_add_constraints [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statments to add constraints (foreign keys) to this table.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
+MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
+(if applicable) may also be supported in the future.
+
+=cut
+
+sub sql_add_constraints {
+ my $self = shift;
+ my @fks = $self->foreign_keys_sql or return ();
+ (
+ 'ALTER TABLE '. $self->name. ' '. join(",\n ", map "ADD $_", @fks)
+ );
+}
+
=item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
Returns a list of SQL statements to alter this table so that it is identical
to the provided table, also a DBIx::DBSchema::Table object.
- #Optionally, the data source can be specified by passing an open DBI database
- #handle, or by passing the DBI data source name, username and password.
- #
- #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
- #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
- #applicable) may also be supported in the future.
- #
- #If not passed a data source (or handle), or if there is no driver for the
- #specified database, will attempt to use generic SQL syntax.
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and used to check the database version as well
+as for more reliable quoting and type mapping. Note that the database
+connection will be used passively, B<not> to actually run the CREATE
+statements.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL.
+
+If not passed a data source (or handle), or if there is no driver for the
+specified database, will attempt to use generic SQL syntax.
=cut
#gosh, false laziness w/DBSchema::sql_update_schema
sub sql_alter_table {
- my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+ my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
my $driver = _load_driver($dbh);
my $table = $self->name;
+ my @at = ();
my @r = ();
my @r_later = ();
my $tempnum = 1;
###
- # columns
+ # columns (add/alter)
###
foreach my $column ( $new->columns ) {
if ( $self->column($column) ) {
-
warn " $table.$column exists\n" if $DEBUG > 1;
- push @r,
- $self->column($column)->sql_alter_column( $new->column($column), $dbh );
+ my ($alter_table, $sql) =
+ $self->column($column)->sql_alter_column( $new->column($column),
+ $dbh,
+ $opt,
+ );
+ push @at, @$alter_table;
+ push @r, @$sql;
} else {
-
warn "column $table.$column does not exist.\n" if $DEBUG > 1;
- push @r,
- $new->column($column)->sql_add_column( $dbh );
+ my ($alter_table, $sql) = $new->column($column)->sql_add_column( $dbh );
+ push @at, @$alter_table;
+ push @r, @$sql;
}
}
- #should eventually drop columns not in $new...
-
###
# indices
###
warn "removing obsolete index $table.$old ON ( ".
$old_indices{$old}->columns_sql. " )\n"
if $DEBUG > 1;
- push @r, "DROP INDEX $old".
- ( $driver eq 'mysql' ? " ON $table" : '');
+ push @r, "DROP INDEX $old ".
+ ( $driver eq 'mysql' ? " ON $table" : ' IF EXISTS');
}
foreach my $new ( keys %new_indices ) {
warn "creating new index $table.$new\n" if $DEBUG > 1;
push @r, $new_indices{$new}->sql_create_index($table);
}
-
+
+ ###
+ # columns (drop)
+ ###
+
+ foreach my $column ( grep !$new->column($_), $self->columns ) {
+
+ warn "column $table.$column should be dropped.\n" if $DEBUG;
+
+ push @at, $self->column($column)->sql_drop_column( $dbh );
+
+ }
+
###
# return the statements
###
-
+
+ unshift @r, "ALTER TABLE $table ". join(', ', @at) if @at;
+
push @r, @r_later;
warn join('', map "$_\n", @r)
}
+=item sql_alter_constraints PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statements to alter this table's constraints (foreign
+keys) so that they are identical to the provided table, also a
+DBIx::DBSchema::Table object.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and used to check the database version as well
+as for more reliable quoting and type mapping. Note that the database
+connection will be used passively, B<not> to actually run the CREATE
+statements.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database' or
+`DBI:Pg:dbname=database', will use syntax specific to that database engine.
+Currently supported databases are MySQL and PostgreSQL.
+
+If not passed a data source (or handle), or if there is no driver for the
+specified database, will attempt to use generic SQL syntax.
+
+=cut
+
+sub sql_alter_constraints {
+ my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
+
+ my $driver = _load_driver($dbh);
+
+ my $table = $self->name;
+
+ my @at = ();
+
+ # foreign keys (add)
+ foreach my $foreign_key ( $new->foreign_keys ) {
+
+ next if grep $foreign_key->cmp($_), $self->foreign_keys;
+
+ push @at, 'ADD '. $foreign_key->sql_foreign_key;
+ }
+
+ #foreign keys (drop)
+ foreach my $foreign_key ( $self->foreign_keys ) {
+
+ next if grep $foreign_key->cmp($_), $new->foreign_keys;
+ next unless $foreign_key->constraint;
+
+ push @at, 'DROP CONSTRAINT '. $foreign_key->constraint;
+ }
+
+ return () unless @at;
+ (
+ 'ALTER TABLE '. $self->name. ' '. join(",\n ", @at)
+ );
+
+}
+
+sub sql_drop_table {
+ my( $self, $dbh ) = ( shift, _dbh(@_) );
+
+ my $name = $self->name;
+
+ ("DROP TABLE $name");
+}
+
+=item foreign_keys_sql
+
+=cut
+
+sub foreign_keys_sql {
+ my $self = shift;
+ map $_->sql_foreign_key, $self->foreign_keys;
+}
+
+=item foreign_keys
+
+Returns a list of foreign keys (DBIx::DBSchema::ForeignKey objects).
+
+=cut
+
+sub foreign_keys {
+ my $self = shift;
+ exists( $self->{'foreign_keys'} )
+ ? @{ $self->{'foreign_keys'} }
+ : ();
+}
+
+
sub _null_sth {
my($dbh, $table) = @_;
my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
Copyright (c) 2000-2007 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
-Copyright (c) 2007 Freeside Internet Services, Inc.
+Copyright (c) 2007-2013 Freeside Internet Services, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
Some of the logic in new_odbc might be better abstracted into Column.pm etc.
-sql_alter_table ought to drop columns not in $new
-
Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
indices method should be a setter, not just a getter?
=head1 SEE ALSO
-L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
-L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
+L<DBIx::DBSchema>, L<DBIx::DBSchema::Column>, L<DBI>,
+L<DBIx::DBSchema::Index>, L<DBIx::DBSchema::FoeignKey>
=cut
projects / DBIx-DBSchema.git / blobdiff