view release on metacpan or  search on metacpan

lib/SQL/Translator/Parser/SQLite.pm  view on Meta::CPAN

    { $item[1] }
    | SQSTRING
    | /NULL/i
    { 'NULL' }
    | /CURRENT_TIMESTAMP/i
    { 'CURRENT_TIMESTAMP' }

END_OF_GRAMMAR

sub parse {
  my ($translator, $data) = @_;

  # Enable warnings within the Parse::RecDescent module.
  local $::RD_ERRORS = 1
      unless defined $::RD_ERRORS;    # Make sure the parser dies when it encounters an error
  local $::RD_WARN = 1
      unless defined $::RD_WARN;      # Enable warnings. This will warn on unused rules &c.
  local $::RD_HINT = 1
      unless defined $::RD_HINT;      # Give out hints to help fix problems.

  local $::RD_TRACE = $translator->trace ? 1 : undef;
  local $DEBUG      = $translator->debug;

  my $parser = ddl_parser_instance('SQLite');

  my $result = $parser->startrule($data);
  return $translator->error("Parse failed.") unless defined $result;
  warn Dumper($result) if $DEBUG;

  my $schema = $translator->schema;
  my @tables = map { $_->[1] }
      sort { $a->[0] <=> $b->[0] }
      map  { [ $result->{'tables'}{$_}->{'order'}, $_ ] }
      keys %{ $result->{'tables'} };

  for my $table_name (@tables) {
    my $tdata = $result->{'tables'}{$table_name};
    my $table = $schema->add_table(name => $tdata->{'name'},)
        or die $schema->error;

    $table->comments($tdata->{'comments'});

    for my $fdata (@{ $tdata->{'fields'} }) {
      my $field = $table->add_field(
        name              => $fdata->{'name'},
        data_type         => $fdata->{'data_type'},
        size              => $fdata->{'size'},
        default_value     => $fdata->{'default'},
        is_auto_increment => $fdata->{'is_auto_inc'},
        (
          $fdata->{'is_auto_inc'}
          ? (extra => { auto_increment_type => 'monotonic' })
          : ()
        ),
        is_nullable => $fdata->{'is_nullable'},
        comments    => $fdata->{'comments'},
      ) or die $table->error;

      $table->primary_key($field->name) if $fdata->{'is_primary_key'};

      for my $cdata (@{ $fdata->{'constraints'} }) {
        next unless $cdata->{'type'} eq 'foreign_key';
        $cdata->{'fields'} ||= [ $field->name ];
        push @{ $tdata->{'constraints'} }, $cdata;
      }
    }

    for my $idata (@{ $tdata->{'indices'} || [] }) {
      my $index = $table->add_index(
        name   => $idata->{'name'},
        type   => uc($idata->{'type'} || ''),
        fields => $idata->{'fields'},
      ) or die $table->error;
    }

    for my $cdata (@{ $tdata->{'constraints'} || [] }) {
      my $constraint = $table->add_constraint(
        name             => $cdata->{'name'},
        type             => $cdata->{'type'},
        fields           => $cdata->{'fields'},
        reference_table  => $cdata->{'reference_table'},
        reference_fields => $cdata->{'reference_fields'},
        match_type       => $cdata->{'match_type'} || '',
        on_delete        => $cdata->{'on_delete'}  || $cdata->{'on_delete_do'},
        on_update        => $cdata->{'on_update'}  || $cdata->{'on_update_do'},
      ) or die $table->error;
    }
  }

  for my $def (@{ $result->{'views'} || [] }) {
    my $view = $schema->add_view(
      name => $def->{'name'},
      sql  => $def->{'sql'},
    );
  }

  for my $def (@{ $result->{'triggers'} || [] }) {
    my $view = $schema->add_trigger(
      name                => $def->{'name'},
      perform_action_when => $def->{'when'},
      database_events     => $def->{'db_events'},
      action              => $def->{'action'},
      on_table            => $def->{'on_table'},
      scope               => 'row',                 # SQLite only supports row triggers
    );
  }

  return 1;
}

1;

# -------------------------------------------------------------------
# All wholesome food is caught without a net or a trap.
# William Blake
# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.

=head1 SEE ALSO

perl(1), Parse::RecDescent, SQL::Translator::Schema.

=cut