X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=DBSchema.pm;h=1ae57d8f31201001ef424306e8298de07ac18971;hb=31e75dd45e81bbba3902564207b7bfc5dfc91fd3;hp=590cb9c35d00829862206abfbe4372b7d4842f16;hpb=2f5c5c180ebbeb6237039a02e1c18f68d97641d2;p=DBIx-DBSchema.git diff --git a/DBSchema.pm b/DBSchema.pm index 590cb9c..1ae57d8 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -1,12 +1,11 @@ package DBIx::DBSchema; use strict; -use vars qw(@ISA $VERSION); +use vars qw(@ISA $VERSION $DEBUG $errstr); #use Exporter; -use Carp qw(confess); -use DBI; use Storable; -use DBIx::DBSchema::Table; +use DBIx::DBSchema::_util qw(_load_driver _dbh); +use DBIx::DBSchema::Table 0.03; use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; use DBIx::DBSchema::ColGroup::Index; @@ -14,7 +13,8 @@ use DBIx::DBSchema::ColGroup::Index; #@ISA = qw(Exporter); @ISA = (); -$VERSION = "0.26"; +$VERSION = "0.32"; +$DEBUG = 0; =head1 NAME @@ -31,7 +31,7 @@ DBIx::DBSchema - Database-independent schema objects $schema = new_native DBIx::DBSchema $dsn, $user, $pass; $schema->save("filename"); - $schema = load DBIx::DBSchema "filename"; + $schema = load DBIx::DBSchema "filename" or die $DBIx::DBSchema::errstr; $schema->addtable($dbix_dbschema_table_object); @@ -55,13 +55,15 @@ represent a database schema. This module implements an OO-interface to database schemas. Using this module, you can create a database schema with an OO Perl interface. You can read the schema from an existing database. You can save the schema to disk and restore -it a different process. Most importantly, DBIx::DBSchema can write SQL -CREATE statements statements for different databases from a single source. +it a different process. You can write SQL CREATE statements statements for +different databases from a single source. In recent versions, you can +transform one schema to another, adding any necessary new columsn and tables. -Currently supported databases are MySQL and PostgreSQL. Sybase support is -partially implemented. DBIx::DBSchema will attempt to use generic SQL syntax -for other databases. Assistance adding support for other databases is -welcomed. See L, "Driver Writer's Guide and Base Class". +Currently supported databases are MySQL, PostgreSQL and SQLite. Sybase and +Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use +generic SQL syntax for other databases. Assistance adding support for other +databases is welcomed. See L, "Driver Writer's Guide and +Base Class". =head1 METHODS @@ -103,8 +105,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 +122,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) ); @@ -130,7 +130,8 @@ sub new_native { =item load FILENAME -Loads a DBIx::DBSchema object from a file. +Loads a DBIx::DBSchema object from a file. If there is an error, returns +false and puts an error message in $DBIx::DBSchema::errstr; =cut @@ -143,12 +144,23 @@ sub load { eval { $self = Storable::retrieve($file); }; if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw + my $olderror = $@; + eval "use FreezeThaw;"; - die $@ if $@; - open(FILE,"<$file") or die "Can't open $file: $!"; - my $string = join('',); - close FILE or die "Can't close $file: $!"; - ($self) = FreezeThaw::thaw($string); + if ( $@ ) { + $@ = $olderror; + } else { + open(FILE,"<$file") + or do { $errstr = "Can't open $file: $!"; return ''; }; + my $string = join('',); + close FILE + or do { $errstr = "Can't close $file: $!"; return ''; }; + ($self) = FreezeThaw::thaw($string); + } + } + + unless ( $self ) { + $errstr = $@; } $self; @@ -221,15 +233,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, +L and +L 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 @@ -306,22 +389,6 @@ sub pretty_read { # private subroutines -sub _load_driver { - my($dbh) = @_; - my $driver; - if ( ref($dbh) ) { - $driver = $dbh->{Driver}->{Name}; - } else { - $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect - or '' =~ /()/; # ensure $1 etc are empty if match fails - $driver = $1 or confess "can't parse data source: $dbh"; - } - - #require "DBIx/DBSchema/DBD/$driver.pm"; - #$driver; - eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@; -} - sub _tables_from_dbh { my($dbh) = @_; my $driver = _load_driver($dbh); @@ -339,16 +406,25 @@ sub _tables_from_dbh { =back -=head1 AUTHOR +=head1 AUTHORS Ivan Kohler Charles Shapiro and Mitchell Friedman contributed the start of a Sybase driver. +Daniel Hanks contributed the Oracle driver. + +Jesse Vincent contributed the SQLite driver. + +=head1 CONTRIBUTIONS + +Contributions are welcome! I'm especially keen on any interest in the first +three items/projects below under BUGS. + =head1 COPYRIGHT -Copyright (c) 2000-2005 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 @@ -356,6 +432,18 @@ the same terms as Perl itself. =head1 BUGS +Indices are not stored by name. Index representation could use an overhaul. + +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, added/modified/indices (probably need em named first), +added/deleted tables + +Need to port and test with additional databases + Each DBIx::DBSchema object should have a name which corresponds to its name within the SQL database engine (DBI data source). @@ -364,6 +452,12 @@ pretty_print is actually pretty ugly. Perhaps pretty_read should eval column types so that we can use DBI qw(:sql_types) here instead of externally. +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, L,