Make table dropping optional, not the default.

diff --git a/Changes b/Changes
index 439cbb9..cfcb123 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,9 @@ Revision history for Perl extension DBIx::DBSchema.
         - More work on update schema from Slaven Rezic <srezic@cpan.org>,
           thanks!
           + implement table dropping (closes: CPAN#27936)
         - More work on update schema from Slaven Rezic <srezic@cpan.org>,
           thanks!
           + implement table dropping (closes: CPAN#27936)

+        - Fix to quiet warnings from internal use of old API from Jesse Vincent
+          <jesse+cpan@fsck.com>, thanks! (closes: CPAN#27958)
+        - Make table dropping optional, not the default.

 
 0.33 Thu Jun 28 18:46:15 PDT 2007
         - Overhaul of index representation: indices (both normal and unique)
 
 0.33 Thu Jun 28 18:46:15 PDT 2007
         - Overhaul of index representation: indices (both normal and unique)

diff --git a/DBSchema.pm b/DBSchema.pm
index 4ff8fa0..6b6b1c2 100644 (file)
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -3,14 +3,14 @@ package DBIx::DBSchema;
 use strict;
 use vars qw($VERSION $DEBUG $errstr);
 use Storable;
 use strict;
 use vars qw($VERSION $DEBUG $errstr);
 use Storable;

-use DBIx::DBSchema::_util qw(_load_driver _dbh);
+use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);

 use DBIx::DBSchema::Table 0.05;
 use DBIx::DBSchema::Index;
 use DBIx::DBSchema::Column;
 use DBIx::DBSchema::ColGroup::Unique;
 use DBIx::DBSchema::ColGroup::Index;
 
 use DBIx::DBSchema::Table 0.05;
 use DBIx::DBSchema::Index;
 use DBIx::DBSchema::Column;
 use DBIx::DBSchema::ColGroup::Unique;
 use DBIx::DBSchema::ColGroup::Index;
 

-$VERSION = "0.34_01";
+$VERSION = "0.34_02";

 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
 $DEBUG = 0;
 $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 -
 
 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.
 
 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,45 @@ sub sql {
   map { $self->table($_)->sql_create_table($dbh); } $self->tables;
 }
 
   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.
 
 
 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_alter_column> for additional specifics and
 limitations.
 
 
 See L<DBIx::DBSchema::Table/sql_alter_table>,
 L<DBIx::DBSchema::Column/sql_add_coumn> 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 {
 =cut
 
 #gosh, false laziness w/DBSchema::Table::sql_alter_schema
 
 sub sql_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(@_) );

 
   my @r = ();
 
 
   my @r = ();
 


@@ -289,16 +301,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;
 
 
       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"
   }
 
   warn join("\n", @r). "\n"


@@ -308,7 +323,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.
 
 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 +331,10 @@ the schema.  Throws a fatal error if any statement fails.
 =cut
 
 sub update_schema {
 =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";
   }
     $dbh->do( $statement )
       or die "Error: ". $dbh->errstr. "\n executing: $statement";
   }


@@ -505,8 +521,8 @@ 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,
 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.
+modified columns).  sql_update_schema doesn't deal with deleted or modified
+columns yet.

 
 Need to port and test with additional databases
 
 
 Need to port and test with additional databases
 

diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm
index 1e70525..899fe94 100644 (file)
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -379,11 +379,11 @@ Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
 
 sub unique {
     my $self = shift;
 
 sub unique {
     my $self = shift;

-    carp ref($self) . "->unique method is deprecated; see ->indices";

 
 

+    carp ref($self) . "->unique method is deprecated; see ->indices";

     #croak ref($self). "->unique method is deprecated; see ->indices";
     #croak ref($self). "->unique method is deprecated; see ->indices";

-    $self->_unique(@_);

 
 

+    $self->_unique(@_);

 }
 
 sub _unique {
 }
 
 sub _unique {


@@ -412,8 +412,8 @@ sub index {
 
   carp ref($self). "->index method is deprecated; see ->indices";
   #croak ref($self). "->index method is deprecated; see ->indices";
 
   carp ref($self). "->index method is deprecated; see ->indices";
   #croak ref($self). "->index method is deprecated; see ->indices";

-    $self->_index(@_);

 
 

+  $self->_index(@_);

 }
 
 
 }
 
 


@@ -576,15 +576,22 @@ sub sql_create_table {
 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.
 
 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
 
 
 =cut
 

diff --git a/DBSchema/_util.pm b/DBSchema/_util.pm
index 51a3159..5bb583f 100644 (file)
--- a/DBSchema/_util.pm
+++ b/DBSchema/_util.pm
@@ -9,7 +9,7 @@ use Carp qw(confess);
 use DBI;
 
 @ISA = qw(Exporter);
 use DBI;
 
 @ISA = qw(Exporter);

-@EXPORT_OK = qw( _load_driver _dbh );
+@EXPORT_OK = qw( _load_driver _dbh _parse_opt );

 
 sub _load_driver {
   my($dbh) = @_;
 
 sub _load_driver {
   my($dbh) = @_;


@@ -39,5 +39,14 @@ sub _dbh {
   ( $dbh, $created_dbh );
 }
 
   ( $dbh, $created_dbh );
 }
 

+sub _parse_opt {
+  my $optref = shift;
+  if ( ref( $optref->[0] ) eq 'HASH' ) {
+    shift @$optref;
+  } else {
+    {};
+  }
+}
+

 1;
 
 1;