- 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 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Perl extension DBIx::DBSchema.
 
 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
 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 (file)
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -1,11 +1,10 @@
 package DBIx::DBSchema;
 
 use strict;
 package DBIx::DBSchema;
 
 use strict;

-use vars qw(@ISA $VERSION);
+use vars qw(@ISA $VERSION $DEBUG);

 #use Exporter;
 #use Exporter;

-use DBI;

 use Storable;
 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;
 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 = ();
 
 #@ISA = qw(Exporter);
 @ISA = ();
 

-$VERSION = "0.30";
+$VERSION = "0.31";
+$DEBUG = 0;

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -103,8 +103,7 @@ driver.
 =cut
 
 sub new_odbc {
 =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)
   );
   $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 {
 =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)
   );
   $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 {
 =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;
   @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
 }
 
 =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
 
 (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>,
 =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 (file)
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 #use Carp;
 #use Exporter;
 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();
 
 #@ISA = qw(Exporter);
 @ISA = qw();


@@ -245,14 +245,8 @@ for other engines (if applicable) may also be supported in the future.
 =cut
 
 sub line {
 =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;
   my $driver = $dbh ? _load_driver($dbh) : '';
 
   my %typemap;


@@ -285,7 +279,7 @@ sub line {
     $null =~ s/^NULL$//;
   }
 
     $null =~ s/^NULL$//;
   }
 

-  my $r = join(' ',
+  join(' ',

     $self->name,
     $type. ( ( defined($self->length) && $self->length )
              ? '('.$self->length.')'
     $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.  
 
 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 {
 =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;
 
 
   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) : '';
 
   my $driver = $dbh ? _load_driver($dbh) : '';
 

-  #eofalse
-

   my @after_add = ();
 
   my $real_type = '';
   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;
 
   $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;
 
 
   @r;
 


@@ -426,7 +463,7 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 
 =head1 COPYRIGHT
 
 
 =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.
 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 (file)
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -1,10 +1,10 @@
 package DBIx::DBSchema::Table;
 
 use strict;
 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 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;
 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';
 @ISA = qw();
 
 $VERSION = '0.02';

+$DEBUG = 0;

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -350,6 +351,9 @@ sub column {
 
 Returns a list of SQL statments to create this table.
 
 
 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.  
 
 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 { 
 =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 :/
   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;
     if $self->index;
 
   #$self->primary_key($saved_pkey) if $saved_pkey;

-  $dbh->disconnect if $created_dbh;

   @r;
 }
 
   @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) = @_;
 
 sub _null_sth {
   my($dbh, $table) = @_;


@@ -441,7 +493,7 @@ with no indices.
 
 =head1 COPYRIGHT
 
 
 =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
 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.
 
 
 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>,
 =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 (file)
--- 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 vars qw(@ISA @EXPORT_OK);
 use Exporter;
 use Carp qw(confess);

+use DBI;

 
 @ISA = qw(Exporter);
 
 @ISA = qw(Exporter);

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

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


@@ -26,5 +27,17 @@ sub _load_driver {
   eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@;
 }
 
   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;
 
 1;
 

diff --git a/debian/changelog b/debian/changelog
index f57725b..1ef7af7 100644 (file)
--- 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
 libdbix-dbschema-perl (0.30-1) unstable; urgency=low
 
   * new upstream release

diff --git a/debian/files b/debian/files
deleted file mode 100644 (file)
index ac0ce4d..0000000
--- a/debian/files
+++ /dev/null
@@ -1 +0,0 @@
-libdbix-dbschema-perl_0.29-1_all.deb perl optional