1 package DBIx::DBSchema;
4 use vars qw($VERSION $DEBUG $errstr);
6 use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
7 use DBIx::DBSchema::Table 0.08;
8 use DBIx::DBSchema::Index;
9 use DBIx::DBSchema::Column;
10 use DBIx::DBSchema::ColGroup::Unique;
11 use DBIx::DBSchema::ColGroup::Index;
14 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
20 DBIx::DBSchema - Database-independent schema objects
26 $schema = new DBIx::DBSchema @dbix_dbschema_table_objects;
27 $schema = new_odbc DBIx::DBSchema $dbh;
28 $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass;
29 $schema = new_native DBIx::DBSchema $dbh;
30 $schema = new_native DBIx::DBSchema $dsn, $user, $pass;
32 $schema->save("filename");
33 $schema = load DBIx::DBSchema "filename" or die $DBIx::DBSchema::errstr;
35 $schema->addtable($dbix_dbschema_table_object);
37 @table_names = $schema->tables;
39 $DBIx_DBSchema_table_object = $schema->table("table_name");
41 @sql = $schema->sql($dbh);
42 @sql = $schema->sql($dsn, $username, $password);
43 @sql = $schema->sql($dsn); #doesn't connect to database - less reliable
45 $perl_code = $schema->pretty_print;
46 %hash = eval $perl_code;
47 use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash;
51 DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and
52 represent a database schema.
54 This module implements an OO-interface to database schemas. Using this module,
55 you can create a database schema with an OO Perl interface. You can read the
56 schema from an existing database. You can save the schema to disk and restore
57 it in a different process. You can write SQL CREATE statements statements for
58 different databases from a single source. In recent versions, you can
59 transform one schema to another, adding any necessary new columns and tables
60 (and, as of 0.33, indices).
62 Currently supported databases are MySQL, PostgreSQL and SQLite. Sybase and
63 Oracle drivers are partially implemented. DBIx::DBSchema will attempt to use
64 generic SQL syntax for other databases. Assistance adding support for other
65 databases is welcomed. See L<DBIx::DBSchema::DBD>, "Driver Writer's Guide and
72 =item new TABLE_OBJECT, TABLE_OBJECT, ...
74 Creates a new DBIx::DBSchema object.
79 my($proto, @tables) = @_;
80 my %tables = map { $_->name, $_ } @tables; #check for duplicates?
82 my $class = ref($proto) || $proto;
87 bless ($self, $class);
91 =item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
93 Creates a new DBIx::DBSchema object from an existing data source, which can be
94 specified by passing an open DBI database handle, or by passing the DBI data
95 source name, username, and password. This uses the experimental DBI type_info
96 method to create a schema with standard (ODBC) SQL column types that most
97 closely correspond to any non-portable column types. Use this to import a
98 schema that you wish to use with many different database engines. Although
99 primary key and (unique) index information will only be read from databases
100 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
101 column names and attributes *should* work for any database. Note that this
102 method only uses "ODBC" column types; it does not require or use an ODBC
108 my($proto, $dbh) = ( shift, _dbh(@_) );
110 map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh)
114 =item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
116 Creates a new DBIx::DBSchema object from an existing data source, which can be
117 specified by passing an open DBI database handle, or by passing the DBI data
118 source name, username and password. This uses database-native methods to read
119 the schema, and will preserve any non-portable column types. The method is
120 only available if there is a DBIx::DBSchema::DBD for the corresponding database engine (currently, MySQL and PostgreSQL).
125 my($proto, $dbh) = (shift, _dbh(@_) );
127 map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh)
133 Loads a DBIx::DBSchema object from a file. If there is an error, returns
134 false and puts an error message in $DBIx::DBSchema::errstr;
139 my($proto,$file)=@_; #use $proto ?
144 eval { $self = Storable::retrieve($file); };
146 if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw
149 eval "use FreezeThaw;";
154 or do { $errstr = "Can't open $file: $!"; return ''; };
155 my $string = join('',<FILE>);
157 or do { $errstr = "Can't close $file: $!"; return ''; };
158 ($self) = FreezeThaw::thaw($string);
172 Saves a DBIx::DBSchema object to a file.
177 #my($self, $file) = @_;
178 Storable::nstore(@_);
181 =item addtable TABLE_OBJECT
183 Adds the given DBIx::DBSchema::Table object to this DBIx::DBSchema.
189 $self->{'tables'}->{$table->name} = $table; #check for dupliates?
194 Returns a list of the names of all tables.
200 keys %{$self->{'tables'}};
203 =item table TABLENAME
205 Returns the specified DBIx::DBSchema::Table object.
211 $self->{'tables'}->{$table};
214 =item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
216 Returns a list of SQL `CREATE' statements for this schema.
218 The data source can be specified by passing an open DBI database handle, or by
219 passing the DBI data source name, username and password.
221 Although the username and password are optional, it is best to call this method
222 with a database handle or data source including a valid username and password -
223 a DBI connection will be opened and used to check the database version as well
224 as for more reliable quoting and type mapping. Note that the database
225 connection will be used passively, B<not> to actually run the CREATE
228 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
229 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
230 Currently supported databases are MySQL and PostgreSQL.
232 If not passed a data source (or handle), or if there is no driver for the
233 specified database, will attempt to use generic SQL syntax.
238 my($self, $dbh) = ( shift, _dbh(@_) );
239 map { $self->table($_)->sql_create_table($dbh); } $self->tables;
242 =item sql_update_schema [ OPTIONS_HASHREF, ] PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
244 Returns a list of SQL statements to update this schema so that it is idential
245 to the provided prototype schema, also a DBIx::DBSchema object.
247 Right now this method knows how to add new tables and alter existing tables,
248 including indices. If specifically requested by passing an options hashref
249 with B<drop_tables> set true before all other arguments, it will also drop
252 See L<DBIx::DBSchema::Table/sql_alter_table>,
253 L<DBIx::DBSchema::Column/sql_add_column> and
254 L<DBIx::DBSchema::Column/sql_alter_column> for additional specifics and
257 The data source can be specified by passing an open DBI database handle, or by
258 passing the DBI data source name, username and password.
260 Although the username and password are optional, it is best to call this method
261 with a database handle or data source including a valid username and password -
262 a DBI connection will be opened and used to check the database version as well
263 as for more reliable quoting and type mapping. Note that the database
264 connection will be used passively, B<not> to actually run the CREATE
267 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
268 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
269 Currently supported databases are MySQL and PostgreSQL.
271 If not passed a data source (or handle), or if there is no driver for the
272 specified database, will attempt to use generic SQL syntax.
276 #gosh, false laziness w/DBSchema::Table::sql_alter_schema
278 sub sql_update_schema {
279 my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
283 foreach my $table ( $new->tables ) {
285 if ( $self->table($table) ) {
287 warn "$table exists\n" if $DEBUG > 1;
289 push @r, $self->table($table)->sql_alter_table( $new->table($table),
296 warn "table $table does not exist.\n" if $DEBUG;
299 $new->table($table)->sql_create_table( $dbh );
305 if ( $opt->{'drop_tables'} ) {
307 warn "drop_tables enabled\n" if $DEBUG;
309 # drop tables not in $new
310 foreach my $table ( grep !$new->table($_), $self->tables ) {
312 warn "table $table should be dropped.\n" if $DEBUG;
314 push @r, $self->table($table)->sql_drop_table( $dbh );
320 warn join("\n", @r). "\n"
327 =item update_schema [ OPTIONS_HASHREF, ] PROTOTYPE_SCHEMA, DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ]
329 Same as sql_update_schema, except actually runs the SQL commands to update
330 the schema. Throws a fatal error if any statement fails.
335 #my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
336 my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
338 foreach my $statement ( $self->sql_update_schema( $opt, $new, $dbh ) ) {
339 $dbh->do( $statement )
340 or die "Error: ". $dbh->errstr. "\n executing: $statement";
347 Returns the data in this schema as Perl source, suitable for assigning to a
358 my $table = $self->table($tablename);
359 my %indices = $table->indices;
361 "'$tablename' => {\n".
364 #cant because -w complains about , in qw()
365 # (also biiiig problems with empty lengths)
367 #$table->column($_)->type. " ".
368 #( $table->column($_)->null ? 'NULL' : 0 ). " ".
369 #$table->column($_)->length. " ),\n"
371 "'". $table->column($_)->type. "', ".
372 "'". $table->column($_)->null. "', ".
373 "'". $table->column($_)->length. "', ".
375 ( ref($table->column($_)->default)
376 ? "\\'". ${ $table->column($_)->default }. "'"
377 : "'". $table->column($_)->default. "'"
380 "'". $table->column($_)->local. "',\n"
384 " 'primary_key' => '". $table->primary_key. "',\n".
386 #old style index representation..
389 $table->{'unique'} # $table->_unique
390 ? " 'unique' => [ ". join(', ',
391 map { "[ '". join("', '", @{$_}). "' ]" }
392 @{$table->_unique->lol_ref}
397 ( $table->{'index'} # $table->_index
398 ? " 'index' => [ ". join(', ',
399 map { "[ '". join("', '", @{$_}). "' ]" }
400 @{$table->_index->lol_ref}
406 " 'indices' => { ". join( ",\n ",
408 map { my $iname = $_;
409 my $index = $indices{$iname};
412 ? " 'using' => '". $index->using ."',\n"
415 " 'unique' => ". $index->unique .",\n".
417 join("', '", @{$index->columns} ).
431 =item pretty_read HASHREF
433 This method is B<not> recommended. If you need to load and save your schema
434 to a file, see the L</load|load> and L</save|save> methods.
436 Creates a schema as specified by a data structure such as that created by
437 B<pretty_print> method.
442 my($proto, $href) = @_;
444 my $schema = $proto->new( map {
447 my $info = $href->{$tablename};
450 while ( @{$info->{'columns'}} ) {
451 push @columns, DBIx::DBSchema::Column->new(
452 splice @{$info->{'columns'}}, 0, 6
456 DBIx::DBSchema::Table->new({
457 'name' => $tablename,
458 'primary_key' => $info->{'primary_key'},
459 'columns' => \@columns,
462 'unique' => DBIx::DBSchema::ColGroup::Unique->new($info->{'unique'}),
463 'index' => DBIx::DBSchema::ColGroup::Index->new($info->{'index'}),
466 'indices' => [ map { my $idx_info = $info->{'indices'}{$_};
467 DBIx::DBSchema::Index->new({
470 'unique' => $idx_info->{'unique'},
471 'columns' => $idx_info->{'columns'},
474 keys %{ $info->{'indices'} }
482 # private subroutines
484 sub _tables_from_dbh {
486 my $driver = _load_driver($dbh);
488 scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_catalog");
490 scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_schema");
491 my $sth = $dbh->table_info($db_catalog, $db_schema, '', 'TABLE')
493 #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
494 # @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
495 map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
496 @{ $sth->fetchall_arrayref([2,3]) };
503 Ivan Kohler <ivan-dbix-dbschema@420.am>
505 Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman
506 <mitchell.friedman@numethods.com> contributed the start of a Sybase driver.
508 Daniel Hanks <hanksdc@about-inc.com> contributed the Oracle driver.
510 Jesse Vincent contributed the SQLite driver and fixes to quiet down
511 internal usage of the old API.
513 Slaven Rezic <srezic@cpan.org> contributed column and table dropping, Pg
518 Contributions are welcome! I'm especially keen on any interest in the top
519 items/projects below under BUGS.
523 Copyright (c) 2000-2007 Ivan Kohler
524 Copyright (c) 2000 Mail Abuse Prevention System LLC
525 Copyright (c) 2007-2013 Freeside Internet Services, Inc.
527 This program is free software; you can redistribute it and/or modify it under
528 the same terms as Perl itself.
532 Multiple primary keys are not yet supported.
534 Foreign keys and other constraints are not yet supported.
536 sql_update_schema doesn't deal with deleted columns yet.
538 Need to port and test with additional databases
540 Each DBIx::DBSchema object should have a name which corresponds to its name
541 within the SQL database engine (DBI data source).
543 pretty_print is actually pretty ugly.
545 pretty_print isn't so good about quoting values... save/load is a much better
546 alternative to using pretty_print/pretty_read
548 pretty_read is pretty ugly too.
550 pretty_read should *not* create and pass in old-style unique/index indices
551 when nothing is given in the read.
553 Perhaps pretty_read should eval column types so that we can use DBI
554 qw(:sql_types) here instead of externally.
556 Need to support "using" index attribute in pretty_read and in reverse
559 perhaps we should just get rid of pretty_read entirely. pretty_print is useful
560 for debugging, but pretty_read is pretty bunk.
562 sql CREATE TABLE output should convert integers
563 (i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
568 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::Index>,
569 L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
570 L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,