projects / DBIx-DBSchema.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
0.38
[DBIx-DBSchema.git] / DBSchema.pm
diff --git a/DBSchema.pm b/DBSchema.pm
index 9266480..643e174 100644 (file)
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -1,19 +1,18 @@
 package DBIx::DBSchema;
 
 use strict;
 package DBIx::DBSchema;
 
 use strict;
-use vars qw(@ISA $VERSION $DEBUG $errstr);
-#use Exporter;
+use vars qw($VERSION $DEBUG $errstr);
 use Storable;
 use Storable;
-use DBIx::DBSchema::_util qw(_load_driver _dbh);
-use DBIx::DBSchema::Table 0.03;
+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::Column;
 use DBIx::DBSchema::ColGroup::Unique;
 use DBIx::DBSchema::ColGroup::Index;
 
-#@ISA = qw(Exporter);
-@ISA = ();
+$VERSION = "0.38_01";
+$VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
 
-$VERSION = "0.32";
 $DEBUG = 0;
 
 =head1 NAME
 $DEBUG = 0;
 
 =head1 NAME
@@ -55,13 +54,16 @@ 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
 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 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).
 
 
-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<DBIx::DBSchema::DBD>, "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<DBIx::DBSchema::DBD>, "Driver Writer's Guide and
+Base Class".
 
 =head1 METHODS
 
 
 =head1 METHODS
 
@@ -218,8 +220,10 @@ 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 -
 
 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.
+a DBI connection will be opened and used to check the database version as well
+as for more reliable quoting and type mapping.  Note that the database
+connection will be used passively, B<not> to actually run the CREATE
+statements.
 
 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.
 
 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.
@@ -235,35 +239,44 @@ sub sql {
   map { $self->table($_)->sql_create_table($dbh); } $self->tables;
 }
 
   map { $self->table($_)->sql_create_table($dbh); } $self->tables;
 }
 
-=item sql_update_schema PROTOTYPE_SCHEMA [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+=item sql_update_schema [ OPTIONS_HASHREF, ] 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.
 
 
 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.
+Right now this method knows how to add new tables and alter existing tables,
+including indices.  If specifically requested by passing an options hashref
+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_alter_column> for additional specifics and
 limitations.
 
 
 See L<DBIx::DBSchema::Table/sql_alter_table>,
 L<DBIx::DBSchema::Column/sql_add_coumn> and
 L<DBIx::DBSchema::Column/sql_alter_column> for additional specifics and
 limitations.
 
+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 used to check the database version as well
+as for more reliable quoting and type mapping.  Note that the database
+connection will be used passively, B<not> to actually run the CREATE
+statements.
+
+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.
+
 =cut
 
 #gosh, false laziness w/DBSchema::Table::sql_alter_schema
 
 sub sql_update_schema {
 =cut
 
 #gosh, false laziness w/DBSchema::Table::sql_alter_schema
 
 sub sql_update_schema {
-  my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+  my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 
   my @r = ();
 
 
   my @r = ();
 
@@ -273,8 +286,10 @@ sub sql_update_schema {
   
       warn "$table exists\n" if $DEBUG > 1;
 
   
       warn "$table exists\n" if $DEBUG > 1;
 
-      push @r,
-        $self->table($table)->sql_alter_table( $new->table($table), $dbh );
+      push @r, $self->table($table)->sql_alter_table( $new->table($table),
+                                                      $dbh,
+                                                      $opt
+                                                    );
 
     } else {
   
 
     } else {
   
@@ -287,16 +302,29 @@ sub sql_update_schema {
   
   }
 
   
   }
 
-  # should eventually drop tables not in $new
+  if ( $opt->{'drop_tables'} ) {
+
+    warn "drop_tables enabled\n" if $DEBUG;
+
+    # drop tables not in $new
+    foreach my $table ( grep !$new->table($_), $self->tables ) {
+
+      warn "table $table should be dropped.\n" if $DEBUG;
+
+      push @r, $self->table($table)->sql_drop_table( $dbh );
+
+    }
+
+  }
 
   warn join("\n", @r). "\n"
 
   warn join("\n", @r). "\n"
-    if $DEBUG;
+    if $DEBUG > 1;
 
   @r;
   
 }
 
 
   @r;
   
 }
 
-=item update_schema PROTOTYPE_SCHEMA, DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ]
+=item update_schema [ OPTIONS_HASHREF, ] 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.
 
 Same as sql_update_schema, except actually runs the SQL commands to update
 the schema.  Throws a fatal error if any statement fails.
