Fixes for dropping nullability on old Pg (<= 7.2)
[DBIx-DBSchema.git] / DBSchema.pm
1 package DBIx::DBSchema;
2
3 use strict;
4 use vars qw(@ISA $VERSION $DEBUG $errstr);
5 #use Exporter;
6 use Storable;
7 use DBIx::DBSchema::_util qw(_load_driver _dbh);
8 use DBIx::DBSchema::Table 0.03;
9 use DBIx::DBSchema::Column;
10 use DBIx::DBSchema::ColGroup::Unique;
11 use DBIx::DBSchema::ColGroup::Index;
12
13 #@ISA = qw(Exporter);
14 @ISA = ();
15
16 $VERSION = "0.32";
17 $DEBUG = 0;
18
19 =head1 NAME
20
21 DBIx::DBSchema - Database-independent schema objects
22
23 =head1 SYNOPSIS
24
25   use DBIx::DBSchema;
26
27   $schema = new DBIx::DBSchema @dbix_dbschema_table_objects;
28   $schema = new_odbc DBIx::DBSchema $dbh;
29   $schema = new_odbc DBIx::DBSchema $dsn, $user, $pass;
30   $schema = new_native DBIx::DBSchema $dbh;
31   $schema = new_native DBIx::DBSchema $dsn, $user, $pass;
32
33   $schema->save("filename");
34   $schema = load DBIx::DBSchema "filename" or die $DBIx::DBSchema::errstr;
35
36   $schema->addtable($dbix_dbschema_table_object);
37
38   @table_names = $schema->tables;
39
40   $DBIx_DBSchema_table_object = $schema->table("table_name");
41
42   @sql = $schema->sql($dbh);
43   @sql = $schema->sql($dsn, $username, $password);
44   @sql = $schema->sql($dsn); #doesn't connect to database - less reliable
45
46   $perl_code = $schema->pretty_print;
47   %hash = eval $perl_code;
48   use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash;
49
50 =head1 DESCRIPTION
51
52 DBIx::DBSchema objects are collections of DBIx::DBSchema::Table objects and
53 represent a database schema.
54
55 This module implements an OO-interface to database schemas.  Using this module,
56 you can create a database schema with an OO Perl interface.  You can read the
57 schema from an existing database.  You can save the schema to disk and restore
58 it a different process.  You can write SQL CREATE statements statements for
59 different databases from a single source.  In recent versions, you can
60 transform one schema to another, adding any necessary new columsn and tables.
61
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
66 Base Class".
67
68 =head1 METHODS
69
70 =over 4
71
72 =item new TABLE_OBJECT, TABLE_OBJECT, ...
73
74 Creates a new DBIx::DBSchema object.
75
76 =cut
77
78 sub new {
79   my($proto, @tables) = @_;
80   my %tables = map  { $_->name, $_ } @tables; #check for duplicates?
81
82   my $class = ref($proto) || $proto;
83   my $self = {
84     'tables' => \%tables,
85   };
86
87   bless ($self, $class);
88
89 }
90
91 =item new_odbc DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
92
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
103 driver.
104
105 =cut
106
107 sub new_odbc {
108   my($proto, $dbh) = ( shift, _dbh(@_) );
109   $proto->new(
110     map { new_odbc DBIx::DBSchema::Table $dbh, $_ } _tables_from_dbh($dbh)
111   );
112 }
113
114 =item new_native DATABASE_HANDLE | DATA_SOURCE USERNAME PASSWORD [ ATTR ]
115
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).
121
122 =cut
123
124 sub new_native {
125   my($proto, $dbh) = (shift, _dbh(@_) );
126   $proto->new(
127     map { new_native DBIx::DBSchema::Table ( $dbh, $_ ) } _tables_from_dbh($dbh)
128   );
129 }
130
131 =item load FILENAME
132
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;
135
136 =cut
137
138 sub load {
139   my($proto,$file)=@_; #use $proto ?
140
141   my $self;
142
143   #first try Storable
144   eval { $self = Storable::retrieve($file); };
145
146   if ( $@ && $@ =~ /not.*storable/i ) { #then try FreezeThaw
147     my $olderror = $@;
148
149     eval "use FreezeThaw;";
150     if ( $@ ) {
151       $@ = $olderror;
152     } else { 
153       open(FILE,"<$file")
154         or do { $errstr = "Can't open $file: $!"; return ''; };
155       my $string = join('',<FILE>);
156       close FILE
157         or do { $errstr = "Can't close $file: $!"; return ''; };
158       ($self) = FreezeThaw::thaw($string);
159     }
160   }
161
162   unless ( $self ) {
163     $errstr = $@;
164   }
165
166   $self;
167
168 }
169
170 =item save FILENAME
171
172 Saves a DBIx::DBSchema object to a file.
173
174 =cut
175
176 sub save {
177   #my($self, $file) = @_;
178   Storable::nstore(@_);
179 }
180
181 =item addtable TABLE_OBJECT
182
183 Adds the given DBIx::DBSchema::Table object to this DBIx::DBSchema.
184
185 =cut
186
187 sub addtable {
188   my($self,$table)=@_;
189   $self->{'tables'}->{$table->name} = $table; #check for dupliates?
190 }
191
192 =item tables 
193
194 Returns a list of the names of all tables.
195
196 =cut
197
198 sub tables {
199   my($self)=@_;
200   keys %{$self->{'tables'}};
201 }
202
203 =item table TABLENAME
204
205 Returns the specified DBIx::DBSchema::Table object.
206
207 =cut
208
209 sub table {
210   my($self,$table)=@_;
211   $self->{'tables'}->{$table};
212 }
213
214 =item sql [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
215
216 Returns a list of SQL `CREATE' statements for this schema.
217
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.  
220
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 the quoting and type mapping will be more
224 reliable.
225
226 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
227 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
228 Currently supported databases are MySQL and PostgreSQL.
229
230 If not passed a data source (or handle), or if there is no driver for the
231 specified database, will attempt to use generic SQL syntax.
232
233 =cut
234
235 sub sql {
236   my($self, $dbh) = ( shift, _dbh(@_) );
237   map { $self->table($_)->sql_create_table($dbh); } $self->tables;
238 }
239
240 =item sql_update_schema PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
241
242 Returns a list of SQL statements to update this schema so that it is idential
243 to the provided prototype schema, also a DBIx::DBSchema object.
244
245  #Optionally, the data source can be specified by passing an open DBI database
246  #handle, or by passing the DBI data source name, username and password.  
247  #
248  #If passed a DBI data source (or handle) such as `DBI:mysql:database' or
249  #`DBI:Pg:dbname=database', will use syntax specific to that database engine.
250  #Currently supported databases are MySQL and PostgreSQL.
251  #
252  #If not passed a data source (or handle), or if there is no driver for the
253  #specified database, will attempt to use generic SQL syntax.
254
255 Right now this method knows how to add new tables and alter existing tables.
256 It doesn't know how to drop tables yet.
257
258 See L<DBIx::DBSchema::Table/sql_alter_table>,
259 L<DBIx::DBSchema::Column/sql_add_coumn> and
260 L<DBIx::DBSchema::Column/sql_alter_column> for additional specifics and
261 limitations.
262
263 =cut
264
265 #gosh, false laziness w/DBSchema::Table::sql_alter_schema
266
267 sub sql_update_schema {
268   my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
269
270   my @r = ();
271
272   foreach my $table ( $new->tables ) {
273   
274     if ( $self->table($table) ) {
275   
276       warn "$table exists\n" if $DEBUG > 1;
277
278       push @r,
279         $self->table($table)->sql_alter_table( $new->table($table), $dbh );
280
281     } else {
282   
283       warn "table $table does not exist.\n" if $DEBUG;
284
285       push @r, 
286         $new->table($table)->sql_create_table( $dbh );
287   
288     }
289   
290   }
291
292   # should eventually drop tables not in $new
293
294   warn join("\n", @r). "\n"
295     if $DEBUG;
296
297   @r;
298   
299 }
300
301 =item update_schema PROTOTYPE_SCHEMA, DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ]
302
303 Same as sql_update_schema, except actually runs the SQL commands to update
304 the schema.  Throws a fatal error if any statement fails.
305
306 =cut
307
308 sub update_schema {
309   my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
310
311   foreach my $statement ( $self->sql_update_schema( $new, $dbh ) ) {
312     $dbh->do( $statement )
313       or die "Error: ". $dbh->errstr. "\n executing: $statement";
314   }
315
316 }
317
318 =item pretty_print
319
320 Returns the data in this schema as Perl source, suitable for assigning to a
321 hash.
322
323 =cut
324
325 sub pretty_print {
326   my($self) = @_;
327   join("},\n\n",
328     map {
329       my $table = $_;
330       "'$table' => {\n".
331         "  'columns' => [\n".
332           join("", map { 
333                          #cant because -w complains about , in qw()
334                          # (also biiiig problems with empty lengths)
335                          #"    qw( $_ ".
336                          #$self->table($table)->column($_)->type. " ".
337                          #( $self->table($table)->column($_)->null ? 'NULL' : 0 ). " ".
338                          #$self->table($table)->column($_)->length. " ),\n"
339                          "    '$_', ".
340                          "'". $self->table($table)->column($_)->type. "', ".
341                          "'". $self->table($table)->column($_)->null. "', ". 
342                          "'". $self->table($table)->column($_)->length. "', ".
343                          "'". $self->table($table)->column($_)->default. "', ".
344                          "'". $self->table($table)->column($_)->local. "',\n"
345                        } $self->table($table)->columns
346           ).
347         "  ],\n".
348         "  'primary_key' => '". $self->table($table)->primary_key. "',\n".
349         "  'unique' => [ ". join(', ',
350           map { "[ '". join("', '", @{$_}). "' ]" }
351             @{$self->table($table)->unique->lol_ref}
352           ).  " ],\n".
353         "  'index' => [ ". join(', ',
354           map { "[ '". join("', '", @{$_}). "' ]" }
355             @{$self->table($table)->index->lol_ref}
356           ). " ],\n"
357         #"  'index' => [ ".    " ],\n"
358     } $self->tables
359   ). "}\n";
360 }
361
362 =cut
363
364 =item pretty_read HASHREF
365
366 Creates a schema as specified by a data structure such as that created by
367 B<pretty_print> method.
368
369 =cut
370
371 sub pretty_read {
372   my($proto, $href) = @_;
373   my $schema = $proto->new( map {  
374     my(@columns);
375     while ( @{$href->{$_}{'columns'}} ) {
376       push @columns, DBIx::DBSchema::Column->new(
377         splice @{$href->{$_}{'columns'}}, 0, 6
378       );
379     }
380     DBIx::DBSchema::Table->new(
381       $_,
382       $href->{$_}{'primary_key'},
383       DBIx::DBSchema::ColGroup::Unique->new($href->{$_}{'unique'}),
384       DBIx::DBSchema::ColGroup::Index->new($href->{$_}{'index'}),
385       @columns,
386     );
387   } (keys %{$href}) );
388 }
389
390 # private subroutines
391
392 sub _tables_from_dbh {
393   my($dbh) = @_;
394   my $driver = _load_driver($dbh);
395   my $db_catalog =
396     scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_catalog");
397   my $db_schema  =
398     scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_schema");
399   my $sth = $dbh->table_info($db_catalog, $db_schema, '', 'TABLE')
400     or die $dbh->errstr;
401   #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
402   #  @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
403   map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
404     @{ $sth->fetchall_arrayref([2,3]) };
405 }
406
407 =back
408
409 =head1 AUTHORS
410
411 Ivan Kohler <ivan-dbix-dbschema@420.am>
412
413 Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman
414 <mitchell.friedman@numethods.com> contributed the start of a Sybase driver.
415
416 Daniel Hanks <hanksdc@about-inc.com> contributed the Oracle driver.
417
418 Jesse Vincent contributed the SQLite driver.
419
420 =head1 CONTRIBUTIONS
421
422 Contributions are welcome!  I'm especially keen on any interest in the first
423 three items/projects below under BUGS.
424
425 =head1 COPYRIGHT
426
427 Copyright (c) 2000-2006 Ivan Kohler
428 Copyright (c) 2000 Mail Abuse Prevention System LLC
429 All rights reserved.
430 This program is free software; you can redistribute it and/or modify it under
431 the same terms as Perl itself.
432
433 =head1 BUGS
434
435 Indices are not stored by name.  Index representation could use an overhaul.
436
437 Multiple primary keys are not yet supported.
438
439 Foreign keys and other constraints are not yet supported.
440
441 Eventually it would be nice to have additional transformations (deleted,
442 modified columns, added/modified/indices (probably need em named first),
443 added/deleted tables
444
445 Need to port and test with additional databases
446
447 Each DBIx::DBSchema object should have a name which corresponds to its name
448 within the SQL database engine (DBI data source).
449
450 pretty_print is actually pretty ugly.
451
452 Perhaps pretty_read should eval column types so that we can use DBI
453 qw(:sql_types) here instead of externally.
454
455 sql CREATE TABLE output should convert integers
456 (i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
457 to fudge things
458
459 sql_update_schema doesn't drop tables yet.
460
461 =head1 SEE ALSO
462
463 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,
464 L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
465 L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
466 L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
467 L<DBI>
468
469 =cut
470
471 1;
472