X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=DBSchema.pm;h=89354cd1b432ea1f909f05504ce57ff77901f718;hb=HEAD;hp=d7d6dc0a968192ab14fbddea5182df57db2d35e4;hpb=bebbb82db829900b14dc869180e752c832f56534;p=DBIx-DBSchema.git diff --git a/DBSchema.pm b/DBSchema.pm index d7d6dc0..89354cd 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -1,20 +1,19 @@ package DBIx::DBSchema; use strict; -use vars qw(@ISA $VERSION $DEBUG); -#use Exporter; use Storable; -use DBIx::DBSchema::_util qw(_load_driver _dbh); -use DBIx::DBSchema::Table 0.03; +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; -#@ISA = qw(Exporter); -@ISA = (); +our $VERSION = '0.47'; +$VERSION = eval $VERSION; # modperlstyle: convert the string into a number -$VERSION = "0.31"; -$DEBUG = 0; +our $DEBUG = 0; + +our $errstr; =head1 NAME @@ -31,7 +30,7 @@ DBIx::DBSchema - Database-independent schema objects $schema = new_native DBIx::DBSchema $dsn, $user, $pass; $schema->save("filename"); - $schema = load DBIx::DBSchema "filename"; + $schema = load DBIx::DBSchema "filename" or die $DBIx::DBSchema::errstr; $schema->addtable($dbix_dbschema_table_object); @@ -55,13 +54,15 @@ represent a database schema. 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. Most importantly, DBIx::DBSchema can write SQL -CREATE statements statements for different databases from a single source. +it in a different process. You can write SQL CREATE statements statements for +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 and PostgreSQL. Sybase support is -partially implemented. DBIx::DBSchema will attempt to use generic SQL syntax -for other databases. Assistance adding support for other databases is -welcomed. See L, "Driver Writer's Guide and Base Class". +Currently supported databases are MySQL, PostgreSQL and SQLite. Sybase and +Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use +generic SQL syntax for other databases. Assistance adding support for other +databases is welcomed. See L, "Driver Writer's Guide and +Base Class". =head1 METHODS @@ -128,7 +129,8 @@ sub new_native { =item load FILENAME -Loads a DBIx::DBSchema object from a file. +Loads a DBIx::DBSchema object from a file. If there is an error, returns +false and puts an error message in $DBIx::DBSchema::errstr; =cut @@ -141,12 +143,23 @@ sub load { eval { $self = Storable::retrieve($file); }; if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw + my $olderror = $@; + eval "use FreezeThaw;"; - die $@ if $@; - open(FILE,"<$file") or die "Can't open $file: $!"; - my $string = join('',); - close FILE or die "Can't close $file: $!"; - ($self) = FreezeThaw::thaw($string); + if ( $@ ) { + $@ = $olderror; + } else { + open(FILE,"<$file") + or do { $errstr = "Can't open $file: $!"; return ''; }; + my $string = join('',); + close FILE + or do { $errstr = "Can't close $file: $!"; return ''; }; + ($self) = FreezeThaw::thaw($string); + } + } + + unless ( $self ) { + $errstr = $@; } $self; @@ -206,8 +219,10 @@ 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. +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 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. @@ -220,40 +235,53 @@ specified database, will attempt to use generic SQL syntax. 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 set true before all other arguments, it will also drop +tables. See L, -L and +L and L 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 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 ) { @@ -262,29 +290,48 @@ sub sql_update_schema { 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; + if $DEBUG > 1; @r; } -=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. @@ -292,9 +339,10 @@ 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"; } @@ -310,45 +358,99 @@ hash. 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. "', ". + + ( ref($table->column($_)->default) + ? "\\'". ${ $table->column($_)->default }. "'" + : "'". $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". + + #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 recommended. If you need to load and save your schema +to a file, see the L and L methods. + Creates a schema as specified by a data structure such as that created by B method. @@ -356,21 +458,39 @@ B method. 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, + + #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 @@ -378,16 +498,8 @@ sub pretty_read { 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 @@ -401,53 +513,80 @@ Charles Shapiro and Mitchell Friedman Daniel Hanks 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 contributed column and table dropping, Pg +bugfixes and more. + +Nathan Anderson contribued updates to the +SQLite and Sybase drivers. =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 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-2006 Ivan Kohler +Copyright (c) 2000-2007 Ivan Kohler Copyright (c) 2000 Mail Abuse Prevention System LLC +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. -=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 +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). -pretty_print is actually pretty ugly. - -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 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. +=head2 PRETTY_ BUGS + +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. + +perhaps we should just get rid of pretty_read entirely. pretty_print is useful +for debugging, but pretty_read is pretty bunk. =head1 SEE ALSO -L, L, -L, L, +L, L, L, L, L, L, L, L