no DEFAULT for mysql, patch from trs@bestpractical, CPAN#58505
[DBIx-DBSchema.git] / DBSchema.pm
index a84246e..44a76a2 100644 (file)
@@ -1,19 +1,19 @@
 package DBIx::DBSchema;
 
 use strict;
-use vars qw($VERSION $DEBUG $errstr);
 use Storable;
 use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
 use DBIx::DBSchema::Table 0.08;
 use DBIx::DBSchema::Index;
 use DBIx::DBSchema::Column;
-use DBIx::DBSchema::ColGroup::Unique;
-use DBIx::DBSchema::ColGroup::Index;
+use DBIx::DBSchema::ForeignKey;
 
-$VERSION = "0.37_04";
+our $VERSION = '0.44';
 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
-$DEBUG = 0;
+our $DEBUG = 0;
+
+our $errstr;
 
 =head1 NAME
 
@@ -55,9 +55,8 @@ 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 in 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 columns and tables
-(and, as of 0.33, indices).
+different databases from a single source.  You can transform one schema to
+another, adding any necessary new columns, tables, indices and foreign keys.
 
 Currently supported databases are MySQL, PostgreSQL and SQLite.  Sybase and
 Oracle drivers are partially implemented.  DBIx::DBSchema will attempt to use
@@ -236,7 +235,10 @@ specified database, will attempt to use generic SQL syntax.
 
 sub sql {
   my($self, $dbh) = ( shift, _dbh(@_) );
-  map { $self->table($_)->sql_create_table($dbh); } $self->tables;
+  ( 
+    ( map { $self->table($_)->sql_create_table($dbh); } $self->tables ),
+    ( map { $self->table($_)->sql_add_constraints($dbh); } $self->tables ),
+  );
 }
 
 =item sql_update_schema [ OPTIONS_HASHREF, ] PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
@@ -250,7 +252,7 @@ with B<drop_tables> set true before all other arguments, it will also drop
 tables.
 
 See L<DBIx::DBSchema::Table/sql_alter_table>,
-L<DBIx::DBSchema::Column/sql_add_coumn> and
+L<DBIx::DBSchema::Column/sql_add_column> and
 L<DBIx::DBSchema::Column/sql_alter_column> for additional specifics and
 limitations.
 
@@ -279,6 +281,7 @@ sub sql_update_schema {
   my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 
   my @r = ();
+  my @later = ();
 
   foreach my $table ( $new->tables ) {
   
@@ -286,17 +289,19 @@ sub sql_update_schema {
   
       warn "$table exists\n" if $DEBUG > 1;
 
-      push @r, $self->table($table)->sql_alter_table( $new->table($table),
-                                                      $dbh,
-                                                      $opt
-                                                    );
+      push @r,
+        $self->table($table)->sql_alter_table( $new->table($table),
+                                                 $dbh, $opt );
+      push @later,
+        $self->table($table)->sql_alter_constraints( $new->table($table),
+                                                       $dbh, $opt );
 
     } else {
   
       warn "table $table does not exist.\n" if $DEBUG;
 
-      push @r, 
-        $new->table($table)->sql_create_table( $dbh );
+      push @r,     $new->table($table)->sql_create_table(    $dbh );
+      push @later, $new->table($table)->sql_add_constraints( $dbh );
   
     }
   
@@ -317,6 +322,8 @@ sub sql_update_schema {
 
   }
 
+  push @r, @later;
+
   warn join("\n", @r). "\n"
     if $DEBUG > 1;
 
@@ -371,7 +378,12 @@ sub pretty_print {
                          "'". $table->column($_)->type. "', ".
                          "'". $table->column($_)->null. "', ". 
                          "'". $table->column($_)->length. "', ".
-                         "'". $table->column($_)->default. "', ".
+
+                         ( ref($table->column($_)->default)
+                             ? "\\'". ${ $table->column($_)->default }. "'"
+                             : "'". $table->column($_)->default. "'"
+                         ).', '.
+
                          "'". $table->column($_)->local. "',\n"
                        } $table->columns
           ).
@@ -415,18 +427,29 @@ sub pretty_print {
               }
               keys %indices
 
-        ). "\n               }, \n"
+        ). "\n               }, \n".
+
+        #foreign_keys
+        "  'foreign_keys' => [ ". join( ",\n                 ",
+
+          map { my $name = $_->constraint;
+                "'$name' => { \n".
+                "                 },\n";
+              }
+            $table->foreign_keys
+
+        ). "\n               ], \n"
+
+      ;
 
     } $self->tables
   ). "}\n";
 }
 
-=cut
-
 =item pretty_read HASHREF
 
 This method is B<not> recommended.  If you need to load and save your schema
-to a file, see the L</load|load> and L</save|save> methods.
+to a file, see the L</load> and L</save> methods.
 
 Creates a schema as specified by a data structure such as that created by
 B<pretty_print> method.
@@ -453,11 +476,7 @@ sub pretty_read {
       'primary_key' => $info->{'primary_key'},
       'columns'     => \@columns,
 
-      #old-style indices 
-      'unique'      => DBIx::DBSchema::ColGroup::Unique->new($info->{'unique'}),
-      'index'       => DBIx::DBSchema::ColGroup::Index->new($info->{'index'}),
-
-      #new-style indices
+      #indices
       'indices'     => [ map { my $idx_info = $info->{'indices'}{$_};
                                DBIx::DBSchema::Index->new({
                                  'name'    => $_,
@@ -517,7 +536,7 @@ items/projects below under BUGS.
 
 Copyright (c) 2000-2007 Ivan Kohler
 Copyright (c) 2000 Mail Abuse Prevention System LLC
-Copyright (c) 2007-2010 Freeside Internet Services, Inc.
+Copyright (c) 2007-2013 Freeside Internet Services, Inc.
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
@@ -526,15 +545,22 @@ the same terms as Perl itself.
 
 Multiple primary keys are not yet supported.
 
-Foreign keys and other constraints are not yet supported.
-
-sql_update_schema doesn't deal with deleted columns yet.
+Foreign keys: need to support dropping, NOT VALID, reverse engineering w/mysql
 
 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).
 
+Need to support "using" index attribute in pretty_read and in reverse
+engineering
+
+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
+
+=head2 PRETTY_ BUGS
+
 pretty_print is actually pretty ugly.
 
 pretty_print isn't so good about quoting values...  save/load is a much better
@@ -548,16 +574,9 @@ when nothing is given in the read.
 Perhaps pretty_read should eval column types so that we can use DBI
 qw(:sql_types) here instead of externally.
 
-Need to support "using" index attribute in pretty_read and in reverse
-engineering
-
 perhaps we should just get rid of pretty_read entirely.  pretty_print is useful
 for debugging, but pretty_read is pretty bunk.
 
-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
-
 =head1 SEE ALSO
 
 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::Index>,