lib/SQL/Translator/Producer/SQL/PostgreSQL.pm

   1 use MooseX::Declare;
   2 role SQL::Translator::Producer::SQL::PostgreSQL {
   3     use SQL::Translator::Constants qw(:sqlt_types :sqlt_constants);
   4     use SQL::Translator::Types qw(Column Constraint Index Table View);
   5 my ( %index_name );
   6 my $max_id_length;
   7
   8 #BEGIN {
   9
  10 my %translate  = (
  11     #
  12     # MySQL types
  13     #
  14     bigint     => 'bigint',
  15     double     => 'numeric',
  16     decimal    => 'numeric',
  17     float      => 'numeric',
  18     int        => 'integer',
  19     mediumint  => 'integer',
  20     smallint   => 'smallint',
  21     tinyint    => 'smallint',
  22     char       => 'character',
  23     varchar    => 'character varying',
  24     longtext   => 'text',
  25     mediumtext => 'text',
  26     text       => 'text',
  27     tinytext   => 'text',
  28     tinyblob   => 'bytea',
  29     blob       => 'bytea',
  30     mediumblob => 'bytea',
  31     longblob   => 'bytea',
  32     enum       => 'character varying',
  33     set        => 'character varying',
  34     date       => 'date',
  35     datetime   => 'timestamp',
  36     time       => 'time',
  37     timestamp  => 'timestamp',
  38     year       => 'date',
  39
  40     #
  41     # Oracle types
  42     #
  43     number     => 'integer',
  44     char       => 'character',
  45     varchar2   => 'character varying',
  46     long       => 'text',
  47     CLOB       => 'bytea',
  48     date       => 'date',
  49
  50     #
  51     # Sybase types
  52     #
  53     int        => 'integer',
  54     money      => 'money',
  55     varchar    => 'character varying',
  56     datetime   => 'timestamp',
  57     text       => 'text',
  58     real       => 'numeric',
  59     comment    => 'text',
  60     bit        => 'bit',
  61     tinyint    => 'smallint',
  62     float      => 'numeric',
  63 );
  64
  65  $max_id_length = 62;
  66 #}
  67 my %reserved = map { $_, 1 } qw[
  68     ALL ANALYSE ANALYZE AND ANY AS ASC
  69     BETWEEN BINARY BOTH
  70     CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
  71     CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
  72     DEFAULT DEFERRABLE DESC DISTINCT DO
  73     ELSE END EXCEPT
  74     FALSE FOR FOREIGN FREEZE FROM FULL
  75     GROUP HAVING
  76     ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
  77     JOIN LEADING LEFT LIKE LIMIT
  78     NATURAL NEW NOT NOTNULL NULL
  79     OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
  80     PRIMARY PUBLIC REFERENCES RIGHT
  81     SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
  82     UNION UNIQUE USER USING VERBOSE WHEN WHERE
  83 ];
  84
  85 # my $max_id_length    = 62;
  86 my %used_names;
  87 my %used_identifiers = ();
  88 my %global_names;
  89 my %unreserve;
  90 my %truncated;
  91
  92 # -------------------------------------------------------------------
  93 method produce {
  94     my $translator = $self->translator;
  95 #    local $DEBUG         = $translator->debug;
  96 #    local $WARN          = $translator->show_warnings;
  97     my $no_comments      = $translator->no_comments;
  98     my $add_drop_table   = $translator->add_drop_table;
  99     my $schema           = $translator->schema;
 100     my $pargs            = $translator->producer_args;
 101     my $postgres_version = $pargs->{postgres_version} || 0;
 102
 103     my $qt = $translator->quote_table_names ? q{"} : q{};
 104     my $qf = $translator->quote_field_names ? q{"} : q{};
 105
 106     my @output;
 107     push @output, $self->header_comment unless ($no_comments);
 108
 109     my (@table_defs, @fks);
 110     for my $table ( $schema->get_tables ) {
 111
 112         my ($table_def, $fks) = $self->create_table($table, {
 113             quote_table_names => $qt,
 114             quote_field_names => $qf,
 115             no_comments       => $no_comments,
 116             postgres_version  => $postgres_version,
 117             add_drop_table    => $add_drop_table,
 118         });
 119
 120         push @table_defs, $table_def;
 121         push @fks, @$fks;
 122     }
 123
 124     for my $view ( $schema->get_views ) {
 125       push @table_defs, $self->create_view($view, {
 126         add_drop_view     => $add_drop_table,
 127         quote_table_names => $qt,
 128         quote_field_names => $qf,
 129         no_comments       => $no_comments,
 130       });
 131     }
 132
 133     push @output, map { "$_;\n\n" } @table_defs;
 134     if ( @fks ) {
 135         push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
 136         push @output, map { "$_;\n\n" } @fks;
 137     }
 138
 139 #    if ( $WARN ) {
 140 #        if ( %truncated ) {
 141 #            warn "Truncated " . keys( %truncated ) . " names:\n";
 142 #            warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
 143 #        }
 144
 145 #        if ( %unreserve ) {
 146 #            warn "Encounted " . keys( %unreserve ) .
 147 #                " unsafe names in schema (reserved or invalid):\n";
 148 #            warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
 149 #        }
 150 #    }
 151
 152     return wantarray
 153         ? @output
 154         : join ('', @output);
 155 }
 156
 157 # -------------------------------------------------------------------
 158 method mk_name($basename = '', $type = '', $scope = '', $critical = '') {
 159     my $basename_orig = $basename;
 160 #    my $max_id_length = 62;
 161     my $max_name      = $type
 162                         ? $max_id_length - (length($type) + 1)
 163                         : $max_id_length;
 164     $basename         = substr( $basename, 0, $max_name )
 165                         if length( $basename ) > $max_name;
 166     my $name          = $type ? "${type}_$basename" : $basename;
 167
 168     if ( $basename ne $basename_orig and $critical ) {
 169         my $show_type = $type ? "+'$type'" : "";
 170 #        warn "Truncating '$basename_orig'$show_type to $max_id_length ",
 171 #            "character limit to make '$name'\n" if $WARN;
 172         $truncated{ $basename_orig } = $name;
 173     }
 174
 175     $scope ||= \%global_names;
 176     if ( my $prev = $scope->{ $name } ) {
 177         my $name_orig = $name;
 178         $name        .= sprintf( "%02d", ++$prev );
 179         substr($name, $max_id_length - 3) = "00"
 180             if length( $name ) > $max_id_length;
 181
 182 #        warn "The name '$name_orig' has been changed to ",
 183 #             "'$name' to make it unique.\n" if $WARN;
 184
 185         $scope->{ $name_orig }++;
 186     }
 187
 188     $scope->{ $name }++;
 189     return $name;
 190 }
 191
 192 # -------------------------------------------------------------------
 193 method unreserve($name = '', $schema_obj_name = '') {
 194     my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
 195
 196     # also trap fields that don't begin with a letter
 197     return $name if (!$reserved{ uc $name }) && $name =~ /^[a-z]/i;
 198
 199     if ( $schema_obj_name ) {
 200         ++$unreserve{"$schema_obj_name.$name"};
 201     }
 202     else {
 203         ++$unreserve{"$name (table name)"};
 204     }
 205
 206     my $unreserve = sprintf '%s_', $name;
 207     return $unreserve.$suffix;
 208 }
 209
 210 # -------------------------------------------------------------------
 211 method next_unused_name($orig_name?) {
 212     return unless $orig_name;
 213     my $name      = $orig_name;
 214
 215     my $suffix_gen = sub {
 216         my $suffix = 0;
 217         return ++$suffix ? '' : $suffix;
 218     };
 219
 220     for (;;) {
 221         $name = $orig_name . $suffix_gen->();
 222         last if $used_names{ $name }++;
 223     }
 224
 225     return $name;
 226 }
 227
 228 method create_table(Table $table, $options?) {
 229     my $qt = $options->{quote_table_names} || '';
 230     my $qf = $options->{quote_field_names} || '';
 231     my $no_comments = $options->{no_comments} || 0;
 232     my $add_drop_table = $options->{add_drop_table} || 0;
 233     my $postgres_version = $options->{postgres_version} || 0;
 234
 235     my $table_name = $table->name or next;
 236     my ( $fql_tbl_name ) = ( $table_name =~ s/\W(.*)$// ) ? $1 : q{};
 237     my $table_name_ur = $qt ? $table_name
 238         : $fql_tbl_name ? join('.', $table_name, $self->unreserve($fql_tbl_name))
 239         : $self->unreserve($table_name);
 240     $table->name($table_name_ur);
 241
 242 # print STDERR "$table_name table_name\n";
 243     my ( @comments, @field_defs, @sequence_defs, @constraint_defs, @type_defs, @type_drops, @fks );
 244
 245     push @comments, "--\n-- Table: $table_name_ur\n--\n" unless $no_comments;
 246
 247     if ( $table->comments and !$no_comments ){
 248         my $c = "-- Comments: \n-- ";
 249         $c .= join "\n-- ", $table->comments;
 250         $c .= "\n--\n";
 251         push @comments, $c;
 252     }
 253
 254     #
 255     # Fields
 256     #
 257     my %field_name_scope;
 258     for my $field ( $table->get_fields ) {
 259         push @field_defs, $self->create_field($field, { quote_table_names => $qt,
 260                                                  quote_field_names => $qf,
 261                                                  table_name => $table_name_ur,
 262                                                  postgres_version => $postgres_version,
 263                                                  type_defs => \@type_defs,
 264                                                  type_drops => \@type_drops,
 265                                                  constraint_defs => \@constraint_defs,});
 266     }
 267
 268     #
 269     # Index Declarations
 270     #
 271     my @index_defs = ();
 272  #   my $idx_name_default;
 273     for my $index ( $table->get_indices ) {
 274         my ($idef, $constraints) = $self->create_index($index,
 275                                               {
 276                                                   quote_field_names => $qf,
 277                                                   quote_table_names => $qt,
 278                                                   table_name => $table_name,
 279                                               });
 280         $idef and push @index_defs, $idef;
 281         push @constraint_defs, @$constraints;
 282     }
 283
 284     #
 285     # Table constraints
 286     #
 287     my $c_name_default;
 288     for my $c ( $table->get_constraints ) {
 289         my ($cdefs, $fks) = $self->create_constraint($c,
 290                                               {
 291                                                   quote_field_names => $qf,
 292                                                   quote_table_names => $qt,
 293                                                   table_name => $table_name,
 294                                               });
 295         push @constraint_defs, @$cdefs;
 296         push @fks, @$fks;
 297     }
 298
 299     my $temporary = "";
 300
 301     if(exists $table->{extra}{temporary}) {
 302         $temporary = $table->{extra}{temporary} ? "TEMPORARY " : "";
 303     }
 304
 305     my $create_statement;
 306     $create_statement = join("\n", @comments);
 307     if ($add_drop_table) {
 308         if ($postgres_version >= 8.2) {
 309             $create_statement .= qq[DROP TABLE IF EXISTS $qt$table_name_ur$qt CASCADE;\n];
 310             $create_statement .= join (";\n", @type_drops) . ";\n"
 311                 if $postgres_version >= 8.3 && scalar @type_drops;
 312         } else {
 313             $create_statement .= qq[DROP TABLE $qt$table_name_ur$qt CASCADE;\n];
 314         }
 315     }
 316     $create_statement .= join(";\n", @type_defs) . ";\n"
 317         if $postgres_version >= 8.3 && scalar @type_defs;
 318     $create_statement .= qq[CREATE ${temporary}TABLE $qt$table_name_ur$qt (\n].
 319                             join( ",\n", map { "  $_" } @field_defs, @constraint_defs ) .
 320                             "\n)" ;
 321
 322     $create_statement .= @index_defs ? ';' : q{};
 323     $create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
 324         . join(";\n", @index_defs);
 325
 326     return $create_statement, \@fks;
 327 }
 328
 329 method create_view(View $view, $options?) {
 330     my $qt = $options->{quote_table_names} || '';
 331     my $qf = $options->{quote_field_names} || '';
 332     my $add_drop_view = $options->{add_drop_view};
 333
 334     my $view_name = $view->name;
 335
 336     my $create = '';
 337     $create .= "--\n-- View: ${qt}${view_name}${qt}\n--\n"
 338         unless $options->{no_comments};
 339     $create .= "DROP VIEW ${qt}${view_name}${qt};\n" if $add_drop_view;
 340     $create .= 'CREATE';
 341
 342     my $extra = $view->extra;
 343     $create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
 344     $create .= " VIEW ${qt}${view_name}${qt}";
 345
 346     if ( my @fields = $view->fields ) {
 347         my $field_list = join ', ', map { "${qf}${_}${qf}" } @fields;
 348         $create .= " ( ${field_list} )";
 349     }
 350
 351     if ( my $sql = $view->sql ) {
 352         $create .= " AS\n    ${sql}\n";
 353     }
 354
 355     if ( $extra->{check_option} ) {
 356         $create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
 357     }
 358
 359     return $create;
 360 }
 361
 362 {
 363
 364     my %field_name_scope;
 365
 366     method create_field(Column $field, $options?) {
 367         my $qt = $options->{quote_table_names} || '';
 368         my $qf = $options->{quote_field_names} || '';
 369         my $table_name = $field->table->name;
 370         my $constraint_defs = $options->{constraint_defs} || [];
 371         my $postgres_version = $options->{postgres_version} || 0;
 372         my $type_defs = $options->{type_defs} || [];
 373         my $type_drops = $options->{type_drops} || [];
 374
 375         $field_name_scope{$table_name} ||= {};
 376         my $field_name    = $field->name;
 377         my $field_name_ur = $qf ? $field_name : $self->unreserve($field_name, $table_name );
 378         $field->name($field_name_ur);
 379         my $field_comments = $field->comments
 380             ? "-- " . $field->comments . "\n  "
 381             : '';
 382
 383         my $field_def     = $field_comments.qq[$qf$field_name_ur$qf];
 384
 385         #
 386         # Datatype
 387         #
 388         my @size      = $field->size;
 389         my $data_type = lc $field->data_type;
 390         my %extra     = $field->extra;
 391         my $list      = $extra{'list'} || [];
 392         # todo deal with embedded quotes
 393         my $commalist = join( ', ', map { qq['$_'] } @$list );
 394
 395         if ($postgres_version >= 8.3 && $field->data_type eq 'enum') {
 396             my $type_name = $field->table->name . '_' . $field->name . '_type';
 397             $field_def .= ' '. $type_name;
 398             push @$type_defs, "CREATE TYPE $type_name AS ENUM ($commalist)";
 399             push @$type_drops, "DROP TYPE IF EXISTS $type_name";
 400         } else {
 401             $field_def .= ' '. $self->convert_datatype($field);
 402         }
 403
 404         #
 405         # Default value
 406         #
 407         my $default = $field->default_value;
 408         $field_def .= $self->_default_value($default, [ 'NULL'=> \'NULL', 'now()' => 'now()', 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP', ] ) if defined $default;
 409
 410         #
 411         # Not null constraint
 412         #
 413         $field_def .= ' NOT NULL' unless $field->is_nullable;
 414
 415         return $field_def;
 416     }
 417 }
 418
 419 method create_index(Index $index, $options?) {
 420     my $qt = $options->{quote_table_names} ||'';
 421     my $qf = $options->{quote_field_names} ||'';
 422     my $table_name = $index->table->name;
 423 #        my $table_name_ur = $qt ? $self->unreserve($table_name) : $table_name;
 424
 425     my ($index_def, @constraint_defs);
 426
 427     my $name = $self->next_unused_name(
 428         $index->name
 429         || join('_', $table_name, 'idx', ++$index_name{ $table_name })
 430     );
 431
 432     my $type = $index->type || NORMAL;
 433     my @fields     =
 434         map { $_ =~ s/\(.+\)//; $_ }
 435     map { $qt ? $_ : $self->unreserve($_, $table_name ) }
 436     $index->fields;
 437     return ('', []) unless @fields;
 438
 439     my $def_start = qq[CONSTRAINT "$name" ];
 440     if ( $type eq PRIMARY_KEY ) {
 441         push @constraint_defs, "${def_start}PRIMARY KEY ".
 442             '(' .$qf . join( $qf. ', '.$qf, @fields ) . $qf . ')';
 443     }
 444     elsif ( $type eq UNIQUE ) {
 445         push @constraint_defs, "${def_start}UNIQUE " .
 446             '(' . $qf . join( $qf. ', '.$qf, @fields ) . $qf.')';
 447     }
 448     elsif ( $type eq NORMAL ) {
 449         $index_def =
 450             "CREATE INDEX ${qf}${name}${qf} on ${qt}${table_name}${qt} (".
 451             join( ', ', map { qq[$qf$_$qf] } @fields ).
 452             ')'
 453             ;
 454     }
 455     else {
 456 #        warn "Unknown index type ($type) on table $table_name.\n"
 457 #            if $WARN;
 458     }
 459
 460     return $index_def, \@constraint_defs;
 461 }
 462
 463 method create_constraint(Constraint $c, $options?) {
 464     my $qf = $options->{quote_field_names} ||'';
 465     my $qt = $options->{quote_table_names} ||'';
 466     my $table_name = $c->table->name;
 467     my (@constraint_defs, @fks);
 468
 469     my $name = $c->name || '';
 470     if ( $name ) {
 471         $name = $self->next_unused_name($name);
 472     }
 473
 474     my @fields     =
 475         map { $_ =~ s/\(.+\)//; $_ }
 476     map { $qt ? $_ : $self->unreserve( $_, $table_name )}
 477     $c->fields;
 478     my @rfields     =
 479         map { $_ =~ s/\(.+\)//; $_ }
 480     map { $qt ? $_ : $self->unreserve( $_, $table_name )}
 481     $c->reference_fields;
 482     return ([], []) if !@fields && $c->type ne CHECK_C;
 483
 484     my $def_start = $name ? qq[CONSTRAINT "$name" ] : '';
 485     if ( $c->type eq PRIMARY_KEY ) {
 486         push @constraint_defs, "${def_start}PRIMARY KEY ".
 487             '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 488     }
 489     elsif ( $c->type eq UNIQUE ) {
 490         $name = $self->next_unused_name($name);
 491         push @constraint_defs, "${def_start}UNIQUE " .
 492             '('.$qf . join( $qf.', '.$qf, @fields ) . $qf.')';
 493     }
 494     elsif ( $c->type eq CHECK_C ) {
 495         my $expression = $c->expression;
 496         push @constraint_defs, "${def_start}CHECK ($expression)";
 497     }
 498     elsif ( $c->type eq FOREIGN_KEY ) {
 499         my $def .= "ALTER TABLE ${qt}${table_name}${qt} ADD FOREIGN KEY (" .
 500             join( ', ', map { qq[$qf$_$qf] } @fields ) . ')' .
 501             "\n  REFERENCES " . $qt . $c->reference_table . $qt;
 502
 503         if ( @rfields ) {
 504             $def .= ' ('.$qf . join( $qf.', '.$qf, @rfields ) . $qf.')';
 505         }
 506
 507         if ( $c->match_type ) {
 508             $def .= ' MATCH ' . ( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
 509         }
 510
 511 #        if ( $c->on_delete ) {
 512 #            $def .= ' ON DELETE '.join( ' ', $c->on_delete );
 513 #        }
 514
 515 #        if ( $c->on_update ) {
 516 #            $def .= ' ON UPDATE '.join( ' ', $c->on_update );
 517 #        }
 518
 519         if ( $c->deferrable ) {
 520             $def .= ' DEFERRABLE';
 521         }
 522
 523         push @fks, "$def";
 524     }
 525
 526     return \@constraint_defs, \@fks;
 527 }
 528
 529 method convert_datatype(Column $field) {
 530     my @size      = $field->size;
 531     my $data_type = lc $field->data_type;
 532
 533     if ( $data_type eq 'enum' ) {
 534 #        my $len = 0;
 535 #        $len = ($len < length($_)) ? length($_) : $len for (@$list);
 536 #        my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
 537 #        push @$constraint_defs,
 538 #        qq[CONSTRAINT "$chk_name" CHECK ($qf$field_name$qf ].
 539 #           qq[IN ($commalist))];
 540         $data_type = 'character varying';
 541     }
 542     elsif ( $data_type eq 'set' ) {
 543         $data_type = 'character varying';
 544     }
 545     elsif ( $field->is_auto_increment ) {
 546         if ( defined $size[0] && $size[0] > 11 ) {
 547             $data_type = 'bigserial';
 548         }
 549         else {
 550             $data_type = 'serial';
 551         }
 552         undef @size;
 553     }
 554     else {
 555         $data_type  = defined $translate{ $data_type } ?
 556             $translate{ $data_type } :
 557             $data_type;
 558     }
 559
 560     if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
 561         if ( defined $size[0] && $size[0] > 6 ) {
 562             $size[0] = 6;
 563         }
 564     }
 565
 566     if ( $data_type eq 'integer' ) {
 567         if ( defined $size[0] && $size[0] > 0) {
 568             if ( $size[0] > 10 ) {
 569                 $data_type = 'bigint';
 570             }
 571             elsif ( $size[0] < 5 ) {
 572                 $data_type = 'smallint';
 573             }
 574             else {
 575                 $data_type = 'integer';
 576             }
 577         }
 578         else {
 579             $data_type = 'integer';
 580         }
 581     }
 582
 583     my $type_with_size = join('|',
 584         'bit', 'varbit', 'character', 'bit varying', 'character varying',
 585         'time', 'timestamp', 'interval'
 586     );
 587
 588     if ( $data_type !~ /$type_with_size/ ) {
 589         @size = ();
 590     }
 591
 592     if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
 593         $data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
 594         $data_type .= $2 if(defined $2);
 595     } elsif ( defined $size[0] && $size[0] > 0 ) {
 596         $data_type .= '(' . join( ',', @size ) . ')';
 597     }
 598
 599     return $data_type;
 600 }
 601
 602
 603 method alter_field(Column $from_field, Column $to_field) {
 604     die "Can't alter field in another table"
 605         if($from_field->table->name ne $to_field->table->name);
 606
 607     my @out;
 608     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
 609                        $to_field->table->name,
 610                        $to_field->name) if(!$to_field->is_nullable and
 611                                            $from_field->is_nullable);
 612
 613     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
 614                       $to_field->table->name,
 615                       $to_field->name)
 616        if ( !$from_field->is_nullable and $to_field->is_nullable );
 617
 618
 619     my $from_dt = $self->convert_datatype($from_field);
 620     my $to_dt   = $self->convert_datatype($to_field);
 621     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
 622                        $to_field->table->name,
 623                        $to_field->name,
 624                        $to_dt) if($to_dt ne $from_dt);
 625
 626     push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
 627                        $to_field->table->name,
 628                        $from_field->name,
 629                        $to_field->name) if($from_field->name ne $to_field->name);
 630
 631     my $old_default = $from_field->default_value;
 632     my $new_default = $to_field->default_value;
 633     my $default_value = $to_field->default_value;
 634
 635     # fixes bug where output like this was created:
 636     # ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
 637     if(ref $default_value eq "SCALAR" ) {
 638         $default_value = $$default_value;
 639     } elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
 640         $default_value =~ s/'/''/xsmg;
 641         $default_value = q(') . $default_value . q(');
 642     }
 643
 644     push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
 645                        $to_field->table->name,
 646                        $to_field->name,
 647                        $default_value)
 648         if ( defined $new_default &&
 649              (!defined $old_default || $old_default ne $new_default) );
 650
 651      # fixes bug where removing the DEFAULT statement of a column
 652      # would result in no change
 653
 654      push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
 655                        $to_field->table->name,
 656                        $to_field->name)
 657         if ( !defined $new_default && defined $old_default );
 658
 659
 660     return wantarray ? @out : join("\n", @out);
 661 }
 662
 663 method rename_field(@args) { $self->alter_field(@args) }
 664
 665 method add_field(Column $new_field) {
 666     my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
 667                       $new_field->table->name,
 668                       $self->create_field($new_field));
 669     return $out;
 670
 671 }
 672
 673 method drop_field(Column $old_field) {
 674     my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
 675                       $old_field->table->name,
 676                       $old_field->name);
 677
 678     return $out;
 679 }
 680
 681 method alter_table(Column $to_table, $options?) {
 682     my $qt = $options->{quote_table_names} || '';
 683     my $out = sprintf('ALTER TABLE %s %s',
 684                       $qt . $to_table->name . $qt,
 685                       $options->{alter_table_action});
 686     return $out;
 687 }
 688
 689 method rename_table(Table $old_table, Table $new_table, $options?) {
 690     my $qt = $options->{quote_table_names} || '';
 691     $options->{alter_table_action} = "RENAME TO $qt$new_table$qt";
 692     return alter_table($old_table, $options);
 693 }
 694
 695 method alter_create_index(Index $index, $options?) {
 696     my $qt = $options->{quote_table_names} || '';
 697     my $qf = $options->{quote_field_names} || '';
 698     my ($idef, $constraints) = create_index($index, {
 699         quote_field_names => $qf,
 700         quote_table_names => $qt,
 701         table_name => $index->table->name,
 702     });
 703     return $index->type eq NORMAL ? $idef
 704         : sprintf('ALTER TABLE %s ADD %s',
 705               $qt . $index->table->name . $qt,
 706               join(q{}, @$constraints)
 707           );
 708 }
 709
 710 method alter_drop_index(Index $index, $options?) {
 711     my $index_name = $index->name;
 712     return "DROP INDEX $index_name";
 713 }
 714
 715 method alter_drop_constraint(Constraint $c, $options?) {
 716     my $qt = $options->{quote_table_names} || '';
 717     my $qc = $options->{quote_field_names} || '';
 718     my $out = sprintf('ALTER TABLE %s DROP CONSTRAINT %s',
 719                       $qt . $c->table->name . $qt,
 720                       $qc . $c->name . $qc );
 721     return $out;
 722 }
 723
 724 method alter_create_constraint(Index $index, $options?) {
 725     my $qt = $options->{quote_table_names} || '';
 726     my ($defs, $fks) = create_constraint(@_);
 727
 728     # return if there are no constraint definitions so we don't run
 729     # into output like this:
 730     # ALTER TABLE users ADD ;
 731
 732     return unless(@{$defs} || @{$fks});
 733     return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
 734         : join( ' ', 'ALTER TABLE', $qt.$index->table->name.$qt,
 735               'ADD', join(q{}, @{$defs}, @{$fks})
 736           );
 737 }
 738
 739 method drop_table(Str $table, $options?) {
 740     my $qt = $options->{quote_table_names} || '';
 741     return "DROP TABLE $qt$table$qt CASCADE";
 742 }
 743
 744     method header_comment($producer?, $comment_char?) {
 745         $producer ||= caller;
 746         my $now = scalar localtime;
 747         my $DEFAULT_COMMENT = '-- ';
 748
 749         $comment_char = $DEFAULT_COMMENT
 750             unless defined $comment_char;
 751
 752         my $header_comment =<<"HEADER_COMMENT";
 753             ${comment_char}
 754             ${comment_char}Created by $producer
 755             ${comment_char}Created on $now
 756             ${comment_char}
 757 HEADER_COMMENT
 758
 759         # Any additional stuff passed in
 760         for my $additional_comment (@_) {
 761             $header_comment .= "${comment_char}${additional_comment}\n";
 762         }
 763
 764         return $header_comment;
 765     }
 766 }