@@ -304,9 +332,10 @@ the schema.  Throws a fatal error if any statement fails.
 =cut
 
 sub update_schema {
 =cut
 
 sub update_schema {
-  my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+  #my($self, $new, $dbh) = ( shift, shift, _dbh(@_) );
+  my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 
 
-  foreach my $statement ( $self->sql_update_schema( $new, $dbh ) ) {
+  foreach my $statement ( $self->sql_update_schema( $opt, $new, $dbh ) ) {
     $dbh->do( $statement )
       or die "Error: ". $dbh->errstr. "\n executing: $statement";
   }
     $dbh->do( $statement )
       or die "Error: ". $dbh->errstr. "\n executing: $statement";
   }
@@ -322,37 +351,77 @@ hash.
 
 sub pretty_print {
   my($self) = @_;
 
 sub pretty_print {
   my($self) = @_;
+
   join("},\n\n",
     map {
   join("},\n\n",
     map {
-      my $table = $_;
-      "'$table' => {\n".
+      my $tablename = $_;
+      my $table = $self->table($tablename);
+      my %indices = $table->indices;
+
+      "'$tablename' => {\n".
         "  'columns' => [\n".
           join("", map { 
                          #cant because -w complains about , in qw()
                          # (also biiiig problems with empty lengths)
                          #"    qw( $_ ".
         "  '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"
+                         #$table->column($_)->type. " ".
+                         #( $table->column($_)->null ? 'NULL' : 0 ). " ".
+                         #$table->column($_)->length. " ),\n"
                          "    '$_', ".
                          "    '$_', ".
-                         "'". $self->table($table)->column($_)->type. "', ".
-                         "'". $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
+                         "'". $table->column($_)->type. "', ".
+                         "'". $table->column($_)->null. "', ". 
+                         "'". $table->column($_)->length. "', ".
+
+                         ( ref($table->column($_)->default)
+                             ? "\\'". ${ $table->column($_)->default }. "'"
+                             : "'". $table->column($_)->default. "'"
+                         ).', '.
+
+                         "'". $table->column($_)->local. "',\n"
+                       } $table->columns
           ).
         "  ],\n".
           ).
         "  ],\n".
-        "  'primary_key' => '". $self->table($table)->primary_key. "',\n".
-        "  'unique' => [ ". join(', ',
-          map { "[ '". join("', '", @{$_}). "' ]" }
-            @{$self->table($table)->unique->lol_ref}
-          ).  " ],\n".
-        "  'index' => [ ". join(', ',
-          map { "[ '". join("', '", @{$_}). "' ]" }
-            @{$self->table($table)->index->lol_ref}
-          ). " ],\n"
-        #"  'index' => [ ".    " ],\n"
+        "  'primary_key' => '". $table->primary_key. "',\n".
+
+        #old style index representation..
+
+        ( 
+          $table->{'unique'} # $table->_unique
+            ? "  'unique' => [ ". join(', ',
+                map { "[ '". join("', '", @{$_}). "' ]" }
+                    @{$table->_unique->lol_ref}
+              ).  " ],\n"
+            : ''
+        ).
+
+        ( $table->{'index'} # $table->_index
+            ? "  'index' => [ ". join(', ',
+                map { "[ '". join("', '", @{$_}). "' ]" }
+                    @{$table->_index->lol_ref}
+              ). " ],\n"
+            : ''
+        ).
+
+        #new style indices
+        "  'indices' => { ". join( ",\n                 ",
+
+          map { my $iname = $_;
+                my $index = $indices{$iname};
+                "'$iname' => { \n".
+                  ( $index->using
+                      ? "              'using'  => '". $index->using ."',\n"
+                      : ''
+                  ).
+                  "                   'unique'  => ". $index->unique .",\n".
+                  "                   'columns' => [ '".
+                                              join("', '", @{$index->columns} ).
+                                              "' ],\n".
+                "                 },\n";
+              }
+              keys %indices
+
+        ). "\n               }, \n"
+
     } $self->tables
   ). "}\n";
 }
     } $self->tables
   ). "}\n";
 }
@@ -361,6 +430,9 @@ sub pretty_print {
 
 =item pretty_read HASHREF
 
 
 =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.
+
 Creates a schema as specified by a data structure such as that created by
 B<pretty_print> method.
 
 Creates a schema as specified by a data structure such as that created by
 B<pretty_print> method.
 
@@ -368,21 +440,43 @@ B<pretty_print> method.
 
 sub pretty_read {
   my($proto, $href) = @_;
 
 sub pretty_read {
   my($proto, $href) = @_;
+
   my $schema = $proto->new( map {  
   my $schema = $proto->new( map {  
-    my(@columns);
-    while ( @{$href->{$_}{'columns'}} ) {
+
+    my $tablename = $_;
+    my $info = $href->{$tablename};
+
+    my @columns;
+    while ( @{$info->{'columns'}} ) {
       push @columns, DBIx::DBSchema::Column->new(
       push @columns, DBIx::DBSchema::Column->new(
-        splice @{$href->{$_}{'columns'}}, 0, 6
+        splice @{$info->{'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,
-    );
+
+    DBIx::DBSchema::Table->new({
+      'name'        => $tablename,
+      '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'     => [ map { my $idx_info = $info->{'indices'}{$_};
+                               DBIx::DBSchema::Index->new({
+                                 'name'    => $_,
+                                 #'using'   =>
+                                 'unique'  => $idx_info->{'unique'},
+                                 'columns' => $idx_info->{'columns'},
+                               });
+                             }
+                             keys %{ $info->{'indices'} }
+                       ],
+    } );
+
   } (keys %{$href}) );
   } (keys %{$href}) );
+
 }
 
 # private subroutines
 }
 
 # private subroutines
@@ -413,32 +507,33 @@ Charles Shapiro <charles.shapiro@numethods.com> and Mitchell Friedman
 
 Daniel Hanks <hanksdc@about-inc.com> contributed the Oracle driver.
 
 
 Daniel Hanks <hanksdc@about-inc.com> contributed the Oracle driver.
 
-Jesse Vincent contributed the SQLite driver.
+Jesse Vincent contributed the SQLite driver and fixes to quiet down
+internal usage of the old API.
+
+Slaven Rezic <srezic@cpan.org> contributed column and table dropping, Pg
+bugfixes and more.
 
 =head1 CONTRIBUTIONS
 
 
 =head1 CONTRIBUTIONS
 
-Contributions are welcome!  I'm especially keen on any interest in the first
-three items/projects below under BUGS.
+Contributions are welcome!  I'm especially keen on any interest in the top
+items/projects below under BUGS.
 
 =head1 COPYRIGHT
 
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2006 Ivan Kohler
+Copyright (c) 2000-2007 Ivan Kohler
 Copyright (c) 2000 Mail Abuse Prevention System LLC
 Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2007-2010 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.
 
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
 
-=head1 BUGS
-
-Indices are not stored by name.  Index representation could use an overhaul.
+=head1 BUGS AND TODO
 
 Multiple primary keys are not yet supported.
 
 Foreign keys and other constraints are not yet supported.
 
 
 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
+sql_update_schema doesn't deal with deleted columns yet.
 
 Need to port and test with additional databases
 
 
 Need to port and test with additional databases
 
@@ -447,19 +542,30 @@ within the SQL database engine (DBI data source).
 
 pretty_print is actually pretty ugly.
 
 
 pretty_print is actually pretty ugly.
 
+pretty_print isn't so good about quoting values...  save/load is a much better
+alternative to using pretty_print/pretty_read
+
+pretty_read is pretty ugly too.
+
+pretty_read should *not* create and pass in old-style unique/index indices
+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.
 
 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
 
 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
 
 =head1 SEE ALSO
 
-L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,
-L<DBIx::DBSchema::ColGroup::Unique>, L<DBIx::DBSchema::ColGroup::Index>,
+L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::Index>,
 L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
 L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
 L<DBI>
 L<DBIx::DBSchema::Column>, L<DBIx::DBSchema::DBD>,
 L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>, L<FS::Record>,
 L<DBI>
Unnamed repository; edit this file 'description' to name the repository.