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
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;
#@ISA = qw(Exporter);
@ISA = ();
-$VERSION = "0.30";
+$VERSION = "0.31";
+$DEBUG = 0;
=head1 NAME
=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)
);
=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)
);
=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
(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>,
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();
=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;
$null =~ s/^NULL$//;
}
- my $r = join(' ',
+ join(' ',
$self->name,
$type. ( ( defined($self->length) && $self->length )
? '('.$self->length.')'
: ''
),
);
- $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.
=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 = '';
$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;
=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.
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;
@ISA = qw();
$VERSION = '0.02';
+$DEBUG = 0;
=head1 NAME
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.
=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 :/
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) = @_;
=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
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>,
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) = @_;
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;
+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
+++ /dev/null
-libdbix-dbschema-perl_0.29-1_all.deb perl optional
projects / DBIx-DBSchema.git / commitdiff