+=item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statements to alter this table so that it is identical
+to the provided table, also a DBIx::DBSchema::Table object.
+
+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::sql_update_schema
+
+sub sql_alter_table {
+ my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+
+ my $driver = _load_driver($dbh);
+
+ my $table = $self->name;
+
+ my @r = ();
+ my @r_later = ();
+ my $tempnum = 1;
+
+ ###
+ # columns (add/alter)
+ ###
+
+ foreach my $column ( $new->columns ) {
+
+ if ( $self->column($column) ) {
+
+ warn " $table.$column exists\n" if $DEBUG > 1;
+
+ push @r,
+ $self->column($column)->sql_alter_column( $new->column($column), $dbh );
+
+ } else {
+
+ warn "column $table.$column does not exist.\n" if $DEBUG > 1;
+
+ push @r,
+ $new->column($column)->sql_add_column( $dbh );
+
+ }
+
+ }
+
+ #should eventually drop columns not in $new...
+
+ ###
+ # indices
+ ###
+
+ my %old_indices = $self->indices;
+ my %new_indices = $new->indices;
+
+ foreach my $old ( keys %old_indices ) {
+
+ if ( exists( $new_indices{$old} )
+ && $old_indices{$old}->cmp( $new_indices{$old} )
+ )
+ {
+ warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
+ delete $old_indices{$old};
+ delete $new_indices{$old};
+
+ } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
+
+ my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
+ keys %new_indices;
+
+ if ( @same ) {
+
+ #warn if there's more than one?
+ my $same = shift @same;
+
+ warn "index $table.$old is identical to $same; renaming\n"
+ if $DEBUG > 1;
+
+ my $temp = 'dbs_temp'.$tempnum++;
+
+ push @r, "ALTER INDEX $old RENAME TO $temp";
+ push @r_later, "ALTER INDEX $temp RENAME TO $same";
+
+ delete $old_indices{$old};
+ delete $new_indices{$same};
+
+ }
+
+ }
+
+ }
+
+ foreach my $old ( keys %old_indices ) {
+ warn "removing obsolete index $table.$old ON ( ".
+ $old_indices{$old}->columns_sql. " )\n"
+ if $DEBUG > 1;
+ push @r, "DROP INDEX $old".
+ ( $driver eq 'mysql' ? " ON $table" : '');
+ }
+
+ foreach my $new ( keys %new_indices ) {
+ warn "creating new index $table.$new\n" if $DEBUG > 1;
+ push @r, $new_indices{$new}->sql_create_index($table);
+ }
+
+ ###
+ # columns (drop)
+ ###
+
+ foreach my $column ( grep !$new->column($_), $self->columns ) {
+
+ warn "column $table.$column should be dropped.\n" if $DEBUG;
+
+ push @r, $self->column($column)->sql_drop_column( $dbh );
+
+ }
+
+ ###
+ # return the statements
+ ###
+
+ push @r, @r_later;
+
+ warn join('', map "$_\n", @r)
+ if $DEBUG && @r;
+
+ @r;
+
+}
+
+sub sql_drop_table {
+ my( $self, $dbh ) = ( shift, _dbh(@_) );
+
+ my $name = $self->name;
+
+ ("DROP TABLE $name");
+}
projects / DBIx-DBSchema.git / blobdiff