From: ivan <ivan>
Date: Thu, 30 Mar 2006 13:36:32 +0000 (+0000)
Subject:         - more schema update stuff:
X-Git-Tag: DBIx_DBSchema_0_31
X-Git-Url: http://git.freeside.biz/gitweb/?p=DBIx-DBSchema.git;a=commitdiff_plain;h=227502e5d593043b2c3a9dbdd0ce4464ac04546d

    - more schema update stuff:
        - added Column::sql_alter_column
        - added Table::sql_alter_table
        - added DBSchema::sql_update_schema and DBSchema::update_schema
---

diff --git a/Changes b/Changes
index 95b93a2..5596289 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension DBIx::DBSchema.
 
+0.31 Thu Mar 30 05:28:20 PST 2006
+	- more schema update stuff:
+	- added Column::sql_alter_column
+	- added Table::sql_alter_table
+	- added DBSchema::sql_update_schema and DBSchema::update_schema
+
 0.30 Thu Feb 16 16:43:01 PST 2006
 	- "Too much uptime"
 	- Remove buggy debugging from Column.pm
diff --git a/DBSchema.pm b/DBSchema.pm
index 9595c42..893696a 100644
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -1,11 +1,10 @@
 package DBIx::DBSchema;
 
 use strict;
-use vars qw(@ISA $VERSION);
+use vars qw(@ISA $VERSION $DEBUG);
 #use Exporter;
-use DBI;
 use Storable;
-use DBIx::DBSchema::_util qw(_load_driver);
+use DBIx::DBSchema::_util qw(_load_driver _dbh);
 use DBIx::DBSchema::Table;
 use DBIx::DBSchema::Column;
 use DBIx::DBSchema::ColGroup::Unique;
@@ -14,7 +13,8 @@ use DBIx::DBSchema::ColGroup::Index;
 #@ISA = qw(Exporter);
 @ISA = ();
 
-$VERSION = "0.30";
+$VERSION = "0.31";
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -103,8 +103,7 @@ driver.
 =cut
 
 sub new_odbc {
-  my($proto, $dbh) = (shift, shift);
-  $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+  my($proto, $dbh) = ( shift, _dbh(@_) );
   $proto->new(
     map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh)
   );
@@ -121,8 +120,7 @@ only available if there is a DBIx::DBSchema::DBD for the corresponding database
 =cut
 
 sub new_native {
-  my($proto, $dbh) = (shift, shift);
-  $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr unless ref($dbh);
+  my($proto, $dbh) = (shift, _dbh(@_) );
   $proto->new(
     map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh)
   );
@@ -221,15 +219,86 @@ specified database, will attempt to use generic SQL syntax.
 =cut
 
 sub sql {
-  my($self, $dbh) = (shift, shift);
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    $created_dbh = 1;
+  my($self, $dbh) = ( shift, _dbh(@_) );
+  map { $self->table($_)->sql_create_table($dbh); } $self->tables;
+}
+
+=item sql_update_schema 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.
+
+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.
+
+=cut
+
+#gosh, false laziness w/DBSchema::Table::sql_alter_schema
+
+sub sql_update_schema {
+  my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+
+  my @r = ();
+
+  foreach my $table ( $new->tables ) {
+  
+    if ( $self->table($table) ) {
+  
+      warn "$table exists\n" if $DEBUG > 1;
+
+      push @r,
+        $self->table($table)->sql_alter_table( $new->table($table), $dbh );
+
+    } else {
+  
+      warn "table $table does not exist.\n" if $DEBUG;
+
+      push @r, 
+        $new->table($table)->sql_create_table( $dbh );
+  
+    }
+  
   }
-  my @r = map { $self->table($_)->sql_create_table($dbh); } $self->tables;
-  $dbh->disconnect if $created_dbh;
+
+  # should eventually drop tables not in $new
+
+  warn join("\n", @r). "\n"
+    if $DEBUG;
+
   @r;
+  
+}
+
+=item update_schema 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(@_) );
+
+  foreach my $statement ( $self->sql_update_schema( $new, $dbh ) ) {
+    $dbh->do( $statement )
+      or die "Error: ". $dbh->errstr. "\n executing: $statement";
+  }
+
 }
 
 =item pretty_print
