X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=DBSchema.pm;h=12a240e6ccb0d06061838d54dffb7b54b72263c4;hb=2376c9905b251387f286db7505a95c66d95dec07;hp=4ff8fa0ae6f22b59e8700607e85a335ba3447108;hpb=b604a6e28009f97d206156bf3fa1eeeb6b5063f9;p=DBIx-DBSchema.git diff --git a/DBSchema.pm b/DBSchema.pm index 4ff8fa0..12a240e 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -3,14 +3,14 @@ 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.05; +use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt); +use DBIx::DBSchema::Table 0.08; use DBIx::DBSchema::Index; use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; use DBIx::DBSchema::ColGroup::Index; -$VERSION = "0.34_01"; +$VERSION = "0.40"; $VERSION = eval $VERSION; # modperlstyle: convert the string into a number $DEBUG = 0; @@ -220,8 +220,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. @@ -237,35 +239,44 @@ sub sql { map { $self->table($_)->sql_create_table($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 = (); @@ -275,8 +286,10 @@ sub sql_update_schema { warn "$table exists\n" if $DEBUG > 1; - push @r, - $self->table($table)->sql_alter_table( $new->table($table), $dbh ); + push @r, $self->table($table)->sql_alter_table( $new->table($table), + $dbh, + $opt + ); } else { @@ -289,16 +302,19 @@ sub sql_update_schema { } - # drop tables not in $new - foreach my $table ( $self->tables ) { + if ( $opt->{'drop_tables'} ) { - if ( !$new->table($table) ) { + 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, $self->table($table)->sql_drop_table( $dbh ); + } + } warn join("\n", @r). "\n" @@ -308,7 +324,7 @@ sub sql_update_schema { } -=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. @@ -316,9 +332,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"; } @@ -354,7 +371,12 @@ sub pretty_print { "'". $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 ). @@ -390,7 +412,7 @@ sub pretty_print { ? " 'using' => '". $index->using ."',\n" : '' ). - " 'unique' => ". $index->_unique .",\n". + " 'unique' => ". $index->unique .",\n". " 'columns' => [ '". join("', '", @{$index->columns} ). "' ],\n". @@ -408,6 +430,9 @@ sub pretty_print { =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. @@ -482,7 +507,11 @@ 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. =head1 CONTRIBUTIONS @@ -493,7 +522,7 @@ items/projects below under BUGS. Copyright (c) 2000-2007 Ivan Kohler Copyright (c) 2000 Mail Abuse Prevention System LLC -Copyright (c) 2007 Freeside Internet Services, Inc. +Copyright (c) 2007-2010 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. @@ -504,9 +533,7 @@ 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. +sql_update_schema doesn't deal with deleted columns yet. Need to port and test with additional databases