package DBIx::DBSchema;
use strict;
-use vars qw($VERSION $DEBUG $errstr);
use Storable;
-use DBIx::DBSchema::_util qw(_load_driver _dbh);
-use DBIx::DBSchema::Table 0.04;
+use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
+use DBIx::DBSchema::Table 0.12;
use DBIx::DBSchema::Index;
use DBIx::DBSchema::Column;
-use DBIx::DBSchema::ColGroup::Unique;
-use DBIx::DBSchema::ColGroup::Index;
+use DBIx::DBSchema::ForeignKey;
-$VERSION = "0.33";
-#$VERSION = eval $VERSION; # modperlstyle: convert the string into a number
+our $VERSION = '0.46_02';
+$VERSION = eval $VERSION; # modperlstyle: convert the string into a number
-$DEBUG = 0;
+our $DEBUG = 0;
+
+our $errstr;
=head1 NAME
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 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 columns and tables
-(and, as of 0.33, indices).
+different databases from a single source. You can transform one schema to
+another, adding any necessary new columns, tables, indices and foreign keys.
Currently supported databases are MySQL, PostgreSQL and SQLite. Sybase and
Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use
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.
+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.
sub sql {
my($self, $dbh) = ( shift, _dbh(@_) );
- map { $self->table($_)->sql_create_table($dbh); } $self->tables;
+ (
+ ( map { $self->table($_)->sql_create_table($dbh); } $self->tables ),
+ ( map { $self->table($_)->sql_add_constraints($dbh); } $self->tables ),
+ );
}
-=item sql_update_schema PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+=item sql_update_schema [ OPTIONS_HASHREF, ] PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
Returns a list of SQL statements to update this schema so that it is idential
to the provided prototype schema, also a DBIx::DBSchema 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: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.
-
-Right now this method knows how to add new tables and alter existing tables.
-It doesn't know how to drop tables yet.
+Right now this method knows how to add new tables and alter existing tables,
+including indices. If specifically requested by passing an options hashref
+with B<drop_tables> set true before all other arguments, it will also drop
+tables.
See L<DBIx::DBSchema::Table/sql_alter_table>,
-L<DBIx::DBSchema::Column/sql_add_coumn> and
+L<DBIx::DBSchema::Column/sql_add_column> and
L<DBIx::DBSchema::Column/sql_alter_column> for additional specifics and
limitations.
+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::Table::sql_alter_schema
sub sql_update_schema {
- my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+ my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
my @r = ();
+ my @later = ();
foreach my $table ( $new->tables ) {
warn "$table exists\n" if $DEBUG > 1;
push @r,
- $self->table($table)->sql_alter_table( $new->table($table), $dbh );
+ $self->table($table)->sql_alter_table( $new->table($table),
+ $dbh, $opt );
+ push @later,
+ $self->table($table)->sql_alter_constraints( $new->table($table),
+ $dbh, $opt );
} else {
warn "table $table does not exist.\n" if $DEBUG;
- push @r,
- $new->table($table)->sql_create_table( $dbh );
+ push @r, $new->table($table)->sql_create_table( $dbh );
+ push @later, $new->table($table)->sql_add_constraints( $dbh );
}
}
- # should eventually drop tables not in $new
+ if ( $opt->{'drop_tables'} ) {
+
+ warn "drop_tables enabled\n" if $DEBUG;
+
+ # drop tables not in $new
+ foreach my $table ( grep !$new->table($_), $self->tables ) {
+
+ warn "table $table should be dropped.\n" if $DEBUG;
+
+ push @r, $self->table($table)->sql_drop_table( $dbh );
+
+ }
+
+ }
+
+ push @r, @later;
warn join("\n", @r). "\n"
if $DEBUG > 1;
}
-=item update_schema PROTOTYPE_SCHEMA, DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ]
+=item update_schema [ OPTIONS_HASHREF, ] PROTOTYPE_SCHEMA, DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ]
Same as sql_update_schema, except actually runs the SQL commands to update
the schema. Throws a fatal error if any statement fails.
=cut
sub update_schema {
- my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+ #my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+ my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
- foreach my $statement ( $self->sql_update_schema( $new, $dbh ) ) {
+ foreach my $statement ( $self->sql_update_schema( $opt, $new, $dbh ) ) {
$dbh->do( $statement )
or die "Error: ". $dbh->errstr. "\n executing: $statement";
}
"'". $table->column($_)->type. "', ".
"'". $table->column($_)->null. "', ".
"'". $table->column($_)->length. "', ".
- "'". $table->column($_)->default. "', ".
+
+ ( ref($table->column($_)->default)
+ ? "\\'". ${ $table->column($_)->default }. "'"
+ : "'". $table->column($_)->default. "'"
+ ).', '.
+
"'". $table->column($_)->local. "',\n"
} $table->columns
).
#old style index representation..
(
- $table->{'unique'} # $table->unique
+ $table->{'unique'} # $table->_unique
? " 'unique' => [ ". join(', ',
map { "[ '". join("', '", @{$_}). "' ]" }
- @{$table->unique->lol_ref}
+ @{$table->_unique->lol_ref}
). " ],\n"
: ''
).
- ( $table->{'index'} # $table->index
+ ( $table->{'index'} # $table->_index
? " 'index' => [ ". join(', ',
map { "[ '". join("', '", @{$_}). "' ]" }
- @{$table->index->lol_ref}
+ @{$table->_index->lol_ref}
). " ],\n"
: ''
).
}
keys %indices
- ). "\n }, \n"
+ ). "\n }, \n".
+
+ #foreign_keys
+ " 'foreign_keys' => [ ". join( ",\n ",
+
+ map { my $name = $_->constraint;
+ "'$name' => { \n".
+ " },\n";
+ }
+ $table->foreign_keys
+
+ ). "\n ], \n"
+
+ ;
} $self->tables
). "}\n";
}
-=cut
-
=item pretty_read HASHREF
+This method is B<not> recommended. If you need to load and save your schema
+to a file, see the L</load> and L</save> methods.
+
Creates a schema as specified by a data structure such as that created by
B<pretty_print> method.
'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
'indices' => [ map { my $idx_info = $info->{'indices'}{$_};
DBIx::DBSchema::Index->new({
'name' => $_,
sub _tables_from_dbh {
my($dbh) = @_;
my $driver = _load_driver($dbh);
- my $db_catalog =
- scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_catalog");
- my $db_schema =
- scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_schema");
- my $sth = $dbh->table_info($db_catalog, $db_schema, '', 'TABLE')
- or die $dbh->errstr;
- #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
- # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
- map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
- @{ $sth->fetchall_arrayref([2,3]) };
+ my $driver_class = "DBIx::DBSchema::DBD::$driver";
+ $driver_class->tables($dbh);
}
=back
Daniel Hanks <hanksdc@about-inc.com> contributed the Oracle driver.
-Jesse Vincent contributed the SQLite driver.
+Jesse Vincent contributed the SQLite driver and fixes to quiet down
+internal usage of the old API.
+
+Slaven Rezic <srezic@cpan.org> contributed column and table dropping, Pg
+bugfixes and more.
+
+Nathan Anderson <http://1id.com/=nathan.anderson> contribued updates to the
+SQLite and Sybase drivers.
=head1 CONTRIBUTIONS
Contributions are welcome! I'm especially keen on any interest in the top
items/projects below under BUGS.
+=head1 REPOSITORY
+
+The code is available from our public git repository:
+
+ git clone git://git.freeside.biz/DBIx-DBSchema.git
+
+Or on the web:
+
+ http://freeside.biz/gitweb/?p=DBIx-DBSchema.git
+ Or:
+ http://freeside.biz/gitlist/DBIx-DBSchema.git
+
=head1 COPYRIGHT
Copyright (c) 2000-2007 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
-Copyright (c) 2007 Freeside Internet Services, Inc.
+Copyright (c) 2007-2017 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.
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, deleted tables). sql_update_schema doesn't drop tables
-or deal with deleted or modified columns yet.
+Foreign keys: need to support dropping, NOT VALID, reverse engineering w/mysql
Need to port and test with additional databases
Each DBIx::DBSchema object should have a name which corresponds to its name
within the SQL database engine (DBI data source).
+Need to support "using" index attribute in pretty_read and in reverse
+engineering
+
+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
+
+=head2 PRETTY_ BUGS
+
pretty_print is actually pretty ugly.
pretty_print isn't so good about quoting values... save/load is a much better
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
-
=head1 SEE ALSO
L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::Index>,