Add Sequence to Schema objects

lib/SQL/Translator.pm

@@ -61,7 +61,7 @@ has $_ => (
   is      => 'rw',
   default => quote_sub(q{ 0 }),
   coerce  => quote_sub(q{ $_[0] ? 1 : 0 }),
-) foreach qw(add_drop_table no_comments show_warnings trace validate);
+) foreach qw(add_drop_sequence add_drop_table no_comments show_warnings trace validate);
 
 # quote_identifiers is on by default, use a 0-but-true as indicator
 # so we can allow individual producers to change the default
@@ -701,6 +701,8 @@ SQL::Translator - manipulate structured data definitions (SQL and more)
       no_comments         => 0,
       # Print name mutations, conflicts
       show_warnings       => 0,
+      # Add "drop sequence" statements
+      add_drop_sequence   => 1,
       # Add "drop table" statements
       add_drop_table      => 1,
       # to quote or not to quote, thats the question
@@ -786,6 +788,10 @@ debug
 
 =item *
 
+add_drop_sequence
+
+=item *
+
 add_drop_table
 
 =item *
@@ -820,6 +826,11 @@ advantage is gained by passing options to the constructor.
 
 =head1 METHODS
 
+=head2 add_drop_sequence
+
+Toogles whether of not to add "DROP SEQUENCE" statements just before the
+create definitions.
+
 =head2 add_drop_table
 
 Toggles whether or not to add "DROP TABLE" statements just before the

lib/SQL/Translator/Diff.pm

@@ -20,11 +20,32 @@ has target_schema           => (is => 'rw',);
 has case_insensitive        => (is => 'rw',);
 has no_batch_alters         => (is => 'rw',);
 has ignore_missing_methods  => (is => 'rw',);
+has $_ => (
+  is      => 'rw',
+  default => quote_sub(q{ 0 }),
+  coerce  => quote_sub(q{ $_[0] ? 1 : 0 }),
+) foreach qw(add_drop_sequence add_drop_table no_comments show_warnings trace validate);
+
 has sqlt_args => (
   is      => 'rw',
   lazy    => 1,
   default => quote_sub '{}',
 );
