Revision history for Perl extension DBIx::DBSchema.
0.33 unreleased
- - DBSchema::DBD::SQLite SERIAL patch from IN SUK JOUNG
- <i.joung@gmail.com>, thanks!
- - Fix for mis-application of above patch from Slaven Rezic
+ - Overhaul of index representation: indices (both normal and unique)
+ are now named DBSchema::Index objects
+ - update_schema now handles indices!
+ - Bump version numbers in Table.pm, Column.pm and DBD.pm
+ - Pg reverse-engineering fix for column order in multi-column indices,
+ to prevent needless drop/add of identical indices
+ - mysql reverse-engineering patch from Brian Phillips
+ <bphillips@cpan.org>, closes: CPAN#17582, thanks!
+ - mysql NAME vs NAME_lc patch from Ralf Hack <ralf@beetlecraft.net>,
+ closes: CPAN#16715, thanks!
+ - mysql fix for additional column data from Chris Mungall
+ <cjm@fruitfly.org>, closes: CPAN#20859, thanks!
+ - SQLite SERIAL patch from IN SUK JOUNG <i.joung@gmail.com>, and fix
+ for mis-application of said patch from Slaven Rezic
<srezic@cpan.org>, thanks!
- Update README wrt current CVS info and URL, closes: CPAN#27577
package DBIx::DBSchema;
use strict;
-use vars qw(@ISA $VERSION $DEBUG $errstr);
-#use Exporter;
+use vars qw($VERSION $DEBUG $errstr);
use Storable;
use DBIx::DBSchema::_util qw(_load_driver _dbh);
-use DBIx::DBSchema::Table 0.03;
+use DBIx::DBSchema::Table 0.04;
+use DBIx::DBSchema::Index;
use DBIx::DBSchema::Column;
use DBIx::DBSchema::ColGroup::Unique;
use DBIx::DBSchema::ColGroup::Index;
-#@ISA = qw(Exporter);
-@ISA = ();
+$VERSION = "0.33_01";
+$VERSION = eval $VERSION; # modperlstyle: convert the string into a number
-$VERSION = "0.32";
$DEBUG = 0;
=head1 NAME
This module implements an OO-interface to database schemas. Using this module,
you can create a database schema with an OO Perl interface. You can read the
schema from an existing database. You can save the schema to disk and restore
-it a different process. You can write SQL CREATE statements statements for
+it in a different process. You can write SQL CREATE statements statements for
different databases from a single source. In recent versions, you can
-transform one schema to another, adding any necessary new columsn and tables.
+transform one schema to another, adding any necessary new columns and tables
+(and, as of 0.33, indices).
Currently supported databases are MySQL, PostgreSQL and SQLite. Sybase and
Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use
sub pretty_print {
my($self) = @_;
+
join("},\n\n",
map {
- my $table = $_;
- "'$table' => {\n".
+ my $tablename = $_;
+ my $table = $self->table($tablename);
+ my %indices = $table->indices;
+
+ "'$tablename' => {\n".
" 'columns' => [\n".
join("", map {
#cant because -w complains about , in qw()
# (also biiiig problems with empty lengths)
#" qw( $_ ".
- #$self->table($table)->column($_)->type. " ".
- #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ".
- #$self->table($table)->column($_)->length. " ),\n"
+ #$table->column($_)->type. " ".
+ #( $table->column($_)->null ? 'NULL' : 0 ). " ".
+ #$table->column($_)->length. " ),\n"
" '$_', ".
- "'". $self->table($table)->column($_)->type. "', ".
- "'". $self->table($table)->column($_)->null. "', ".
- "'". $self->table($table)->column($_)->length. "', ".
- "'". $self->table($table)->column($_)->default. "', ".
- "'". $self->table($table)->column($_)->local. "',\n"
- } $self->table($table)->columns
+ "'". $table->column($_)->type. "', ".
+ "'". $table->column($_)->null. "', ".
+ "'". $table->column($_)->length. "', ".
+ "'". $table->column($_)->default. "', ".
+ "'". $table->column($_)->local. "',\n"
+ } $table->columns
).
" ],\n".
- " 'primary_key' => '". $self->table($table)->primary_key. "',\n".
- " 'unique' => [ ". join(', ',
- map { "[ '". join("', '", @{$_}). "' ]" }
- @{$self->table($table)->unique->lol_ref}
- ). " ],\n".
- " 'index' => [ ". join(', ',
- map { "[ '". join("', '", @{$_}). "' ]" }
- @{$self->table($table)->index->lol_ref}
- ). " ],\n"
- #" 'index' => [ ". " ],\n"
+ " 'primary_key' => '". $table->primary_key. "',\n".
+
+ #old style index representation..
+
+ (
+ $table->{'unique'} # $table->unique
+ ? " 'unique' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$table->unique->lol_ref}
+ ). " ],\n"
+ : ''
+ ).
+
+ ( $table->{'index'} # $table->index
+ ? " 'index' => [ ". join(', ',
+ map { "[ '". join("', '", @{$_}). "' ]" }
+ @{$table->index->lol_ref}
+ ). " ],\n"
+ : ''
+ ).
+
+ #new style indices
+ " 'indices' => { ". join( ",\n ",
+
+ map { my $iname = $_;
+ my $index = $indices{$iname};
+ "'$iname' => { \n".
+ ( $index->using
+ ? " 'using' => '". $index->using ."',\n"
+ : ''
+ ).
+ " 'unique' => ". $index->unique .",\n".
+ " 'columns' => [ '".
+ join("', '", @{$index->columns} ).
+ "' ],\n".
+ " },\n";
+ }
+ keys %indices
+
+ ). "\n }, \n"
+
} $self->tables
). "}\n";
}
sub pretty_read {
my($proto, $href) = @_;
+
my $schema = $proto->new( map {
- my(@columns);
- while ( @{$href->{$_}{'columns'}} ) {
+
+ my $tablename = $_;
+ my $info = $href->{$tablename};
+
+ my @columns;
+ while ( @{$info->{'columns'}} ) {
push @columns, DBIx::DBSchema::Column->new(
- splice @{$href->{$_}{'columns'}}, 0, 6
+ splice @{$info->{'columns'}}, 0, 6
);
}
- DBIx::DBSchema::Table->new(
- $_,
- $href->{$_}{'primary_key'},
- DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}),
- DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}),
- @columns,
- );
+
+ DBIx::DBSchema::Table->new({
+ 'name' => $tablename,
+ 'primary_key' => $info->{'primary_key'},
+ 'columns' => \@columns,
+
+ #old-style indices
+ 'unique' => DBIx::DBSchema::ColGroup::Unique->new($info->{'unique'}),
+ 'index' => DBIx::DBSchema::ColGroup::Index->new($info->{'index'}),
+
+ #new-style indices
+ 'indices' => [ map { my $idx_info = $info->{'indices'}{$_};
+ DBIx::DBSchema::Index->new({
+ 'name' => $_,
+ #'using' =>
+ 'unique' => $idx_info->{'unique'},
+ 'columns' => $idx_info->{'columns'},
+ });
+ }
+ keys %{ $info->{'indices'} }
+ ],
+ } );
+
} (keys %{$href}) );
+
}
# private subroutines
=head1 CONTRIBUTIONS
-Contributions are welcome! I'm especially keen on any interest in the first
-three items/projects below under BUGS.
+Contributions are welcome! I'm especially keen on any interest in the top
+items/projects below under BUGS.
=head1 COPYRIGHT
-Copyright (c) 2000-2006 Ivan Kohler
+Copyright (c) 2000-2007 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2007 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.
-=head1 BUGS
-
-Indices are not stored by name. Index representation could use an overhaul.
+=head1 BUGS AND TODO
Multiple primary keys are not yet supported.
Foreign keys and other constraints are not yet supported.
Eventually it would be nice to have additional transformations (deleted,
-modified columns, added/modified/indices (probably need em named first),
-added/deleted tables
+modified columns, deleted tables). sql_update_schema doesn't drop tables
+or deal with deleted or modified columns yet.
Need to port and test with additional databases
+On schema updates, index changes are not as efficent as they could be,
+especially with large data sets. Specifically, we don't currently recognize
+existing indices with different/"wrong" names that we could use "ALTER INDEX
+name RENAME TO new_name" on, and instead drop the "wrongly named" index and
+re-build a new one. Since these are indices and not columns, its not a huge
+deal, everything turns out right in the end, though inefficient.
+
Each DBIx::DBSchema object should have a name which corresponds to its name
within the SQL database engine (DBI data source).
pretty_print is actually pretty ugly.
+pretty_print isn't so good about quoting values... save/load is a much better
+alternative to using pretty_print/pretty_read
+
+pretty_read is pretty ugly too.
+
+pretty_read should *not* create and pass in old-style unique/index indices
+when nothing is given in the read.
+
Perhaps pretty_read should eval column types so that we can use DBI
qw(:sql_types) here instead of externally.
+Need to support "using" index attribute in pretty_read and in reverse
+engineering
+
+perhaps we should just get rid of pretty_read entirely. pretty_print is useful
+for debugging, but pretty_read is pretty bunk.
+
sql CREATE TABLE output should convert integers
(i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
to fudge things
-sql_update_schema doesn't drop tables yet.
-
=head1 SEE ALSO
-L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,
-L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::Index>,
L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
L<DBI>
package DBIx::DBSchema::ColGroup;
use strict;
-use vars qw(@ISA);
-#use Exporter;
-
-#@ISA = qw(Exporter);
-@ISA = qw();
+use Carp;
=head1 NAME
=head1 DESCRIPTION
+This class is deprecated and included for backwards-compatibility only.
+See L<DBIx::DBSchema::Index> for the current class used to store unique
+and non-unique indices.
+
DBIx::DBSchema::ColGroup objects represent sets of sets of columns. (IOW a
"list of lists" - see L<perllol>.)
my($proto, $lol) = @_;
my $class = ref($proto) || $proto;
+
+ carp "WARNING: $proto is deprecated; switch to DBIx::DBSchema::Index";
+
my $self = {
'lol' => $lol,
};
=head1 SEE ALSO
-L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup::Unique>,
-L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema>, L<perllol>, L<perldsc>,
-L<DBI>
+L<DBIx::DBSchema::Index>, L<DBIx::DBSchema::Table>,
+L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema>, L<perllol>, L<perldsc>, L<DBI>
=cut
=head1 DESCRIPTION
+This class is deprecated and included for backwards-compatibility only.
+See L<DBIx::DBSchema::Index> for the current class used to store unique
+and non-unique indices.
+
DBIx::DBSchema::ColGroup::Index objects represent the (non-unique) indices of a
database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup::Index
inherits from DBIx::DBSchema::ColGroup.
-=head1 BUGS
-
-Is this empty subclass needed?
-
=head1 SEE ALSO
L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Unique>,
=head1 DESCRIPTION
+This class is deprecated and included for backwards-compatibility only.
+See L<DBIx::DBSchema::Index> for the current class used to store unique
+and non-unique indices.
+
DBIx::DBSchema::ColGroup::Unique objects represent the unique indices of a
database table (L<DBIx::DBSchema::Table>). DBIx::DBSchema::ColGroup:Unique
inherits from DBIx::DBSchema::ColGroup.
-=head1 BUGS
-
-Is this empty subclass needed?
-
=head1 SEE ALSO
L<DBIx::DBSchema::ColGroup>, L<DBIx::DBSchema::ColGroup::Index>,
package DBIx::DBSchema::Column;
use strict;
-use vars qw(@ISA $VERSION);
-#use Carp;
-#use Exporter;
+use vars qw($VERSION);
+use Carp;
use DBIx::DBSchema::_util qw(_load_driver _dbh);
-#@ISA = qw(Exporter);
-@ISA = qw();
-
-$VERSION = '0.08';
+$VERSION = '0.09';
=head1 NAME
if ( ref($_[0]) ) {
$self = shift;
} else {
+ #carp "Old-style $class creation without named parameters is deprecated!";
+ #croak "FATAL: old-style $class creation no longer supported;".
+ # " use named parameters";
+
$self = { map { $_ => shift } qw(name type null length default local) };
}
=head1 BUGS
+The new() method should warn that
+"Old-style $class creation without named parameters is deprecated!"
+
Better documentation is needed for sql_add_column
line() and sql_add_column() hav database-specific foo that should be abstracted
use strict;
use vars qw($VERSION);
-$VERSION = '0.03';
+$VERSION = '0.04';
=head1 NAME
=item unique CLASS DBI_DBH TABLE
+Deprecated method - see the B<indices> method for new drivers.
+
Given an active DBI database handle, return a hashref of unique indices. The
keys of the hashref are index names, and the values are arrayrefs which point
a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
-L<DBIx::DBSchema::ColGroup>.
+L<DBIx::DBSchema::Index>.
=item index CLASS DBI_DBH TABLE
+Deprecated method - see the B<indices> method for new drivers.
+
Given an active DBI database handle, return a hashref of (non-unique) indices.
The keys of the hashref are index names, and the values are arrayrefs which
point a list of column names for each. See L<perldsc/"HASHES OF LISTS"> and
-L<DBIx::DBSchema::ColGroup>.
+L<DBIx::DBSchema::Index>.
+
+=item indices CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of all indices, both
+unique and non-unique. The keys of the hashref are index names, and the values
+are again hashrefs with the following keys:
+
+=over 8
+
+=item name - Index name (redundant)
+
+=item using - Optional index method
+
+=item unique - Boolean indicating whether or not this is a unique index
+
+=item columns - List reference of column names (or expressions)
+
+=back
+
+(See L<FS::DBIx::DBSchema::Index>)
+
+New drivers are advised to implement this method, and existing drivers are
+advised to (eventually) provide this method instead of B<index> and B<unique>.
+
+For backwards-compatibility with current drivers, the base DBIx::DBSchema::DBD
+class provides an B<indices> method which uses the old B<index> and B<unique>
+methods to provide this data.
+
+=cut
+
+sub indices {
+ #my($proto, $dbh, $table) = @_;
+ my($proto, @param) = @_;
+
+ my $unique_hr = $proto->unique( @param );
+ my $index_hr = $proto->index( @param );
+
+ my $gratuitous_hashref_to_force_scalar_context =
+ {
+
+ (
+ map {
+ $_ => { 'name' => $_,
+ 'unique' => 1,
+ 'columns' => $unique_hr->{$_},
+ },
+ }
+ keys %$unique_hr
+ ),
+
+ (
+ map {
+ $_ => { 'name' => $_,
+ 'unique' => 0,
+ 'columns' => $index_hr->{$_},
+ },
+ }
+ keys %$index_hr
+ ),
+
+ };
+
+}
=item default_db_catalog
=head1 SEE ALSO
L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>,
-L<DBIx::DBSchema::
ColGroup>, L<DBI>, L<DBI::DBD>, L<perllol>,
+L<DBIx::DBSchema::
Index>, L<DBI>, L<DBI::DBD>, L<perllol>,
L<perldsc/"HASHES OF LISTS">
=cut
use DBD::Pg 1.32;
use DBIx::DBSchema::DBD;
-$VERSION = '0.10';
+$VERSION = '0.11';
@ISA = qw(DBIx::DBSchema::DBD);
die "DBD::Pg version 1.32 or 1.41 (or later) required--".
FROM pg_class c, pg_attribute a, pg_type t
WHERE c.relname = '$index'
AND a.attnum > 0 AND a.attrelid = c.oid AND a.atttypid = t.oid
+ ORDER BY a.attnum
END
$sth->execute or die $sth->errstr;
map { $_->{'attname'} } @{ $sth->fetchall_arrayref({}) };
package DBIx::DBSchema::Table;
use strict;
-use vars qw(@ISA $VERSION $DEBUG %create_params);
-#use Carp;
+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::Index;
use DBIx::DBSchema::ColGroup::Unique;
use DBIx::DBSchema::ColGroup::Index;
-#@ISA = qw(Exporter);
-@ISA = qw();
-
-$VERSION = '0.03';
+$VERSION = '0.04';
$DEBUG = 0;
=head1 NAME
use DBIx::DBSchema::Table;
- #old style (depriciated)
- $table = new DBIx::DBSchema::Table (
- "table_name",
- "primary_key",
- $dbix_dbschema_colgroup_unique_object,
- $dbix_dbschema_colgroup_index_object,
- @dbix_dbschema_column_objects,
- );
-
#new style (preferred), pass a hashref of parameters
$table = new DBIx::DBSchema::Table (
{
name => "table_name",
primary_key => "primary_key",
- unique => $dbix_dbschema_colgroup_unique_object,
- 'index' => $dbix_dbschema_colgroup_index_object,
columns => \@dbix_dbschema_column_objects,
+ #deprecated# unique => $dbix_dbschema_colgroup_unique_object,
+ #deprecated# 'index' => $dbix_dbschema_colgroup_index_object,
+ indices => \@dbix_dbschema_index_objects,
}
);
+ #old style (VERY deprecated)
+ $table = new DBIx::DBSchema::Table (
+ "table_name",
+ "primary_key",
+ $dbix_dbschema_colgroup_unique_object,
+ $dbix_dbschema_colgroup_index_object,
+ @dbix_dbschema_column_objects,
+ );
+
$table->addcolumn ( $dbix_dbschema_column_object );
$table_name = $table->name;
$primary_key = $table->primary_key;
$table->primary_key("primary_key");
- $dbix_dbschema_colgroup_unique_object = $table->unique;
- $table->unique( $dbix_dbschema__colgroup_unique_object );
+ #deprecated# $dbix_dbschema_colgroup_unique_object = $table->unique;
+ #deprecated# $table->unique( $dbix_dbschema__colgroup_unique_object );
- $dbix_dbschema_colgroup_index_object = $table->index;
- $table->index( $dbix_dbschema_colgroup_index_object );
+ #deprecated# $dbix_dbschema_colgroup_index_object = $table->index;
+ #deprecated# $table->index( $dbix_dbschema_colgroup_index_object );
+
+ %indices = $table->indices;
+ $dbix_dbschema_index_object = $indices{'index_name'};
+ @all_index_names = keys %indices;
+ @all_dbix_dbschema_index_objects = values %indices;
@column_names = $table->columns;
=over 4
-=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
-
=item new HASHREF
Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
{
name => TABLE_NAME,
primary_key => PRIMARY_KEY,
- unique => UNIQUE,
- 'index' => INDEX,
- columns => COLUMNS
+ columns => COLUMNS,
+ indices => INDICES,
+ #deprecated# unique => UNIQUE,
+ #deprecated# index => INDEX,
}
TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
-empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
-L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
+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).
+
+Deprecated options:
+
+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>).
+L<DBIx::DBSchema::ColGroup::Index>).
=cut
$self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
$self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
+ $self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
+ if ref($self->{indices}) eq 'ARRAY';
+
} else {
+ carp "Old-style $class creation without named parameters is deprecated!";
+ #croak "FATAL: old-style $class creation no longer supported;".
+ # " use named parameters";
+
my($name,$primary_key,$unique,$index,@columns) = @_;
my %columns = map { $_->name, $_ } @columns;
sub new_odbc {
my( $proto, $dbh, $name) = @_;
+
my $driver = _load_driver($dbh);
my $sth = _null_sth($dbh, $name);
my $sthpos = 0;
- $proto->new (
- $name,
- scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
- 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)"} ]
- : []
- ),
- map {
- my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
- or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
- "returned no results for type ". $sth->{TYPE}->[$sthpos];
- new DBIx::DBSchema::Column
- $_,
- $type_info->{'TYPE_NAME'},
- #"SQL_". uc($type_info->{'TYPE_NAME'}),
- $sth->{NULLABLE}->[$sthpos],
- &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
- ${ [
- eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
- ] }[4]
- # DB-local
- } @{$sth->{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' => [
+
+ map {
+
+ my $col_name = $_;
+
+ my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
+ or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
+ "returned no results for type ". $sth->{TYPE}->[$sthpos];
+
+ my $length = &{ $create_params{ $type_info->{CREATE_PARAMS} } }
+ ( $sth, $sthpos++ );
+
+ my $default = '';
+ if ( $driver ) {
+ $default = ${ [
+ eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
+ ] }[4];
+ }
+
+ DBIx::DBSchema::Column->new({
+ 'name' => $col_name,
+ #'type' => "SQL_". uc($type_info->{'TYPE_NAME'}),
+ 'type' => $type_info->{'TYPE_NAME'},
+ 'null' => $sth->{NULLABLE}->[$sthpos],
+ 'length' => $length,
+ 'default' => $default,
+ #'local' => # DB-local
+ });
+
+ }
+ @{$sth->{NAME}}
+
+ ],
+
+ #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' => { map { my $indexname = $_;
+ $indexname =>
+ DBIx::DBSchema::Index->new($indices_hr->{$indexname})
+ }
+ keys %$indices_hr
+ },
+
+ });
}
=item new_native DATABASE_HANDLE TABLE_NAME
sub new_native {
my( $proto, $dbh, $name) = @_;
my $driver = _load_driver($dbh);
- $proto->new (
- $name,
- scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
- 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)"} ]
- ),
- map {
- DBIx::DBSchema::Column->new( @{$_} )
- } eval "DBIx::DBSchema::DBD::$driver->columns(\$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' => [
+
+ 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
+ },
+
+ });
}
=item addcolumn COLUMN
=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 {
=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->{'columns'}->{$column};
}
+=item indices COLUMN_NAME
+
+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>).
+
+=cut
+
+sub indices {
+ my $self = shift;
+ exists( $self->{'indices'} )
+ ? %{ $self->{'indices'} }
+ : ();
+}
+
=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
Returns a list of SQL statments to create this table.
"CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\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->unique;
-
- 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
- if $self->index;
+ 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 ) {
+ push @r, $indices{$index}->sql_create_index( $self->name );
+ }
#$self->primary_key($saved_pkey) if $saved_pkey;
@r;
sub sql_alter_table {
my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+ my $driver = _load_driver($dbh);
+
my $table = $self->name;
my @r = ();
+ ###
+ # columns
+ ###
+
foreach my $column ( $new->columns ) {
if ( $self->column($column) ) {
- warn " $table.$column exists\n" if $DEBUG > 2;
+ warn " $table.$column exists\n" if $DEBUG > 1;
push @r,
$self->column($column)->sql_alter_column( $new->column($column), $dbh );
} else {
- warn "column $table.$column does not exist.\n" if $DEBUG;
+ warn "column $table.$column does not exist.\n" if $DEBUG > 1;
push @r,
$new->column($column)->sql_add_column( $dbh );
}
}
+
+ #should eventually drop columns not in $new...
- #should eventually check & create missing indices ( & delete ones not in $new)
+ ###
+ # indices
+ ###
+
+ my %old_indices = $self->indices;
+ my %new_indices = $new->indices;
+
+ foreach my $old ( keys %old_indices ) {
+
+ if ( exists( $new_indices{$old} )
+ && $old_indices{$old}->cmp( $new_indices{$old} )
+ )
+ {
+ warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
+ delete $old_indices{$old};
+ delete $new_indices{$old};
+ }
+
+ }
+
+ foreach my $old ( keys %old_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" : '');
+ }
+
+ 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);
+ }
- #should eventually drop columns not in $new
+ ###
+ # return the statements
+ ###
- warn join("\n", @r). "\n"
- if $DEBUG;
+ warn join('', map "$_\n", @r)
+ if $DEBUG && @r;
@r;
=head1 COPYRIGHT
-Copyright (c) 2000-2006 Ivan Kohler
+Copyright (c) 2000-2007 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2007 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.
=head1 BUGS
sql_create_table() has database-specific foo that probably ought to be
-abstracted into the DBIx::DBSchema::DBD:: modules.
+abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
+
+sql_alter_table() also has database-specific foo that ought to be abstracted
+into the DBIx::DBSchema::DBD:: modules.
-sql_create_table may change or destroy the object's data. If you need to use
+sql_create_table() may change or destroy the object's data. If you need to use
the object after sql_create_table, make a copy beforehand.
Some of the logic in new_odbc might be better abstracted into Column.pm etc.
-sql_alter_table ought to update indices, and drop columns not in $new
+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
DBSchema/DBD/SQLite.pm
DBSchema/DBD/Sybase.pm
DBSchema/DBD/mysql.pm
+DBSchema/Index.pm
DBSchema/Table.pm
DBSchema/_util.pm
MANIFEST
DBIx::DBSchema
-Copyright (c) 2000-2006 Ivan Kohler
+Copyright (c) 2000-2007 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2007 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.
schema from an existing database. You can save the schema to disk and restore
it from different process. You can write SQL CREATE statements statements for
different databases from a single source. In recent versions, you can
-transform one schema to another, adding any necessary new columsn and tables.
+transform one schema to another, adding any necessary new columns and tables
+(and, as of 0.33, indices).
Currently supported databases are MySQL, PostgreSQL, and SQLite. Sybase and
Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use
$ cvs checkout DBIx-DBSchema
as well as <http://www.420.am/cgi-bin/viewvc.cgi/DBIx-DBSchema>.
-A mailing list is available. Send a blank message to
-<ivan-dbix-dbschema-users-subscribe@420.am>.
-
Homepage: <http://www.420.am/dbix-dbschema>
+libdbix-dbschema-perl (0.33~01-1) unstable; urgency=low
+
+ * upstream test release
+
+ -- Ivan Kohler <ivan-debian@420.am> Wed, 27 Jun 2007 19:08:10 -0700
+
libdbix-dbschema-perl (0.32-1) unstable; urgency=low
* new upstream release
projects / DBIx-DBSchema.git / commitdiff