X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=DBSchema.pm;h=1ae57d8f31201001ef424306e8298de07ac18971;hb=36fe1079f6e2e8c58d2887926db0b022a644d1de;hp=e052bd6b85161553a6dd7ab4d2893394bd5528d1;hpb=188c6f3bf205ca0397299a97a11c5396ae190e66;p=DBIx-DBSchema.git diff --git a/DBSchema.pm b/DBSchema.pm index e052bd6..1ae57d8 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -1,17 +1,20 @@ package DBIx::DBSchema; use strict; -use vars qw(@ISA $VERSION); +use vars qw(@ISA $VERSION $DEBUG $errstr); #use Exporter; -#use Carp qw(verbose); -use DBI; -use FreezeThaw qw(freeze thaw cmpStr); -use DBIx::DBSchema::Table; +use Storable; +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; #@ISA = qw(Exporter); @ISA = (); -$VERSION = "0.1"; +$VERSION = "0.32"; +$DEBUG = 0; =head1 NAME @@ -22,12 +25,13 @@ DBIx::DBSchema - Database-independent schema objects use DBIx::DBSchema; $schema = new DBIx::DBSchema @dbix_dbschema_table_objects; - $schema = new_from_dsn DBIx::DBSchema $dsn, $user, $pass; $schema = new_odbc DBIx::DBSchema $dbh; + $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass; $schema = new_native DBIx::DBSchema $dbh; + $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); @@ -35,17 +39,32 @@ DBIx::DBSchema - Database-independent schema objects $DBIx_DBSchema_table_object = $schema->table("table_name"); - $sql_string = $schema->sql($dsn); + @sql = $schema->sql($dbh); + @sql = $schema->sql($dsn, $username, $password); + @sql = $schema->sql($dsn); #doesn't connect to database - less reliable $perl_code = $schema->pretty_print; %hash = eval $perl_code; - $schema = pretty_read DBIx::DBSchema \%hash; + use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash; =head1 DESCRIPTION DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and 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. 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, 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 =over 4 @@ -69,68 +88,41 @@ sub new { } -=item new_odbc_from_dsn DATA_SOURCE USERNAME PASSWORD - -Connects to the specified DBI data source and creates a DBIx::DBSchema object -from it using new_odbc. - -=cut - -sub new_odbc_from_dsn { - my($proto, $dsn, $user, $pass ) = @_; - my $dbh = DBI->connect( $dsn, $user, $pass ) or die $DBI::errstr; - my $self = $proto->new_odbc($dbh); - $dbh->disconnect; #silly DBI - $self; -} - -=item new_odbc DATABASE_HANDLE +=item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ] -Creates a new DBIx::DBSchema object from the supplied DBI database handle. -This uses the experimental DBI type_info method to create a schema with -standard (ODBC) SQL column types that most closely correspond to any -non-portable column types. Use this to import a schema that you wish to use -with many different database engines. Although primary key and (unique) index -information will only be read from databases with DBIx::DBSchema::DBD drivers -(currently MySQL and PostgreSQL), import of column names and attributes -*should* work for any database. +Creates a new DBIx::DBSchema object from an existing data source, which can be +specified by passing an open DBI database handle, or by passing the DBI data +source name, username, and password. This uses the experimental DBI type_info +method to create a schema with standard (ODBC) SQL column types that most +closely correspond to any non-portable column types. Use this to import a +schema that you wish to use with many different database engines. Although +primary key and (unique) index information will only be read from databases +with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of +column names and attributes *should* work for any database. Note that this +method only uses "ODBC" column types; it does not require or use an ODBC +driver. =cut sub new_odbc { - my($proto, $dbh) = @_; + my($proto, $dbh) = ( shift, _dbh(@_) ); $proto->new( map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh) ); } -=item new_native_from_dsn DATA_SOURCE USERNAME PASSWORD +=item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ] -Connects to the specified DBI data source and creates a DBIx::DBSchema object -from it using new_native. - -=cut - -sub new_native_from_dsn { - my($proto, $dsn, $user, $pass) = @_; - my $dbh = DBI->connect( $dsn, $user, $pass ) or die $DBI::errstr; - my $self = $proto->new_native($dbh); - $dbh->disconnect; #silly DBI - $self; -} - -=item new_native DATABASE_HANDLE - -Creates a new DBIx::DBSchema object from the supplied DBI database handle. This -uses database-native methods to read the schema, and will preserve any -non-portable column types. The method is only available if there is a -DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and -PostgreSQL). +Creates a new DBIx::DBSchema object from an existing data source, which can be +specified by passing an open DBI database handle, or by passing the DBI data +source name, username and password. This uses database-native methods to read +the schema, and will preserve any non-portable column types. The method is +only available if there is a DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and PostgreSQL). =cut sub new_native { - my($proto, $dbh) = @_; + my($proto, $dbh) = (shift, _dbh(@_) ); $proto->new( map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh) ); @@ -138,18 +130,41 @@ 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 sub load { my($proto,$file)=@_; #use $proto ? - open(FILE,"<$file") or die "Can't open $file: $!"; - my($string)=join('',); #can $string have newlines? pry not? - close FILE or die "Can't close $file: $!"; - my($self)=thaw $string; - #no bless needed? + + my $self; + + #first try Storable + eval { $self = Storable::retrieve($file); }; + + if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw + my $olderror = $@; + + eval "use FreezeThaw;"; + 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; + } =item save FILENAME @@ -159,14 +174,8 @@ Saves a DBIx::DBSchema object to a file. =cut sub save { - my($self,$file)=@_; - my($string)=freeze $self; - open(FILE,">$file") or die "Can't open $file: $!"; - print FILE $string; - close FILE or die "Can't close file: $!"; - my($check_self)=thaw $string; - die "Verify error: Can't freeze and thaw dbdef $self" - if (cmpStr($self,$check_self)); + #my($self, $file) = @_; + Storable::nstore(@_); } =item addtable TABLE_OBJECT @@ -202,22 +211,108 @@ sub table { $self->{'tables'}->{$table}; } -=item sql_string [ DATASRC ] +=item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ] Returns a list of SQL `CREATE' statements for this schema. -If passed a DBI data source such as `DBI:mysql:database' or +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 the quoting and type mapping will be more +reliable. + +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 if there is no driver for the specified -database, will attempt to use generic SQL syntax. +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 -sub sql_string { - my($self, $datasrc) = @_; - map { $self->table($_)->sql_create_table($datasrc); } $self->tables; +sub sql { + 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 ); + + } + + } + + # 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 @@ -235,10 +330,18 @@ sub pretty_print { "'$table' => {\n". " 'columns' => [\n". join("", map { + #cant because -w complains about , in qw() + # (also biiiig problems with empty lengths) + #" qw( $_ ". + #$self->table($table)->column($_)->type. " ". + #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ". + #$self->table($table)->column($_)->length. " ),\n" " '$_', ". "'". $self->table($table)->column($_)->type. "', ". - "'". $self->table($table)->column($_)->null. "', ". - "'". $self->table($table)->column($_)->length. "'\n" + "'". $self->table($table)->column($_)->null. "', ". + "'". $self->table($table)->column($_)->length. "', ". + "'". $self->table($table)->column($_)->default. "', ". + "'". $self->table($table)->column($_)->local. "',\n" } $self->table($table)->columns ). " ],\n". @@ -253,7 +356,7 @@ sub pretty_print { ). " ],\n" #" 'index' => [ ". " ],\n" } $self->tables - ), "}\n"; + ). "}\n"; } =cut @@ -266,23 +369,35 @@ B method. =cut sub pretty_read { - die "unimplemented (pull from fs-setup)"; - my($proto) = @_; + my($proto, $href) = @_; + my $schema = $proto->new( map { + my(@columns); + while ( @{$href->{$_}{'columns'}} ) { + push @columns, DBIx::DBSchema::Column->new( + splice @{$href->{$_}{'columns'}}, 0, 6 + ); + } + DBIx::DBSchema::Table->new( + $_, + $href->{$_}{'primary_key'}, + DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}), + DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}), + @columns, + ); + } (keys %{$href}) ); } # private subroutines -sub _load_driver { - my($dbh) = @_; - my $driver = $dbh->{Driver}->{Name}; - #require "DBIx/DBSchema/DBD/$driver.pm"; - #$driver; - eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver; -} - sub _tables_from_dbh { my($dbh) = @_; - my $sth = $dbh->table_info or die $dbh->errstr; + my $driver = _load_driver($dbh); + my $db_catalog = + scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_catalog"); + my $db_schema = + scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_schema"); + my $sth = $dbh->table_info($db_catalog, $db_schema, '', 'TABLE') + or die $dbh->errstr; #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' } # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) }; map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i } @@ -291,13 +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 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 @@ -305,17 +432,39 @@ 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). -pretty_print is atrocious. +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, L, L, -L, L, L, -L, L, L +L, L, +L, L, L, +L =cut