@@ -373,6 +442,8 @@ 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>,
diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index 7b4382b..44b6099 100644
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 #use Carp;
 #use Exporter;
-use DBIx::DBSchema::_util qw(_load_driver);
+use DBIx::DBSchema::_util qw(_load_driver _dbh);
 
 #@ISA = qw(Exporter);
 @ISA = qw();
@@ -245,14 +245,8 @@ for other engines (if applicable) may also be supported in the future.
 =cut
 
 sub line {
-  my($self,$dbh) = (shift, shift);
+  my($self, $dbh) = ( shift, _dbh(@_) );
 
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
-    $created_dbh = 1;
-  }
   my $driver = $dbh ? _load_driver($dbh) : '';
 
   my %typemap;
@@ -285,7 +279,7 @@ sub line {
     $null =~ s/^NULL$//;
   }
 
-  my $r = join(' ',
+  join(' ',
     $self->name,
     $type. ( ( defined($self->length) && $self->length )
              ? '('.$self->length.')'
@@ -301,14 +295,13 @@ sub line {
       : ''
     ),
   );
-  $dbh->disconnect if $created_dbh;
-  $r;
 
 }
 
-=item sql_add_column
+=item sql_add_column [ DBH ] 
 
-Returns a list of SQL statements to add this column.
+Returns a list of SQL statements to add this column to an existing table.  (To
+create a new table, see L<DBIx::DBSchema::Table/sql_create_table> instead.)
 
 The data source can be specified by passing an open DBI database handle, or by
 passing the DBI data source name, username and password.  
@@ -325,23 +318,13 @@ applicable) may also be supported in the future.
 =cut
 
 sub sql_add_column {
-  my($self, $dbh) = (shift, shift);
+  my($self, $dbh) = ( shift, _dbh(@_) );
 
   die "$self: this column is not assigned to a table"
     unless $self->table_name;
 
-  #false laziness w/Table::sql_create_driver
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
-    $created_dbh = 1;
-  }
-
   my $driver = $dbh ? _load_driver($dbh) : '';
 
-  #eofalse
-
   my @after_add = ();
 
   my $real_type = '';