+has sequences_to_drop => (
+  is      => 'rw',
+  lazy    => 1,
+  default => quote_sub '[]',
+);
+has sequences_to_create => (
+  is      => 'rw',
+  lazy    => 1,
+  default => quote_sub '[]',
+);
+has sequence_diff_hash => (
+  is      => 'rw',
+  lazy    => 1,
+  default => quote_sub '{}',
+);
 has tables_to_drop => (
   is      => 'rw',
   lazy    => 1,
@@ -42,10 +63,17 @@ has table_diff_hash => (
 );
 
 my @diff_arrays = qw/
+    sequences_to_drop
+    sequences_to_create
     tables_to_drop
     tables_to_create
     /;
 
+my @sequence_diff_hash_keys = qw/
+    sequence_options
+    sequence_renamed_from
+    /;
+
 my @diff_hash_keys = qw/
     constraints_to_create
     constraints_to_drop
@@ -72,7 +100,7 @@ sub schema_diff {
   $options ||= {};
 
   my $obj = SQL::Translator::Diff->new({
-    %$options,
+    %{$options},
     source_schema => $source_schema,
     target_schema => $target_schema,
     output_db     => $output_db
@@ -114,6 +142,48 @@ sub compute_differences {
     $preprocess->($target_schema);
   }
 
+  # Sequences
+  my %source_sequences_checked;
+  my @target_sequences = sort { $a->name cmp $b->name } $target_schema->get_sequences;
+  ## do source sequences exist in target?
+  for my $target_sequence (@target_sequences) {
+    my $target_sequence_name = $target_sequence->name;
+
+    my $source_sequence;
+    $self->sequence_diff_hash->{$target_sequence_name} = { map { $_ => [] } @diff_hash_keys };
+
+    if (my $old_name = $target_sequence->extra('renamed_from')) {
+      $source_sequence = $source_schema->get_sequence($old_name, $self->case_insensitive);
+      if ($source_sequence) {
+        $self->sequence_diff_hash->{$target_sequence_name}{sequence_renamed_from} = [ [ $source_sequence, $target_sequence ] ];
+      } else {
+        delete $target_sequence->extra->{renamed_from};
+        carp qq#Renamed sequence can't find old sequence "$old_name" for renamed table\n#;
+      }
+    } else {
+      $source_sequence = $source_schema->get_sequence($target_sequence_name, $self->case_insensitive);
+    }
+
+    unless ($source_sequence) {
+      ## sequence is new
+      ## add sequences(s) later.
+      push @{ $self->sequences_to_create }, $target_sequence;
+      next;
+    }
+    my $source_sequence_name = $source_sequence->name;
+    $source_sequence_name = lc $source_sequence_name if $self->case_insensitive;
+    $source_sequences_checked{$source_sequence_name} = 1;
+  }
+  for my $source_sequence ($source_schema->get_sequences) {
+    my $source_sequence_name = $source_sequence->name;
+
+    $source_sequence_name = lc $source_sequence_name if $self->case_insensitive;
+
+    push @{ $self->sequences_to_drop }, $source_sequence
+        unless $source_sequences_checked{$source_sequence_name};
+  }
+
+  # Tables
   my %src_tables_checked = ();
   my @tar_tables         = sort { $a->name cmp $b->name } $target_schema->get_tables;
   ## do original/source tables exist in target?
@@ -250,11 +320,51 @@ sub produce_diff_sql {
         ;
   }
 
+  # Sequences
+  # warn '$self:'.Dumper($self);
+  if (my @sequences = @{ $self->sequences_to_create }) {
+    my $translator = SQL::Translator->new(
+      producer_type     => $self->output_db,
+      add_drop_sequence => 0,
+      add_drop_table    => 0,
+      no_comments       => $self->{'no_comments'},
+
+      # TODO: sort out options
+      %{ $self->sqlt_args },
+    );
+    $translator->producer_args->{no_transaction} = 1;
+    foreach my $key (keys %{ $self->{'sqlt_args'} } ) {
+      # warn '$sqlt_args->{$key}:'.Dumper($self->{'sqlt_args'}->{$key});
+      $translator->producer_args->{$key} = $self->{'sqlt_args'}->{$key};
+    }
+    my $schema = $translator->schema;
+
+    # warn '@sequences:' . Dumper(\@sequences);
+    $schema->add_sequence($_) for @sequences;
+
+    unshift @diffs,
+
+        # Remove begin/commit here, since we wrap everything in one.
+        grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?)/ }
+        $producer_class->can('produce')->($translator);
+  }
+
+  if (my @sequences_to_drop = @{ $self->{sequences_to_drop} || [] }) {
+    my $meth = $producer_class->can('drop_sequence');
+
+    push @diffs,
+          $meth                         ? (map { $meth->($_, $self->sqlt_args) } @sequences_to_drop)
+        : $self->ignore_missing_methods ? "-- $producer_class cant drop_sequence"
+        :                                 die "$producer_class cant drop_sequence";
+  }
+
+  # Tables
   if (my @tables = @{ $self->tables_to_create }) {
     my $translator = SQL::Translator->new(
-      producer_type  => $self->output_db,
-      add_drop_table => 0,
-      no_comments    => 1,
+      producer_type     => $self->output_db,
+      add_drop_sequence => 0,
+      add_drop_table    => 0,
+      no_comments       => $self->{'no_comments'},
 
       # TODO: sort out options
       %{ $self->sqlt_args }

lib/SQL/Translator/Parser/PostgreSQL.pm

@@ -331,11 +331,23 @@ create : CREATE /TRIGGER/i trigger_name before_or_after database_events /ON/i ta
 
 sequence_id : NAME(s /\./)
     {
-        my @ids = @{ $item[1] };
-        my $column_id = { sequence_name => $ids[ $#ids ] };
-        $column_id->{'schema_name'} = $ids[ $#ids - 2] if ($#ids - 2 >= 0);
-        $column_id->{'database_name'} = $ids[ $#ids - 3] if ($#ids - 3 >= 0);
-        $return = $column_id;
+        my ($sequence_name, $schema_name, $database_name) = reverse @{ $item[1] };
+        $return = {
+            sequence_name => $sequence_name,
+            $schema_name   ? (schema_name   => $schema_name  ) : (),
+            $database_name ? (database_name => $database_name) : (),
+        };
+    }
+
+column_id : NAME(s /\./)
+    {
+        my ($column_name, $table_name, $schema_name, $database_name) = reverse @{ $item[1] };
+        $return = {
+            column_name => $column_name,
+            $table_name    ? (table_name    => $table_name   ) : (),
+            $schema_name   ? (schema_name   => $schema_name  ) : (),
+            $database_name ? (database_name => $database_name) : (),
+        };
     }
 
 seq_sequence : /sequence/i
@@ -380,7 +392,7 @@ seq_option_data_type : AS pg_data_type
       data_type => $item{pg_data_type},
     }
   }
-seq_option_increment : INCREMENT BY(?) digits 
+seq_option_increment : INCREMENT BY(?) digits
   {
     $return = {
       increment => {
@@ -412,15 +424,15 @@ seq_option_maxvalue : NO(?) MAXVALUE digits(?)
       maxvalue => $maxvalue,
     }
   }
-seq_option_start : /START\b/i WITH(?) digits 
+seq_option_start : /START\b/i WITH(?) digits
   {
     $return = {
       start => {
         value => 0+$item[3],
       }
     }
   }
-seq_option_cache : /CACHE/i digits 
+seq_option_cache : /CACHE/i digits
   {
     $return = {
       cache => {
@@ -695,16 +707,6 @@ column_constraint_type : /not null/i { $return = { type => 'not_null' } }
         }
     }
 
-column_id : NAME(s /\./)
-    {
-        my @ids = @{ $item[1] };
-        my $column_id = { column_name => $ids[ $#ids ] };
-        $column_id->{'table_name'} = $ids[ $#ids - 1] if ($#ids - 1 >= 0);
-        $column_id->{'schema_name'} = $ids[ $#ids - 2] if ($#ids - 2 >= 0);
-        $column_id->{'database_name'} = $ids[ $#ids - 3] if ($#ids - 3 >= 0);
-        $return = $column_id;
-    }
-
 table_id : schema_qualification(?) NAME {
     $return = { schema_name => $item[1][0], table_name => $item[2] }
 }
@@ -1052,6 +1054,7 @@ alter : alter_table table_id DROP /constraint/i NAME restrict_or_cascade ';'
 alter : alter_table table_id /owner/i /to/i NAME ';'
     { 1 }
 
+# TODO ALTER SEQUENCE
 # alter : alter_sequence NAME /owned/i /by/i column_name ';'
 #     { 1 }
 
@@ -1287,19 +1290,10 @@ sub parse {
   my @seqs = map { $_ } values %{ $result->{sequences} };
   my @sequences = sort { $a->{order} <=> $b->{order} } @seqs;
   for my $sequence (@sequences) {
-    # Apply PostgreSQL database's default values!
-    # Because the default values are database specific,
-    # they cannot be set in the Schema class Sequence.
-    my $data_type = SQL::Translator::Schema::DataType->new(type => 'integer', size => 20);
-    $sequence->{temporary} //= 0; # Boolean
-    $sequence->{data_type} //= $data_type; # q{bigint};
-    $sequence->{increment} //= 1;
-    $sequence->{minvalue} //= 1; # Same as NO MINVALUE
-    $sequence->{maxvalue} //= 0; # Same as NO MAXVALUE
-    $sequence->{start} //= 1;
-    $sequence->{cache} //= 1;
-    $sequence->{cycle} //= 0; # Boolean, Same as NO CYCLE
-    $sequence->{owner} //= q{NONE};
+    my %default_values = _get_sequence_default_values();
+    for my $key (keys %default_values) {
+      $sequence->{$key} //= $default_values{$key};
+    }
     $schema->add_sequence( %{ $sequence } );
   }
 
@@ -1403,27 +1397,43 @@ sub parse {
   return 1;
 }
 
-# Apply PostgreSQL database's default values!
-# Because the default values are database specific,
-# they cannot be set in the Schema class Sequence.
 sub create_sequence {
   my ($class, %data) = @_;
+  my %default_values = _get_sequence_default_values();
 
-  my $data_type = SQL::Translator::Schema::DataType->new(type => 'integer', size => 20);
-  $data{temporary} //= 0; # Boolean
-  $data{unlogged} //= 0; # Boolean
-  $data{data_type} //= $data_type; # q{bigint};
-  $data{increment} //= 1;
-  $data{minvalue} //= 1; # Same as NO MINVALUE
-  $data{maxvalue} //= 0; # Same as NO MAXVALUE
-  $data{start} //= 1;
-  $data{cache} //= 1;
-  $data{cycle} //= 0; # Boolean, Same as NO CYCLE
-  $data{owner} //= q{NONE};
-
+  for my $key (keys %default_values) {
+    $data{$key} //= $default_values{$key};
+  }
   return SQL::Translator::Schema::Sequence->new( %data );
 };
 
+# Apply PostgreSQL database's default values!
+# Because the default values are database specific,
+# they cannot be set in the Schema class Sequence.
+sub _get_sequence_default_values {
+  my %data;
+
+  # PostgreSQL default sequence datatype is bigint, i.e. 64 bit integer.
+  # The maximum number stored in a 64 bit int
+  # is 2^64 – 1 = 18446744073709551615 (a 20 digit number)
+  my $data_type = SQL::Translator::Schema::DataType->new(
+    type => 'integer',
+    size => 20,
+  );
+
+  $data{temporary} = 0; # Boolean
+  $data{unlogged}  = 0; # Boolean
+  $data{data_type} = $data_type; # q{bigint};
+  $data{increment} = 1;
+  $data{minvalue}  = 1; # Same as NO MINVALUE
+  $data{maxvalue}  = 0; # Same as NO MAXVALUE
+  $data{start}     = 1;
+  $data{cache}     = 1;
+  $data{cycle}     = 0; # Boolean, Same as NO CYCLE
+  $data{owner}     = q{NONE};
+  return %data;
+}
+
 1;
 
 # -------------------------------------------------------------------