@@ -412,7 +395,61 @@ sub sql_add_column {
   $self->type($real_type) if $real_type;
   $self->null($real_null) if defined $real_null;
 
-  $dbh->disconnect if $created_dbh;
+  @r;
+
+}
+
+=item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statements to alter this column so that it is identical
+to the provided prototype column, also a DBIx::DBSchema::Column 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.
+
+
+Or should, someday.  Right now it knows how to change NOT NULL into NULL and
+vice-versa.
+
+=cut
+
+sub sql_alter_column {
+  my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+
+  my $table = $self->table_name;
+  die "$self: this column is not assigned to a table"
+    unless $table;
+
+  my $name = $self->name;
+
+#  my $driver = $dbh ? _load_driver($dbh) : '';
+
+  my @r = ();
+
+  # change the name...
+
+  # change the type...
+
+  # change nullability from NOT NULL to NULL
+  if ( ! $self->null && $new->null ) {
+    push @r, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
+  }
+
+  # change nullability from NULL to NOT NULL...
+  # this one could be more complicated, need to set a DEFAULT value and update
+  # the table first...
+  if ( $self->null && ! $new->null ) {
+    push @r, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
+  }
+
+  # change other stuff...
 
   @r;
 
@@ -426,7 +463,7 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2005 Ivan Kohler
+Copyright (c) 2000-2006 Ivan Kohler
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm
index 0fa0bbf..fc008f9 100644
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -1,10 +1,10 @@
 package DBIx::DBSchema::Table;
 
 use strict;
-use vars qw(@ISA $VERSION %create_params);
+use vars qw(@ISA $VERSION $DEBUG %create_params);
 #use Carp;
 #use Exporter;
-use DBIx::DBSchema::_util qw(_load_driver);
+use DBIx::DBSchema::_util qw(_load_driver _dbh);
 use DBIx::DBSchema::Column 0.03;
 use DBIx::DBSchema::ColGroup::Unique;
 use DBIx::DBSchema::ColGroup::Index;
@@ -13,6 +13,7 @@ use DBIx::DBSchema::ColGroup::Index;
 @ISA = qw();
 
 $VERSION = '0.02';
+$DEBUG = 0;
 
 =head1 NAME
 
@@ -350,6 +351,9 @@ sub column {
 
 Returns a list of SQL statments to create this table.
 
+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.  
+
 The data source can be specified by passing an open DBI database handle, or by
 passing the DBI data source name, username and password.  
 
@@ -365,14 +369,8 @@ MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
 =cut
 
 sub sql_create_table { 
-  my($self, $dbh) = (shift, shift);
+  my($self, $dbh) = ( shift, _dbh(@_) );
 
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous 'used only once' error
-    $created_dbh = 1;
-  }
   my $driver = _load_driver($dbh);
 
 #should be in the DBD somehwere :/
@@ -416,11 +414,65 @@ sub sql_create_table {
     if $self->index;
 
   #$self->primary_key($saved_pkey) if $saved_pkey;
-  $dbh->disconnect if $created_dbh;
   @r;
 }
 
-#
+=item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+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.
+
+=cut
+
+#gosh, false laziness w/DBSchema::sql_update_schema
+
+sub sql_alter_table {
+  my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+
+  my $table = $self->name;
+
+  my @r = ();
+
+  foreach my $column ( $new->columns ) {
+
+    if ( $self->column($column) )  {
+
+      warn "  $table.$column exists\n" if $DEBUG > 2;
+
+      push @r,
+        $self->column($column)->sql_alter_column( $new->column($column), $dbh );
+
+    } else {
+  
+      warn "column $table.$column does not exist.\n" if $DEBUG;
+
+      push @r,
+        $new->column($column)->sql_add_column( $dbh );
+  
+    }
+  
+  }
+  
+  #should eventually check & create missing indices ( & delete ones not in $new)
+  
+  #should eventually drop columns not in $new
+
+  warn join("\n", @r). "\n"
+    if $DEBUG;
+
+  @r;
+
+}
 
 sub _null_sth {
   my($dbh, $table) = @_;
@@ -441,7 +493,7 @@ with no indices.
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000-2006 Ivan Kohler
 Copyright (c) 2000 Mail Abuse Prevention System LLC
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
@@ -457,6 +509,8 @@ 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
+
 =head1 SEE ALSO
 
 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
diff --git a/DBSchema/_util.pm b/DBSchema/_util.pm
index 4e7c3aa..51a3159 100644
--- a/DBSchema/_util.pm
+++ b/DBSchema/_util.pm
@@ -6,9 +6,10 @@ use strict;
 use vars qw(@ISA @EXPORT_OK);
 use Exporter;
 use Carp qw(confess);
+use DBI;
 
 @ISA = qw(Exporter);
-@EXPORT_OK = qw( _load_driver );
+@EXPORT_OK = qw( _load_driver _dbh );
 
 sub _load_driver {
   my($dbh) = @_;
@@ -26,5 +27,17 @@ sub _load_driver {
   eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@;
 }
 
+#sub _dbh_or_dbi_connect_args {
+sub _dbh {
+  my($dbh) = shift;
+  my $created_dbh = 0;
+  unless ( ref($dbh) || ! @_ ) {
+    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
+    $created_dbh = 1;
+  }
+
+  ( $dbh, $created_dbh );
+}
+
 1;
 
diff --git a/debian/changelog b/debian/changelog
index f57725b..1ef7af7 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+libdbix-dbschema-perl (0.31-1) unstable; urgency=low
+
+  * new upstream release
+
+ -- Ivan Kohler <ivan-debian@420.am>  Thu, 30 Mar 2006 04:54:21 -0800
+
 libdbix-dbschema-perl (0.30-1) unstable; urgency=low
 
   * new upstream release
diff --git a/debian/files b/debian/files
deleted file mode 100644
index ac0ce4d..0000000
--- a/debian/files
+++ /dev/null
@@ -1 +0,0 @@
-libdbix-dbschema-perl_0.29-1_all.deb perl optional